You've already forked lazarus-ccr
fpspreadsheet: Extend TsWorksheetDataset.CopyFromDataset to support codepage conversion of the source dataset.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8678 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -200,7 +200,8 @@ type
|
|||||||
procedure Clear(ClearDefs: Boolean);
|
procedure Clear(ClearDefs: Boolean);
|
||||||
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
|
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
|
||||||
procedure CopyFromDataset(ADataset: TDataset;
|
procedure CopyFromDataset(ADataset: TDataset;
|
||||||
const AWorkbookFileName, ASheetName: String);
|
const AWorkbookFileName, ASheetName: String;
|
||||||
|
ASourceCodePage: TSystemCodePage = CP_UTF8);
|
||||||
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
|
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
|
||||||
procedure CreateTable;
|
procedure CreateTable;
|
||||||
procedure Flush;
|
procedure Flush;
|
||||||
@ -270,7 +271,7 @@ procedure Register;
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
LazUTF8, LazUTF16, Math, TypInfo, Variants, FmtBCD, fpsNumFormat;
|
LazUTF8, LazUTF16, LConvEncoding, Math, TypInfo, Variants, FmtBCD, fpsNumFormat;
|
||||||
|
|
||||||
const // This are the field types of FPC 3.3.x
|
const // This are the field types of FPC 3.3.x
|
||||||
ftSupported = [ftString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
|
ftSupported = [ftString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
|
||||||
@ -681,18 +682,44 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function SystemCodePageToStr(ACodePage: TSystemCodePage): String;
|
||||||
|
begin
|
||||||
|
if (ACodePage = CP_UTF8) then
|
||||||
|
Result := 'utf8'
|
||||||
|
else
|
||||||
|
if (ACodePage < 1000) or ((ACodePage >= 1250) and (ACodePage <= 1258)) then
|
||||||
|
Result := 'cp' + IntToStr(ACodePage)
|
||||||
|
else
|
||||||
|
if (ACodePage >= 28591) and (ACodePage <= 28599) then
|
||||||
|
Result := 'iso88' + IntToStr(ACodePage-28000)
|
||||||
|
else
|
||||||
|
if (ACodePage >=28600) and (ACodePage <= 28605) then
|
||||||
|
Result := 'iso88561' + IntToStr(ACodePage-28600)
|
||||||
|
else
|
||||||
|
if (ACodePage = 20866) then
|
||||||
|
Result := 'koi8r'
|
||||||
|
else
|
||||||
|
if (ACodePage = 21866) then
|
||||||
|
Result := 'koi8u'
|
||||||
|
else
|
||||||
|
Result := '';
|
||||||
|
end;
|
||||||
|
|
||||||
{ Copies the specified dataset to the worksheet dataset: copies fielddefs as
|
{ Copies the specified dataset to the worksheet dataset: copies fielddefs as
|
||||||
well as data.
|
well as data.
|
||||||
Important: In order to avoid data loss in the worksheet dataset it must be
|
Important: In order to avoid data loss in the worksheet dataset it must be
|
||||||
closed and FileName and SheetName must be empty; they will be set to the
|
closed and FileName and SheetName must be empty; they will be set to the
|
||||||
values passed as parameters. }
|
values passed as parameters. }
|
||||||
procedure TsWorksheetDataset.CopyFromDataset(ADataset: TDataset;
|
procedure TsWorksheetDataset.CopyFromDataset(ADataset: TDataset;
|
||||||
const AWorkbookFileName, ASheetName: String);
|
const AWorkbookFileName, ASheetName: String; ASourceCodePage: TSystemCodePage = CP_UTF8);
|
||||||
var
|
var
|
||||||
i: Integer;
|
i: Integer;
|
||||||
fsrc, fdest: TField;
|
fsrc, fdest: TField;
|
||||||
stream: TMemoryStream;
|
stream: TMemoryStream;
|
||||||
bm: TBookmark;
|
bm: TBookmark;
|
||||||
|
codepageStr: String;
|
||||||
|
s: RawByteString;
|
||||||
|
sUTF8: UTF8String;
|
||||||
begin
|
begin
|
||||||
if Active then
|
if Active then
|
||||||
DatabaseError('Dataset must not be active when calling CopyFromDataset.');
|
DatabaseError('Dataset must not be active when calling CopyFromDataset.');
|
||||||
@ -701,6 +728,8 @@ begin
|
|||||||
if FSheetName <> '' then
|
if FSheetName <> '' then
|
||||||
DatabaseError('SheetName must be empty when calling CopyFromDataset.');
|
DatabaseError('SheetName must be empty when calling CopyFromDataset.');
|
||||||
|
|
||||||
|
codepageStr := SystemCodePageToStr(ASourceCodepage);
|
||||||
|
|
||||||
FFileName := AWorkbookFileName;
|
FFileName := AWorkbookFileName;
|
||||||
FSheetName := ASheetName;
|
FSheetName := ASheetName;
|
||||||
|
|
||||||
@ -734,7 +763,7 @@ begin
|
|||||||
if not fsrc.IsNull then
|
if not fsrc.IsNull then
|
||||||
case fdest.DataType of
|
case fdest.DataType of
|
||||||
ftString, ftFixedChar:
|
ftString, ftFixedChar:
|
||||||
fdest.AsString := fsrc.AsString;
|
fdest.AsString := ConvertEncoding(fsrc.AsString, codepageStr, 'utf8');
|
||||||
ftWideString, ftFixedWideChar:
|
ftWideString, ftFixedWideChar:
|
||||||
fdest.AsWideString := fsrc.AsWideString;
|
fdest.AsWideString := fsrc.AsWideString;
|
||||||
ftBoolean:
|
ftBoolean:
|
||||||
@ -761,6 +790,15 @@ begin
|
|||||||
begin
|
begin
|
||||||
stream.Clear;
|
stream.Clear;
|
||||||
TBlobField(fsrc).SaveToStream(stream);
|
TBlobField(fsrc).SaveToStream(stream);
|
||||||
|
if (ASourceCodePage <> CP_UTF8) and (stream.Size > 0) then
|
||||||
|
begin
|
||||||
|
stream.Position := 0;
|
||||||
|
SetLength(s, stream.Size);
|
||||||
|
stream.Write(s[1], stream.Size);
|
||||||
|
sUTF8 := ConvertEncoding(s, codepageStr, 'utf8');
|
||||||
|
stream.Clear;
|
||||||
|
stream.Read(sUTF8[1], Length(sUTF8));
|
||||||
|
end;
|
||||||
stream.Position := 0;
|
stream.Position := 0;
|
||||||
TBlobField(fdest).LoadFromStream(stream);
|
TBlobField(fdest).LoadFromStream(stream);
|
||||||
end;
|
end;
|
||||||
|
Reference in New Issue
Block a user