diff --git a/components/fpspreadsheet/examples/db_import_export/dbexport.lpi b/components/fpspreadsheet/examples/db_import_export/db_export_import.lpi
similarity index 94%
rename from components/fpspreadsheet/examples/db_import_export/dbexport.lpi
rename to components/fpspreadsheet/examples/db_import_export/db_export_import.lpi
index 636b7ce55..f364ff07f 100644
--- a/components/fpspreadsheet/examples/db_import_export/dbexport.lpi
+++ b/components/fpspreadsheet/examples/db_import_export/db_export_import.lpi
@@ -6,7 +6,7 @@
-
+
@@ -37,7 +37,7 @@
-
+
@@ -54,7 +54,7 @@
-
+
diff --git a/components/fpspreadsheet/examples/db_import_export/dbexport.lpr b/components/fpspreadsheet/examples/db_import_export/db_export_import.lpr
similarity index 92%
rename from components/fpspreadsheet/examples/db_import_export/dbexport.lpr
rename to components/fpspreadsheet/examples/db_import_export/db_export_import.lpr
index 42ddd0f2e..51c58ddd3 100644
--- a/components/fpspreadsheet/examples/db_import_export/dbexport.lpr
+++ b/components/fpspreadsheet/examples/db_import_export/db_export_import.lpr
@@ -1,4 +1,4 @@
-program dbexport;
+program db_export_import;
{$mode objfpc}{$H+}
diff --git a/components/fpspreadsheet/examples/db_import_export/main.lfm b/components/fpspreadsheet/examples/db_import_export/main.lfm
index a3f84433d..494ec9ddd 100644
--- a/components/fpspreadsheet/examples/db_import_export/main.lfm
+++ b/components/fpspreadsheet/examples/db_import_export/main.lfm
@@ -1,34 +1,34 @@
object Form1: TForm1
Left = 340
- Height = 236
+ Height = 310
Top = 154
- Width = 450
+ Width = 639
Caption = 'db_Export_Import'
- ClientHeight = 236
- ClientWidth = 450
+ ClientHeight = 310
+ ClientWidth = 639
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.3'
object PageControl: TPageControl
Left = 4
- Height = 228
+ Height = 302
Top = 4
- Width = 442
- ActivePage = TabImport
+ Width = 631
+ ActivePage = TabDataGenerator
Align = alClient
BorderSpacing.Around = 4
- TabIndex = 2
+ TabIndex = 0
TabOrder = 0
OnChange = PageControlChange
object TabDataGenerator: TTabSheet
Caption = '1 - Create database'
- ClientHeight = 200
- ClientWidth = 434
+ ClientHeight = 269
+ ClientWidth = 623
object Label2: TLabel
Left = 4
- Height = 15
+ Height = 20
Top = 4
- Width = 426
+ Width = 615
Align = alTop
BorderSpacing.Around = 4
Caption = 'Create a database with random records'
@@ -38,35 +38,35 @@ object Form1: TForm1
end
object Panel1: TPanel
Left = 0
- Height = 177
- Top = 23
- Width = 434
+ Height = 241
+ Top = 28
+ Width = 623
Align = alClient
BevelOuter = bvNone
- ClientHeight = 177
- ClientWidth = 434
+ ClientHeight = 241
+ ClientWidth = 623
TabOrder = 0
object HeaderLabel1: TLabel
Left = 8
- Height = 15
+ Height = 20
Top = 11
- Width = 71
+ Width = 88
Caption = 'Record count'
ParentColor = False
end
object EdRecordCount: TEdit
Left = 107
- Height = 23
+ Height = 28
Top = 8
Width = 64
Alignment = taRightJustify
TabOrder = 0
- Text = '10000'
+ Text = '50000'
end
object BtnCreateDbf: TButton
- Left = 326
- Height = 25
- Top = 123
+ Left = 515
+ Height = 28
+ Top = 208
Width = 99
Anchors = [akRight, akBottom]
Caption = 'Run'
@@ -77,25 +77,25 @@ object Form1: TForm1
Left = 0
Height = 3
Top = 0
- Width = 434
+ Width = 623
Align = alTop
Shape = bsTopLine
end
object InfoLabel1: TLabel
- Left = 4
- Height = 15
- Top = 158
- Width = 426
- Align = alBottom
+ Left = 8
+ Height = 20
+ Top = 216
+ Width = 496
+ Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Around = 4
- Caption = 'InfoLabe1'
+ Caption = 'InfoLabel1'
ParentColor = False
end
object Label1: TLabel
Left = 8
- Height = 15
+ Height = 20
Top = 40
- Width = 324
+ Width = 409
Caption = 'Please note: the binary xls files can handle only 65536 records.'
ParentColor = False
end
@@ -103,13 +103,13 @@ object Form1: TForm1
end
object TabExport: TTabSheet
Caption = '2 - Export to spreadsheet'
- ClientHeight = 200
- ClientWidth = 434
+ ClientHeight = 269
+ ClientWidth = 623
object HeaderLabel2: TLabel
Left = 4
- Height = 15
+ Height = 20
Top = 4
- Width = 426
+ Width = 615
Align = alTop
BorderSpacing.Around = 4
Caption = 'Export database table to spreadsheet file'
@@ -120,26 +120,26 @@ object Form1: TForm1
object Bevel2: TBevel
Left = 0
Height = 3
- Top = 23
- Width = 434
+ Top = 28
+ Width = 623
Align = alTop
Shape = bsTopLine
end
object InfoLabel2: TLabel
- Left = 4
- Height = 15
- Top = 181
- Width = 426
- Align = alBottom
+ Left = 8
+ Height = 20
+ Top = 244
+ Width = 504
+ Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Around = 4
Caption = 'InfoLabel2'
ParentColor = False
end
object RgFileFormat: TRadioGroup
Left = 8
- Height = 134
+ Height = 158
Top = 32
- Width = 185
+ Width = 232
AutoFill = True
Caption = 'Spreadsheet file format'
ChildSizing.LeftRightSpacing = 6
@@ -149,8 +149,8 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
- ClientHeight = 116
- ClientWidth = 181
+ ClientHeight = 136
+ ClientWidth = 228
ItemIndex = 2
Items.Strings = (
'xls (Excel 2)'
@@ -162,9 +162,9 @@ object Form1: TForm1
TabOrder = 0
end
object BtnExport: TButton
- Left = 326
- Height = 25
- Top = 147
+ Left = 515
+ Height = 28
+ Top = 236
Width = 99
Anchors = [akRight, akBottom]
Caption = 'Run'
@@ -174,13 +174,13 @@ object Form1: TForm1
end
object TabImport: TTabSheet
Caption = '3 - Import from spreadsheet'
- ClientHeight = 200
- ClientWidth = 434
+ ClientHeight = 269
+ ClientWidth = 623
object HeaderLabel3: TLabel
Left = 4
- Height = 15
+ Height = 20
Top = 4
- Width = 426
+ Width = 615
Align = alTop
BorderSpacing.Around = 4
Caption = 'Import spreadsheet file in database table'
@@ -191,44 +191,47 @@ object Form1: TForm1
object Bevel3: TBevel
Left = 0
Height = 3
- Top = 23
- Width = 434
+ Top = 28
+ Width = 623
Align = alTop
Shape = bsTopLine
end
object InfoLabel3: TLabel
- Left = 4
- Height = 15
- Top = 181
- Width = 426
- Align = alBottom
+ Left = 8
+ Height = 20
+ Top = 244
+ Width = 70
+ Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4
Caption = 'InfoLabel3'
ParentColor = False
end
object BtnImport: TButton
- Left = 326
- Height = 25
- Top = 147
+ Left = 515
+ Height = 28
+ Top = 236
Width = 99
Anchors = [akRight, akBottom]
Caption = 'Run'
+ Enabled = False
OnClick = BtnImportClick
TabOrder = 0
end
object FileList: TListBox
- Left = 6
- Height = 121
+ Left = 8
+ Height = 181
Top = 56
Width = 292
+ Anchors = [akTop, akLeft, akBottom]
ItemHeight = 0
+ OnClick = FileListClick
TabOrder = 1
end
object Label3: TLabel
- Left = 5
- Height = 15
+ Left = 8
+ Height = 20
Top = 33
- Width = 221
+ Width = 282
Caption = 'Select the spreadsheet file to be imported:'
ParentColor = False
end
diff --git a/components/fpspreadsheet/examples/db_import_export/main.pas b/components/fpspreadsheet/examples/db_import_export/main.pas
index 13c8f5971..3019e6d65 100644
--- a/components/fpspreadsheet/examples/db_import_export/main.pas
+++ b/components/fpspreadsheet/examples/db_import_export/main.pas
@@ -39,6 +39,7 @@ type
procedure BtnCreateDbfClick(Sender: TObject);
procedure BtnExportClick(Sender: TObject);
procedure BtnImportClick(Sender: TObject);
+ procedure FileListClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PageControlChange(Sender: TObject);
@@ -50,7 +51,7 @@ type
FHeaderTemplateCell: PCell;
FDateTemplateCell: PCell;
FImportedFieldNames: TStringList;
- FImportedFieldTypes: Array of TFieldType;
+ FImportedRowCells: Array of TCell;
// 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);
@@ -69,6 +70,7 @@ implementation
{$R *.lfm}
const
+ // Parameters for generating dbf file contents
NUM_LAST_NAMES = 8;
NUM_FIRST_NAMES = 8;
NUM_CITIES = 10;
@@ -121,8 +123,11 @@ begin
FExportDataset.CreateTable;
FExportDataset.Open;
+ // We generate random records by combining first names, last names and cities
+ // defined in the FIRST_NAMES, LAST_NAMES and CITIES arrays. We also add a
+ // random birthday.
for i:=1 to StrToInt(EdRecordCount.Text) do begin
- if (i mod 25) = 0 then
+ if (i mod 1000 = 0) then
begin
InfoLabel1.Caption := Format('Adding record %d...', [i]);
Application.ProcessMessages;
@@ -142,8 +147,12 @@ begin
]);
InfoLabel2.Caption := '';
InfoLabel3.Caption := '';
+ Application.ProcessMessages;
end;
+{ This procedure exports the data in the dbf file created by BtnCreateDbfClick
+ to a spreadsheet file. The workbook operates in virtual mode to minimize
+ memory load of this process }
procedure TForm1.BtnExportClick(Sender: TObject);
var
DataFileName: String;
@@ -152,6 +161,12 @@ begin
InfoLabel2.Caption := '';
Application.ProcessMessages;
+ if RgFileFormat.ItemIndex = 4 then
+ begin
+ MessageDlg('Virtual mode is not yet implemented for .ods files.', mtError, [mbOK], 0);
+ exit;
+ end;
+
if FExportDataset = nil then
begin
FExportDataset := TDbf.Create(self);
@@ -173,24 +188,28 @@ begin
try
worksheet := FWorkbook.AddWorksheet(FExportDataset.TableName);
- // Make header line frozen
- worksheet.Options := worksheet.Options + [soHasFrozenPanes];
- worksheet.TopPaneHeight := 1;
+ // Make header line frozen - but not in Excel2 where frozen panes do not yet work properly
+ if FILE_FORMATS[RgFileFormat.ItemIndex] <> sfExcel2 then begin
+ worksheet.Options := worksheet.Options + [soHasFrozenPanes];
+ worksheet.TopPaneHeight := 1;
+ end;
- // Prepare template for header line
+ // Use cell A1 as format template of header line
FHeaderTemplateCell := worksheet.GetCell(0, 0);
worksheet.WriteFontStyle(FHeaderTemplateCell, [fssBold]);
- worksheet.WriteFontColor(FHeaderTemplateCell, scWhite);
worksheet.WriteBackgroundColor(FHeaderTemplateCell, scGray);
+ if FILE_FORMATS[RgFileFormat.ItemIndex] <> sfExcel2 then
+ worksheet.WriteFontColor(FHeaderTemplateCell, scWhite); // Does not look nice in the limited Excel2 format
- // Prepare template for date column
+ // Use cell B1 as format template of date column
FDateTemplateCell := worksheet.GetCell(0, 1);
worksheet.WriteDateTimeFormat(FDateTemplateCell, nfShortDate);
- // Make first three columns a bit wider
+ // Make rows a bit wider
worksheet.WriteColWidth(0, 20);
worksheet.WriteColWidth(1, 20);
worksheet.WriteColWidth(2, 20);
+ worksheet.WriteCOlWidth(3, 15);
// Setup virtual mode to save memory
// FWorkbook.Options := FWorkbook.Options + [boVirtualMode, boBufStream];
@@ -208,7 +227,7 @@ begin
InfoLabel2.Caption := Format('Done. Database exported to file "%s" in folder "%s"', [
ChangeFileExt(FExportDataset.TableName, FILE_EXT[RgFileFormat.ItemIndex]),
- FExportDataset.FilePathFull
+ DATADIR
]);
end;
@@ -264,9 +283,9 @@ begin
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);
+ // ... and this array will temporarily store the cells of the second row
+ // until we have all information to create the dbf table.
+ SetLength(FImportedRowCells, 0);
// Create the workbook and activate virtual mode
FWorkbook := TsWorkbook.Create;
@@ -277,11 +296,20 @@ begin
// The data are not permanently available in the worksheet and do occupy
// memory there - this is virtual mode.
FWorkbook.ReadFromFile(DataFilename, fmt);
+ // We close the ImportDataset after import process has finished:
+ FImportDataset.Close;
+ InfoLabel3.Caption := Format('Done. File "%s" imported in database "%s".',
+ [ExtractFileName(DataFileName), FImportDataset.TableName]);
finally
FWorkbook.Free;
end;
end;
+procedure TForm1.FileListClick(Sender: TObject);
+begin
+ BtnImport.Enabled := (FileList.ItemIndex > -1);
+end;
+
procedure TForm1.FormCreate(Sender: TObject);
begin
InfoLabel1.Caption := '';
@@ -316,23 +344,26 @@ begin
until FindNext(sr) <> 0;
FindClose(sr);
end;
+ BtnImport.Enabled := FileList.ItemIndex > -1;
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. }
+ ADataCell has just been read from the spreadsheet file, but will not be added
+ to the workbook and will be discarded. The event handler, however, can pick
+ the data and post them to the database table.
+ Note that we do not make too 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;
+ fieldType: TFieldType;
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).
+ // cell until 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);
@@ -341,25 +372,48 @@ begin
// 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]);
+ if Length(FImportedRowCells) = 0 then
+ SetLength(FImportedRowCells, FImportedFieldNames.Count);
+ FImportedRowCells[ACol] := ADataCell^;
+ // The row is read completely, all field types are known --> we create the table
+ if ACol = High(FImportedRowCells) then begin
+ // Add fields - the required information is stored in FImportedFieldNames
+ // and FImportedFieldTypes
+ for i:=0 to High(FImportedRowCells) do begin
+ case FImportedRowCells[i].ContentType of
+ cctNumber : fieldType := ftFloat;
+ cctDateTime : fieldType := ftDateTime;
+ cctUTF8String : fieldType := ftString;
+ end;
+ FImportDataset.FieldDefs.Add(FImportedFieldNames[i], fieldType);
+ end;
+ // Create the table and open it
DeleteFile(FImportDataset.FilePathFull + FImportDataset.TableName);
FImportDataset.CreateTable;
FImportDataset.Open;
+ // Now we have to post the cells of the buffered row, otherwise these data
+ // will be lost
+ FImportDataset.Insert;
+ for i:=0 to High(FImportedRowCells) do
+ case FImportedRowCells[i].ContentType of
+ cctNumber : FImportDataset.Fields[i].AsFloat := FImportedRowCells[i].NumberValue;
+ cctDateTime : FImportDataset.Fields[i].AsDateTime := FImportedRowCells[i].DateTimeValue;
+ cctUTF8String: FImportDataset.Fields[i].AsString := FImportedRowCells[i].UTF8StringValue;
+ end;
+ FImportDataset.Post;
+ // Finally we dispose the buffered cells, we don't need them any more
+ SetLength(FImportedRowCells, 0);
end;
end
else
begin
// Now that we know everything we can add the data to the table
+ if ARow mod 25 = 0 then
+ begin
+ InfoLabel3.Caption := Format('Writing row %d to database...', [ARow]);
+ Application.ProcessMessages;
+ end;
+
if ACol = 0 then
FImportDataset.Insert;
case ADataCell^.ContentType of
@@ -367,8 +421,8 @@ begin
cctUTF8String: FImportDataset.Fields[Acol].AsString := ADataCell^.UTF8StringValue;
cctDateTime : FImportDataset.Fields[ACol].AsDateTime := ADataCell^.DateTimeValue;
end;
- if ACol = High(FImportedFieldTypes) then
- FImportDataset.Post;
+ if ACol = FImportedFieldNames.Count-1 then
+ FImportDataset.Post; // We post the data after the last cell of the row has been received.
end;
end;
@@ -386,16 +440,20 @@ begin
FExportDataset.First;
end
else
+ // After the header line we write the record data. Note that we are responsible
+ // for advancing the dataset cursor whenever a row is complete.
begin
AValue := FExportDataset.Fields[ACol].Value;
if FExportDataset.Fields[ACol].DataType = ftDate then
AStyleCell := FDateTemplateCell;
if ACol = FWorkbook.VirtualColCount-1 then
begin
+ // Move to next record after last field has been written
FExportDataset.Next;
- if (ARow-1) mod 25 = 0 then
+ // Progress display
+ if (ARow-1) mod 1000 = 0 then
begin
- InfoLabel1.Caption := Format('Writing record %d...', [ARow-1]);
+ InfoLabel2.Caption := Format('Writing record %d to spreadsheet...', [ARow-1]);
Application.ProcessMessages;
end;
end;
diff --git a/components/fpspreadsheet/examples/db_import_export/readme.txt b/components/fpspreadsheet/examples/db_import_export/readme.txt
index d2a2a6bf2..57e91c828 100644
--- a/components/fpspreadsheet/examples/db_import_export/readme.txt
+++ b/components/fpspreadsheet/examples/db_import_export/readme.txt
@@ -1,11 +1,12 @@
-This example program shows how a large database table can be exported to a
-spreadsheet file using virtual mode.
+This example program shows how a large database table can be exported to and
+imported from a spreadsheet file using virtual mode.
First, run the section 1 to create a dBase file with random data.
Then, in section 2, the dBase file can be converted to any spreadsheet format
-supported.
+supported. Finally, in section 3, another dBase file can be created from a
+selected spreadsheet file.
Please note that this example is mainly educational to show a "real-world"
application of virtual mode, but, strictly speaking, virtual mode would not
be absolutely necessary due to the small number of columns.
-fpspreadsheet.
+
diff --git a/components/fpspreadsheet/tests/optiontests.pas b/components/fpspreadsheet/tests/optiontests.pas
index 68cfdab89..f9ebbd483 100644
--- a/components/fpspreadsheet/tests/optiontests.pas
+++ b/components/fpspreadsheet/tests/optiontests.pas
@@ -37,6 +37,11 @@ type
procedure TestWriteRead_BIFF2_HideGridLines_ShowHeaders;
procedure TestWriteRead_BIFF2_HideGridLines_HideHeaders;
+ procedure TestWriteRead_BIFF2_Panes_HorVert;
+ procedure TestWriteRead_BIFF2_Panes_Hor;
+ procedure TestWriteRead_BIFF2_Panes_Vert;
+ procedure TestWriteRead_BIFF2_Panes_None;
+
{ BIFF5 tests }
procedure TestWriteRead_BIFF5_ShowGridLines_ShowHeaders;
procedure TestWriteRead_BIFF5_ShowGridLines_HideHeaders;
@@ -310,6 +315,28 @@ begin
end;
end;
+{ Tests for BIFF2 frozen panes }
+procedure TSpreadWriteReadOptionsTests.TestWriteRead_BIFF2_Panes_HorVert;
+begin
+ TestWriteReadPanes(sfExcel2, 1, 2);
+end;
+
+procedure TSpreadWriteReadOptionsTests.TestWriteRead_BIFF2_Panes_Hor;
+begin
+ TestWriteReadPanes(sfExcel2, 1, 0);
+end;
+
+procedure TSpreadWriteReadOptionsTests.TestWriteRead_BIFF2_Panes_Vert;
+begin
+ TestWriteReadPanes(sfExcel2, 0, 2);
+end;
+
+procedure TSpreadWriteReadOptionsTests.TestWriteRead_BIFF2_Panes_None;
+begin
+ TestWriteReadPanes(sfExcel2, 0, 0);
+end;
+
+
{ Tests for BIFF5 frozen panes }
procedure TSpreadWriteReadOptionsTests.TestWriteRead_BIFF5_Panes_HorVert;
begin
diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas
index c98f7aecc..8e68ea21b 100755
--- a/components/fpspreadsheet/xlsbiff2.pas
+++ b/components/fpspreadsheet/xlsbiff2.pas
@@ -54,7 +54,6 @@ type
TsSpreadBIFF2Reader = class(TsSpreadBIFFReader)
private
WorkBookEncoding: TsEncoding;
- FWorksheet: TsWorksheet;
FFont: TsFont;
protected
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); override;