You've already forked lazarus-ccr
fpspreadsheet: Add import of spreadsheet data to a database to the dbexport project (will be renamed to db_export_import). Functional, but not fully complete.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3433 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -9,7 +9,6 @@
|
||||
<Title Value="dbexport"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
|
||||
@ -1,32 +1,34 @@
|
||||
object Form1: TForm1
|
||||
Left = 340
|
||||
Height = 229
|
||||
Height = 236
|
||||
Top = 154
|
||||
Width = 404
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 229
|
||||
ClientWidth = 404
|
||||
Width = 450
|
||||
Caption = 'db_Export_Import'
|
||||
ClientHeight = 236
|
||||
ClientWidth = 450
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '1.3'
|
||||
object PageControl: TPageControl
|
||||
Left = 4
|
||||
Height = 221
|
||||
Height = 228
|
||||
Top = 4
|
||||
Width = 396
|
||||
ActivePage = TabSheet1
|
||||
Width = 442
|
||||
ActivePage = TabImport
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 4
|
||||
TabIndex = 0
|
||||
TabIndex = 2
|
||||
TabOrder = 0
|
||||
object TabSheet1: TTabSheet
|
||||
OnChange = PageControlChange
|
||||
object TabDataGenerator: TTabSheet
|
||||
Caption = '1 - Create database'
|
||||
ClientHeight = 193
|
||||
ClientWidth = 388
|
||||
ClientHeight = 200
|
||||
ClientWidth = 434
|
||||
object Label2: TLabel
|
||||
Left = 4
|
||||
Height = 15
|
||||
Top = 4
|
||||
Width = 380
|
||||
Width = 426
|
||||
Align = alTop
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Create a database with random records'
|
||||
@ -36,13 +38,13 @@ object Form1: TForm1
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 170
|
||||
Height = 177
|
||||
Top = 23
|
||||
Width = 388
|
||||
Width = 434
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 170
|
||||
ClientWidth = 388
|
||||
ClientHeight = 177
|
||||
ClientWidth = 434
|
||||
TabOrder = 0
|
||||
object HeaderLabel1: TLabel
|
||||
Left = 8
|
||||
@ -62,9 +64,9 @@ object Form1: TForm1
|
||||
Text = '10000'
|
||||
end
|
||||
object BtnCreateDbf: TButton
|
||||
Left = 280
|
||||
Left = 326
|
||||
Height = 25
|
||||
Top = 116
|
||||
Top = 123
|
||||
Width = 99
|
||||
Anchors = [akRight, akBottom]
|
||||
Caption = 'Run'
|
||||
@ -75,15 +77,15 @@ object Form1: TForm1
|
||||
Left = 0
|
||||
Height = 3
|
||||
Top = 0
|
||||
Width = 388
|
||||
Width = 434
|
||||
Align = alTop
|
||||
Shape = bsTopLine
|
||||
end
|
||||
object InfoLabel1: TLabel
|
||||
Left = 4
|
||||
Height = 15
|
||||
Top = 151
|
||||
Width = 380
|
||||
Top = 158
|
||||
Width = 426
|
||||
Align = alBottom
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'InfoLabe1'
|
||||
@ -99,15 +101,15 @@ object Form1: TForm1
|
||||
end
|
||||
end
|
||||
end
|
||||
object TabSheet2: TTabSheet
|
||||
Caption = '2 - Write to spreadsheet'
|
||||
ClientHeight = 193
|
||||
ClientWidth = 388
|
||||
object TabExport: TTabSheet
|
||||
Caption = '2 - Export to spreadsheet'
|
||||
ClientHeight = 200
|
||||
ClientWidth = 434
|
||||
object HeaderLabel2: TLabel
|
||||
Left = 4
|
||||
Height = 15
|
||||
Top = 4
|
||||
Width = 380
|
||||
Width = 426
|
||||
Align = alTop
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Export database table to spreadsheet file'
|
||||
@ -119,15 +121,15 @@ object Form1: TForm1
|
||||
Left = 0
|
||||
Height = 3
|
||||
Top = 23
|
||||
Width = 388
|
||||
Width = 434
|
||||
Align = alTop
|
||||
Shape = bsTopLine
|
||||
end
|
||||
object InfoLabel2: TLabel
|
||||
Left = 4
|
||||
Height = 15
|
||||
Top = 174
|
||||
Width = 380
|
||||
Top = 181
|
||||
Width = 426
|
||||
Align = alBottom
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'InfoLabel2'
|
||||
@ -160,9 +162,9 @@ object Form1: TForm1
|
||||
TabOrder = 0
|
||||
end
|
||||
object BtnExport: TButton
|
||||
Left = 280
|
||||
Left = 326
|
||||
Height = 25
|
||||
Top = 140
|
||||
Top = 147
|
||||
Width = 99
|
||||
Anchors = [akRight, akBottom]
|
||||
Caption = 'Run'
|
||||
@ -170,5 +172,66 @@ object Form1: TForm1
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object TabImport: TTabSheet
|
||||
Caption = '3 - Import from spreadsheet'
|
||||
ClientHeight = 200
|
||||
ClientWidth = 434
|
||||
object HeaderLabel3: TLabel
|
||||
Left = 4
|
||||
Height = 15
|
||||
Top = 4
|
||||
Width = 426
|
||||
Align = alTop
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Import spreadsheet file in database table'
|
||||
Font.Style = [fsBold]
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Bevel3: TBevel
|
||||
Left = 0
|
||||
Height = 3
|
||||
Top = 23
|
||||
Width = 434
|
||||
Align = alTop
|
||||
Shape = bsTopLine
|
||||
end
|
||||
object InfoLabel3: TLabel
|
||||
Left = 4
|
||||
Height = 15
|
||||
Top = 181
|
||||
Width = 426
|
||||
Align = alBottom
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'InfoLabel3'
|
||||
ParentColor = False
|
||||
end
|
||||
object BtnImport: TButton
|
||||
Left = 326
|
||||
Height = 25
|
||||
Top = 147
|
||||
Width = 99
|
||||
Anchors = [akRight, akBottom]
|
||||
Caption = 'Run'
|
||||
OnClick = BtnImportClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object FileList: TListBox
|
||||
Left = 6
|
||||
Height = 121
|
||||
Top = 56
|
||||
Width = 292
|
||||
ItemHeight = 0
|
||||
TabOrder = 1
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 5
|
||||
Height = 15
|
||||
Top = 33
|
||||
Width = 221
|
||||
Caption = 'Select the spreadsheet file to be imported:'
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
@ -15,30 +15,46 @@ type
|
||||
TForm1 = class(TForm)
|
||||
Bevel1: TBevel;
|
||||
Bevel2: TBevel;
|
||||
Bevel3: TBevel;
|
||||
BtnCreateDbf: TButton;
|
||||
BtnExport: TButton;
|
||||
BtnImport: TButton;
|
||||
EdRecordCount: TEdit;
|
||||
HeaderLabel3: TLabel;
|
||||
InfoLabel2: TLabel;
|
||||
HeaderLabel1: TLabel;
|
||||
InfoLabel1: TLabel;
|
||||
InfoLabel3: TLabel;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
HeaderLabel2: TLabel;
|
||||
FileList: TListBox;
|
||||
Label3: TLabel;
|
||||
PageControl: TPageControl;
|
||||
Panel1: TPanel;
|
||||
RgFileFormat: TRadioGroup;
|
||||
TabSheet1: TTabSheet;
|
||||
TabSheet2: TTabSheet;
|
||||
TabDataGenerator: TTabSheet;
|
||||
TabExport: TTabSheet;
|
||||
TabImport: TTabSheet;
|
||||
procedure BtnCreateDbfClick(Sender: TObject);
|
||||
procedure BtnExportClick(Sender: TObject);
|
||||
procedure BtnImportClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure PageControlChange(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
FDataset: TDbf;
|
||||
FExportDataset: TDbf;
|
||||
FImportDataset: TDbf;
|
||||
FWorkbook: TsWorkbook;
|
||||
FHeaderTemplateCell: PCell;
|
||||
FDateTemplateCell: PCell;
|
||||
// All data for the cells is generated here (out of the .dbf file)
|
||||
FImportedFieldNames: TStringList;
|
||||
FImportedFieldTypes: Array of TFieldType;
|
||||
// For reading: all data for the database is generated here out of the spreadsheet file
|
||||
procedure ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
|
||||
const ADataCell: PCell);
|
||||
// For writing: all data for the cells is generated here (out of the .dbf file)
|
||||
procedure WriteCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
|
||||
var AValue: variant; var AStyleCell: PCell);
|
||||
public
|
||||
@ -65,66 +81,70 @@ const
|
||||
CITIES: array[0..NUM_CITIES-1] of string = (
|
||||
'New York', 'Los Angeles', 'San Francisco', 'Chicago', 'Miami',
|
||||
'New Orleans', 'Washington', 'Boston', 'Seattle', 'Las Vegas');
|
||||
|
||||
TABLENAME = 'people.dbf'; //name for the dbf table
|
||||
DATADIR = 'data'; //subdirectory where .dbf is stored
|
||||
|
||||
// File formats corresponding to the items of the RgFileFormat radiogroup
|
||||
FILE_FORMATS: array[0..4] of TsSpreadsheetFormat = (
|
||||
sfExcel2, sfExcel5, sfExcel8, sfOOXML, sfOpenDocument
|
||||
);
|
||||
// Spreadsheet files will get the TABLENAME and have one of these extensions.
|
||||
FILE_EXT: array[0..4] of string = (
|
||||
'_excel2.xls', '_excel5.xls', '.xls', '.xlsx', '.ods');
|
||||
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
{ This procedure creates a test database table with random data for us to play with }
|
||||
{ This procedure creates a test dbf table with random data for us to play with }
|
||||
procedure TForm1.BtnCreateDbfClick(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
startDate: TDate;
|
||||
maxAge: Integer = 80 * 365;
|
||||
begin
|
||||
if FDataset <> nil then
|
||||
FDataset.Free;
|
||||
if FExportDataset <> nil then
|
||||
FExportDataset.Free;
|
||||
|
||||
ForceDirectories(DATADIR);
|
||||
startDate := EncodeDate(2010, 8, 1);
|
||||
|
||||
FDataset := TDbf.Create(self);
|
||||
FDataset.FilePathFull := DATADIR + DirectorySeparator;
|
||||
FDataset.TableName := TABLENAME;
|
||||
FDataset.TableLevel := 4; //DBase IV; most widely used.
|
||||
FDataset.FieldDefs.Add('Last name', ftString);
|
||||
FDataset.FieldDefs.Add('First name', ftString);
|
||||
FDataset.FieldDefs.Add('City', ftString);
|
||||
FDataset.FieldDefs.Add('Birthday', ftDateTime);
|
||||
DeleteFile(FDataset.FilePathFull + FDataset.TableName);
|
||||
FDataset.CreateTable;
|
||||
FExportDataset := TDbf.Create(self);
|
||||
FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
|
||||
FExportDataset.TableName := TABLENAME;
|
||||
FExportDataset.TableLevel := 4; //DBase IV; most widely used.
|
||||
FExportDataset.FieldDefs.Add('Last name', ftString);
|
||||
FExportDataset.FieldDefs.Add('First name', ftString);
|
||||
FExportDataset.FieldDefs.Add('City', ftString);
|
||||
FExportDataset.FieldDefs.Add('Birthday', ftDateTime);
|
||||
DeleteFile(FExportDataset.FilePathFull + FExportDataset.TableName);
|
||||
FExportDataset.CreateTable;
|
||||
|
||||
FDataset.Open;
|
||||
FExportDataset.Open;
|
||||
for i:=1 to StrToInt(EdRecordCount.Text) do begin
|
||||
if (i mod 25) = 0 then
|
||||
begin
|
||||
InfoLabel1.Caption := Format('Adding record %d...', [i]);
|
||||
Application.ProcessMessages;
|
||||
end;
|
||||
FDataset.Insert;
|
||||
FDataset.FieldByName('Last name').AsString := LAST_NAMES[Random(NUM_LAST_NAMES)];
|
||||
FDataset.FieldByName('First name').AsString := FIRST_NAMES[Random(NUM_FIRST_NAMES)];
|
||||
FDataset.FieldByName('City').AsString := CITIES[Random(NUM_CITIES)];
|
||||
FDataset.FieldByName('Birthday').AsDateTime := startDate - random(maxAge);
|
||||
FExportDataset.Insert;
|
||||
FExportDataset.FieldByName('Last name').AsString := LAST_NAMES[Random(NUM_LAST_NAMES)];
|
||||
FExportDataset.FieldByName('First name').AsString := FIRST_NAMES[Random(NUM_FIRST_NAMES)];
|
||||
FExportDataset.FieldByName('City').AsString := CITIES[Random(NUM_CITIES)];
|
||||
FExportDataset.FieldByName('Birthday').AsDateTime := startDate - random(maxAge);
|
||||
// creates a random date between "startDate" and "maxAge" days back
|
||||
FDataset.Post;
|
||||
FExportDataset.Post;
|
||||
end;
|
||||
FDataset.Close;
|
||||
FExportDataset.Close;
|
||||
|
||||
InfoLabel1.Caption := Format('Done. Created file "%s" in folder "data".', [
|
||||
FDataset.TableName, FDataset.FilePathFull
|
||||
FExportDataset.TableName, FExportDataset.FilePathFull
|
||||
]);
|
||||
InfoLabel2.Caption := '';
|
||||
InfoLabel3.Caption := '';
|
||||
end;
|
||||
|
||||
procedure TForm1.BtnExportClick(Sender: TObject);
|
||||
const
|
||||
FILE_FORMATS: array[0..4] of TsSpreadsheetFormat = (
|
||||
sfExcel2, sfExcel5, sfExcel8, sfOOXML, sfOpenDocument
|
||||
);
|
||||
EXT: array[0..4] of string = (
|
||||
'_excel2.xls', '_excel5.xls', '.xls', '.xlsx', '.ods');
|
||||
var
|
||||
DataFileName: String;
|
||||
worksheet: TsWorksheet;
|
||||
@ -132,14 +152,14 @@ begin
|
||||
InfoLabel2.Caption := '';
|
||||
Application.ProcessMessages;
|
||||
|
||||
if FDataset = nil then
|
||||
if FExportDataset = nil then
|
||||
begin
|
||||
FDataset := TDbf.Create(self);
|
||||
FDataset.FilePathFull := DATADIR + DirectorySeparator;
|
||||
FDataset.TableName := TABLENAME;
|
||||
FExportDataset := TDbf.Create(self);
|
||||
FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
|
||||
FExportDataset.TableName := TABLENAME;
|
||||
end;
|
||||
|
||||
DataFileName := FDataset.FilePathFull + FDataset.TableName;
|
||||
DataFileName := FExportDataset.FilePathFull + FExportDataset.TableName;
|
||||
if not FileExists(DataFileName) then
|
||||
begin
|
||||
MessageDlg(Format('Database file "%s" not found. Please run "Create database" first.',
|
||||
@ -147,11 +167,11 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
FDataset.Open;
|
||||
FExportDataset.Open;
|
||||
|
||||
FWorkbook := TsWorkbook.Create;
|
||||
try
|
||||
worksheet := FWorkbook.AddWorksheet(FDataset.TableName);
|
||||
worksheet := FWorkbook.AddWorksheet(FExportDataset.TableName);
|
||||
|
||||
// Make header line frozen
|
||||
worksheet.Options := worksheet.Options + [soHasFrozenPanes];
|
||||
@ -176,45 +196,203 @@ begin
|
||||
// FWorkbook.Options := FWorkbook.Options + [boVirtualMode, boBufStream];
|
||||
FWorkbook.Options := FWorkbook.Options + [boVirtualMode];
|
||||
FWorkbook.OnWriteCellData := @WriteCellDataHandler;
|
||||
FWorkbook.VirtualRowCount := FDataset.RecordCount + 1; // +1 for the header line
|
||||
FWorkbook.VirtualColCount := FDataset.FieldCount;
|
||||
FWorkbook.VirtualRowCount := FExportDataset.RecordCount + 1; // +1 for the header line
|
||||
FWorkbook.VirtualColCount := FExportDataset.FieldCount;
|
||||
|
||||
// Write
|
||||
DataFileName := ChangeFileExt(DataFileName, EXT[RgFileFormat.ItemIndex]);
|
||||
DataFileName := ChangeFileExt(DataFileName, FILE_EXT[RgFileFormat.ItemIndex]);
|
||||
FWorkbook.WriteToFile(DataFileName, FILE_FORMATS[RgFileFormat.ItemIndex], true);
|
||||
finally
|
||||
FreeAndNil(FWorkbook);
|
||||
end;
|
||||
|
||||
InfoLabel2.Caption := Format('Done. Database exported to file "%s" in folder "%s"',
|
||||
[ChangeFileExt(FDataset.TableName, EXT[RgFileFormat.ItemIndex]), FDataset.FilePathFull]);
|
||||
InfoLabel2.Caption := Format('Done. Database exported to file "%s" in folder "%s"', [
|
||||
ChangeFileExt(FExportDataset.TableName, FILE_EXT[RgFileFormat.ItemIndex]),
|
||||
FExportDataset.FilePathFull
|
||||
]);
|
||||
end;
|
||||
|
||||
{ This procedure imports the contents of the selected spreadsheet file into a
|
||||
new dbf database file using virtual mode. }
|
||||
procedure TForm1.BtnImportClick(Sender: TObject);
|
||||
var
|
||||
DataFileName: String;
|
||||
fmt: TsSpreadsheetFormat;
|
||||
ext: String;
|
||||
begin
|
||||
if FileList.ItemIndex = -1 then begin
|
||||
MessageDlg('Please select a file in the listbox.', mtInformation, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// Determine the file format from the filename - just to avoid the annoying
|
||||
// exceptions that occur for Excel2 and Excel5.
|
||||
DataFileName := FileList.Items[FileList.ItemIndex];
|
||||
ext := lowercase(ExtractFileExt(DataFileName));
|
||||
if ext = '.xls' then begin
|
||||
if pos(FILE_EXT[0], DataFileName) > 0 then
|
||||
fmt := sfExcel2
|
||||
else
|
||||
if pos(FILE_EXT[1], DataFileName) > 0 then
|
||||
fmt := sfExcel5
|
||||
else
|
||||
fmt := sfExcel8;
|
||||
end else
|
||||
if ext = '.xlsx' then
|
||||
fmt := sfOOXML
|
||||
else
|
||||
if ext = '.ods' then
|
||||
fmt := sfOpenDocument
|
||||
else begin
|
||||
MessageDlg('Unknown spreadsheet file format.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
DataFileName := DATADIR + DirectorySeparator + DataFileName;
|
||||
|
||||
// Prepare dbf table for the spreadsheet data to be imported
|
||||
if FImportDataset <> nil then
|
||||
FImportDataset.Free;
|
||||
FImportDataset := TDbf.Create(self);
|
||||
FImportDataset.FilePathFull := DATADIR + DirectorySeparator;
|
||||
FImportDataset.TableName := 'imported_' + TABLENAME;
|
||||
FImportDataset.TableLevel := 4; //DBase IV; most widely used.
|
||||
DeleteFile(FImportDataset.FilePathFull + FImportDataset.TableName);
|
||||
|
||||
// The stringlist will temporarily store the field names ...
|
||||
if FImportedFieldNames = nil then
|
||||
FImportedFieldNames := TStringList.Create;
|
||||
FImportedFieldNames.Clear;
|
||||
|
||||
// ... and this array stores the field types until we have all information
|
||||
// to create the dbf table.
|
||||
SetLength(FImportedFieldTypes, 0);
|
||||
|
||||
// Create the workbook and activate virtual mode
|
||||
FWorkbook := TsWorkbook.Create;
|
||||
try
|
||||
FWorkbook.Options := FWorkbook.Options + [boVirtualMode];
|
||||
FWorkbook.OnReadCellData := @ReadCellDataHandler;
|
||||
// Read the data from the spreadsheet file transparently into the dbf file
|
||||
// The data are not permanently available in the worksheet and do occupy
|
||||
// memory there - this is virtual mode.
|
||||
FWorkbook.ReadFromFile(DataFilename, fmt);
|
||||
finally
|
||||
FWorkbook.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
InfoLabel1.Caption := '';
|
||||
InfoLabel2.Caption := '';
|
||||
InfoLabel3.Caption := '';
|
||||
PageControl.ActivePageIndex := 0;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(FImportedFieldNames);
|
||||
end;
|
||||
|
||||
{ When we activate the "Import" page of the pagecontrol we read the data
|
||||
folder and collect all spreadsheet files available in a list box. The user
|
||||
will have to select the one to be converted to dbf. }
|
||||
procedure TForm1.PageControlChange(Sender: TObject);
|
||||
var
|
||||
sr: TSearchRec;
|
||||
ext: String;
|
||||
begin
|
||||
if PageControl.ActivePage = TabImport then begin
|
||||
FileList.Clear;
|
||||
if FindFirst(DATADIR + DirectorySeparator + ChangeFileExt(TABLENAME, '') + '*.*', faAnyFile, sr) = 0
|
||||
then begin
|
||||
repeat
|
||||
if (sr.Name = '.') or (sr.Name = '..') then
|
||||
Continue;
|
||||
ext := lowercase(ExtractFileExt(sr.Name));
|
||||
if (ext = '.xls') or (ext = '.xlsx') or (ext = '.ods') then
|
||||
FileList.Items.Add(sr.Name);
|
||||
until FindNext(sr) <> 0;
|
||||
FindClose(sr);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ This is the event handler for reading a spreadsheet file in virtual mode.
|
||||
The data are not stored in the worksheet and exist only temporarily.
|
||||
This event handler picks the data and posts them to the database table.
|
||||
Note that we do not make many assumptions on the data structure here. Therefore
|
||||
we have to buffer the first two rows of the spreadsheet file until the
|
||||
structure of the table is clear. }
|
||||
procedure TForm1.ReadCellDataHandler(Sender: TObject; ARow, Acol: Cardinal;
|
||||
const ADataCell: PCell);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
// The first row (index 0) holds the field names. We temporarily store the
|
||||
// field names in a string list because we don't know the data types of the
|
||||
// cell before we have not read the second row (index 1).
|
||||
if ARow = 0 then begin
|
||||
// We know that the first row contains string cells -> no further checks.
|
||||
FImportedFieldNames.Add(ADataCell^.UTF8StringValue);
|
||||
end
|
||||
else
|
||||
// We have to buffer the second row (index 1) as well. When it is fully read
|
||||
// we can put everything together and create the dfb table.
|
||||
if ARow = 1 then begin
|
||||
if Length(FImportedFieldTypes) = 0 then
|
||||
SetLength(FImportedFieldTypes, FImportedFieldNames.Count);
|
||||
case ADataCell^.ContentType of
|
||||
cctNumber : FImportedFieldTypes[ACol] := ftFloat;
|
||||
cctUTF8String: FImportedFieldTypes[ACol] := ftString;
|
||||
cctDateTime : FImportedFieldTypes[ACol] := ftDate;
|
||||
end;
|
||||
// All field types are known --> we create the table
|
||||
if ACol = High(FImportedFieldTypes) then begin
|
||||
for i:=0 to High(FImportedFieldTypes) do
|
||||
FImportDataset.FieldDefs.Add(FImportedFieldNames[i], FImportedFieldTypes[i]);
|
||||
DeleteFile(FImportDataset.FilePathFull + FImportDataset.TableName);
|
||||
FImportDataset.CreateTable;
|
||||
FImportDataset.Open;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Now that we know everything we can add the data to the table
|
||||
if ACol = 0 then
|
||||
FImportDataset.Insert;
|
||||
case ADataCell^.ContentType of
|
||||
cctNumber : FImportDataSet.Fields[Acol].AsFloat := ADataCell^.NumberValue;
|
||||
cctUTF8String: FImportDataset.Fields[Acol].AsString := ADataCell^.UTF8StringValue;
|
||||
cctDateTime : FImportDataset.Fields[ACol].AsDateTime := ADataCell^.DateTimeValue;
|
||||
end;
|
||||
if ACol = High(FImportedFieldTypes) then
|
||||
FImportDataset.Post;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ This is the event handler for exporting a database file to spreadsheet format
|
||||
in virtual mode. Data are not written into the worksheet, they exist only
|
||||
temporarily. }
|
||||
procedure TForm1.WriteCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
|
||||
var AValue: variant; var AStyleCell: PCell);
|
||||
begin
|
||||
// Header line: we want to show the field names here.
|
||||
if ARow = 0 then
|
||||
begin
|
||||
AValue := FDataset.Fields[ACol].FieldName;
|
||||
AValue := FExportDataset.Fields[ACol].FieldName;
|
||||
AStyleCell := FHeaderTemplateCell;
|
||||
FDataset.First;
|
||||
FExportDataset.First;
|
||||
end
|
||||
else
|
||||
begin
|
||||
AValue := FDataset.Fields[ACol].Value;
|
||||
if FDataset.Fields[ACol].DataType = ftDate then
|
||||
AValue := FExportDataset.Fields[ACol].Value;
|
||||
if FExportDataset.Fields[ACol].DataType = ftDate then
|
||||
AStyleCell := FDateTemplateCell;
|
||||
if ACol = FWorkbook.VirtualColCount-1 then
|
||||
begin
|
||||
FDataset.Next;
|
||||
FExportDataset.Next;
|
||||
if (ARow-1) mod 25 = 0 then
|
||||
begin
|
||||
InfoLabel1.Caption := Format('Writing record %d...', [ARow-1]);
|
||||
|
||||
Reference in New Issue
Block a user