fpspreadsheet: Complete database import demo. Rename dbexport to db_export_import. Fix biff2 crashing in ReadPane because of duplicate variable FWorksheet.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3434 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/db_import_export/db_export_import.lpi

@@ -6,7 +6,7 @@
     <General>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <Title Value="dbexport"/>
+      <Title Value="db_export_import"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
     </General>
@@ -37,7 +37,7 @@
     </RequiredPackages>
     <Units Count="2">
       <Unit0>
-        <Filename Value="dbexport.lpr"/>
+        <Filename Value="db_export_import.lpr"/>
         <IsPartOfProject Value="True"/>
       </Unit0>
       <Unit1>
@@ -54,7 +54,7 @@
     <Version Value="11"/>
     <PathDelim Value="\"/>
     <Target>
-      <Filename Value="dbexport"/>
+      <Filename Value="db_export_import"/>
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>

components/fpspreadsheet/examples/db_import_export/db_export_import.lpr

@@ -1,4 +1,4 @@
-program dbexport;
+program db_export_import;
 
 {$mode objfpc}{$H+}
 

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
+  ClientHeight = 310
-  ClientWidth = 450
+  ClientWidth = 639
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   LCLVersion = '1.3'
   object PageControl: TPageControl
     Left = 4
-    Height = 228
+    Height = 302
     Top = 4
-    Width = 442
+    Width = 631
-    ActivePage = TabImport
+    ActivePage = TabDataGenerator
     Align = alClient
     BorderSpacing.Around = 4
-    TabIndex = 2
+    TabIndex = 0
     TabOrder = 0
     OnChange = PageControlChange
     object TabDataGenerator: TTabSheet
       Caption = '1 - Create database'
-      ClientHeight = 200
+      ClientHeight = 269
-      ClientWidth = 434
+      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
+        Height = 241
-        Top = 23
+        Top = 28
-        Width = 434
+        Width = 623
         Align = alClient
         BevelOuter = bvNone
-        ClientHeight = 177
+        ClientHeight = 241
-        ClientWidth = 434
+        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
+          Left = 515
-          Height = 25
+          Height = 28
-          Top = 123
+          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
+          Left = 8
-          Height = 15
+          Height = 20
-          Top = 158
+          Top = 216
-          Width = 426
+          Width = 496
-          Align = alBottom
+          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
+      ClientHeight = 269
-      ClientWidth = 434
+      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
+        Top = 28
-        Width = 434
+        Width = 623
         Align = alTop
         Shape = bsTopLine
       end
       object InfoLabel2: TLabel
-        Left = 4
+        Left = 8
-        Height = 15
+        Height = 20
-        Top = 181
+        Top = 244
-        Width = 426
+        Width = 504
-        Align = alBottom
+        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
+        ClientHeight = 136
-        ClientWidth = 181
+        ClientWidth = 228
         ItemIndex = 2
         Items.Strings = (
           'xls (Excel 2)'
@@ -162,9 +162,9 @@ object Form1: TForm1
         TabOrder = 0
       end
       object BtnExport: TButton
-        Left = 326
+        Left = 515
-        Height = 25
+        Height = 28
-        Top = 147
+        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
+      ClientHeight = 269
-      ClientWidth = 434
+      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
+        Top = 28
-        Width = 434
+        Width = 623
         Align = alTop
         Shape = bsTopLine
       end
       object InfoLabel3: TLabel
-        Left = 4
+        Left = 8
-        Height = 15
+        Height = 20
-        Top = 181
+        Top = 244
-        Width = 426
+        Width = 70
-        Align = alBottom
+        Anchors = [akLeft, akBottom]
         BorderSpacing.Around = 4
         Caption = 'InfoLabel3'
         ParentColor = False
       end
       object BtnImport: TButton
-        Left = 326
+        Left = 515
-        Height = 25
+        Height = 28
-        Top = 147
+        Top = 236
         Width = 99
         Anchors = [akRight, akBottom]
         Caption = 'Run'
+        Enabled = False
         OnClick = BtnImportClick
         TabOrder = 0
       end
       object FileList: TListBox
-        Left = 6
+        Left = 8
-        Height = 121
+        Height = 181
         Top = 56
         Width = 292
+        Anchors = [akTop, akLeft, akBottom]
         ItemHeight = 0
+        OnClick = FileListClick
         TabOrder = 1
       end
       object Label3: TLabel
-        Left = 5
+        Left = 8
-        Height = 15
+        Height = 20
         Top = 33
-        Width = 221
+        Width = 282
         Caption = 'Select the spreadsheet file to be imported:'
         ParentColor = False
       end

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
+    // Make header line frozen - but not in Excel2 where frozen panes do not yet work properly
-    worksheet.Options := worksheet.Options + [soHasFrozenPanes];
+    if FILE_FORMATS[RgFileFormat.ItemIndex] <> sfExcel2 then begin
-    worksheet.TopPaneHeight := 1;
+      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
+  // ... and this array will temporarily store the cells of the second row
-  // to create the dbf table.
+  // until we have all information to create the dbf table.
-  SetLength(FImportedFieldTypes, 0);
+  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.
+  ADataCell has just been read from the spreadsheet file, but will not be added
-  This event handler picks the data and posts them to the database table.
+  to the workbook and will be discarded. The event handler, however, can pick
-  Note that we do not make many assumptions on the data structure here. Therefore
+  the data and post them to the database table.
-  we have to buffer the first two rows of the spreadsheet file until the
+  Note that we do not make too many assumptions on the data structure here.
-  structure of the table is clear. }
+  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
+    if Length(FImportedRowCells) = 0 then
-      SetLength(FImportedFieldTypes, FImportedFieldNames.Count);
+      SetLength(FImportedRowCells, FImportedFieldNames.Count);
-    case ADataCell^.ContentType of
+    FImportedRowCells[ACol] := ADataCell^;
-      cctNumber    : FImportedFieldTypes[ACol] := ftFloat;
+    // The row is read completely, all field types are known --> we create the table
-      cctUTF8String: FImportedFieldTypes[ACol] := ftString;
+    if ACol = High(FImportedRowCells) then begin
-      cctDateTime  : FImportedFieldTypes[ACol] := ftDate;
+      // Add fields - the required information is stored in FImportedFieldNames
-    end;
+      // and FImportedFieldTypes
-    // All field types are known --> we create the table
+      for i:=0 to High(FImportedRowCells) do begin
-    if ACol = High(FImportedFieldTypes) then begin
+        case FImportedRowCells[i].ContentType of
-      for i:=0 to High(FImportedFieldTypes) do
+          cctNumber     : fieldType := ftFloat;
-        FImportDataset.FieldDefs.Add(FImportedFieldNames[i], FImportedFieldTypes[i]);
+          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
+    if ACol = FImportedFieldNames.Count-1 then
-      FImportDataset.Post;
+      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;

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 
+This example program shows how a large database table can be exported to and 
-spreadsheet file using virtual mode. 
+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.
+

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

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;