diff --git a/components/fpspreadsheet/examples/db_import_export/dbexport.lpi b/components/fpspreadsheet/examples/db_import_export/dbexport.lpi
index e4e236749..636b7ce55 100644
--- a/components/fpspreadsheet/examples/db_import_export/dbexport.lpi
+++ b/components/fpspreadsheet/examples/db_import_export/dbexport.lpi
@@ -9,7 +9,6 @@
-
diff --git a/components/fpspreadsheet/examples/db_import_export/main.lfm b/components/fpspreadsheet/examples/db_import_export/main.lfm
index f84059760..a3f84433d 100644
--- a/components/fpspreadsheet/examples/db_import_export/main.lfm
+++ b/components/fpspreadsheet/examples/db_import_export/main.lfm
@@ -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
diff --git a/components/fpspreadsheet/examples/db_import_export/main.pas b/components/fpspreadsheet/examples/db_import_export/main.pas
index 7a35376b5..13c8f5971 100644
--- a/components/fpspreadsheet/examples/db_import_export/main.pas
+++ b/components/fpspreadsheet/examples/db_import_export/main.pas
@@ -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]);