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

components/fpspreadsheet/examples/db_import_export/dbexport.lpi

@@ -9,7 +9,6 @@
       <Title Value="dbexport"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>

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
+  Width = 450
-  Caption = 'Form1'
+  Caption = 'db_Export_Import'
-  ClientHeight = 229
+  ClientHeight = 236
-  ClientWidth = 404
+  ClientWidth = 450
   OnCreate = FormCreate
+  OnDestroy = FormDestroy
   LCLVersion = '1.3'
   object PageControl: TPageControl
     Left = 4
-    Height = 221
+    Height = 228
     Top = 4
-    Width = 396
+    Width = 442
-    ActivePage = TabSheet1
+    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
+      ClientHeight = 200
-      ClientWidth = 388
+      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
+        ClientHeight = 177
-        ClientWidth = 388
+        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
+          Top = 158
-          Width = 380
+          Width = 426
           Align = alBottom
           BorderSpacing.Around = 4
           Caption = 'InfoLabe1'
@@ -99,15 +101,15 @@ object Form1: TForm1
         end
       end
     end
-    object TabSheet2: TTabSheet
+    object TabExport: TTabSheet
-      Caption = '2 - Write to spreadsheet'
+      Caption = '2 - Export to spreadsheet'
-      ClientHeight = 193
+      ClientHeight = 200
-      ClientWidth = 388
+      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
+        Top = 181
-        Width = 380
+        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

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;
+    TabDataGenerator: TTabSheet;
-    TabSheet2: 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
+  if FExportDataset <> nil then
-    FDataset.Free;
+    FExportDataset.Free;
 
   ForceDirectories(DATADIR);
   startDate := EncodeDate(2010, 8, 1);
 
-  FDataset := TDbf.Create(self);
+  FExportDataset := TDbf.Create(self);
-  FDataset.FilePathFull := DATADIR + DirectorySeparator;
+  FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
-  FDataset.TableName := TABLENAME;
+  FExportDataset.TableName := TABLENAME;
-  FDataset.TableLevel := 4; //DBase IV; most widely used.
+  FExportDataset.TableLevel := 4; //DBase IV; most widely used.
-  FDataset.FieldDefs.Add('Last name', ftString);
+  FExportDataset.FieldDefs.Add('Last name', ftString);
-  FDataset.FieldDefs.Add('First name', ftString);
+  FExportDataset.FieldDefs.Add('First name', ftString);
-  FDataset.FieldDefs.Add('City', ftString);
+  FExportDataset.FieldDefs.Add('City', ftString);
-  FDataset.FieldDefs.Add('Birthday', ftDateTime);
+  FExportDataset.FieldDefs.Add('Birthday', ftDateTime);
-  DeleteFile(FDataset.FilePathFull + FDataset.TableName);
+  DeleteFile(FExportDataset.FilePathFull + FExportDataset.TableName);
-  FDataset.CreateTable;
+  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;
+    FExportDataset.Insert;
-    FDataset.FieldByName('Last name').AsString := LAST_NAMES[Random(NUM_LAST_NAMES)];
+    FExportDataset.FieldByName('Last name').AsString := LAST_NAMES[Random(NUM_LAST_NAMES)];
-    FDataset.FieldByName('First name').AsString := FIRST_NAMES[Random(NUM_FIRST_NAMES)];
+    FExportDataset.FieldByName('First name').AsString := FIRST_NAMES[Random(NUM_FIRST_NAMES)];
-    FDataset.FieldByName('City').AsString := CITIES[Random(NUM_CITIES)];
+    FExportDataset.FieldByName('City').AsString := CITIES[Random(NUM_CITIES)];
-    FDataset.FieldByName('Birthday').AsDateTime := startDate - random(maxAge);
+    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);
+    FExportDataset := TDbf.Create(self);
-    FDataset.FilePathFull := DATADIR + DirectorySeparator;
+    FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
-    FDataset.TableName := TABLENAME;
+    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.VirtualRowCount := FExportDataset.RecordCount + 1;  // +1 for the header line
-    FWorkbook.VirtualColCount := FDataset.FieldCount;
+    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"',
+  InfoLabel2.Caption := Format('Done. Database exported to file "%s" in folder "%s"', [
-    [ChangeFileExt(FDataset.TableName, EXT[RgFileFormat.ItemIndex]), FDataset.FilePathFull]);
+    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;
+    AValue := FExportDataset.Fields[ACol].Value;
-    if FDataset.Fields[ACol].DataType = ftDate then
+    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]);