fpspreadsheet: Add a ftFloat field and TBufDataset to db_import_export demo

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

components/fpspreadsheet/examples/db_import_export/db_export_import.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <PathDelim Value="\"/>
     <General>
       <SessionStorage Value="InProjectDir"/>

components/fpspreadsheet/examples/db_import_export/main.lfm

@@ -61,16 +61,16 @@ object Form1: TForm1
           Width = 64
           Alignment = taRightJustify
           TabOrder = 0
-          Text = '50000'
+          Text = '5000'
         end
-        object BtnCreateDbf: TButton
+        object BtnCreateDatabase: TButton
           Left = 397
           Height = 28
           Top = 218
           Width = 99
           Anchors = [akRight, akBottom]
           Caption = 'Run'
-          OnClick = BtnCreateDbfClick
+          OnClick = BtnCreateDatabaseClick
           TabOrder = 1
         end
         object Bevel1: TBevel
@@ -99,6 +99,30 @@ object Form1: TForm1
           Caption = 'Please note: the binary xls files can handle only 65536 records.'
           ParentColor = False
         end
+        object RgDatabaseType: TRadioGroup
+          Left = 9
+          Height = 45
+          Top = 67
+          Width = 185
+          AutoFill = True
+          Caption = 'Database type'
+          ChildSizing.LeftRightSpacing = 6
+          ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+          ChildSizing.EnlargeVertical = crsHomogenousChildResize
+          ChildSizing.ShrinkHorizontal = crsScaleChilds
+          ChildSizing.ShrinkVertical = crsScaleChilds
+          ChildSizing.Layout = cclLeftToRightThenTopToBottom
+          ChildSizing.ControlsPerLine = 2
+          ClientHeight = 25
+          ClientWidth = 181
+          Columns = 2
+          ItemIndex = 0
+          Items.Strings = (
+            'dbf'
+            'BufDataset'
+          )
+          TabOrder = 2
+        end
       end
     end
     object TabExport: TTabSheet
@@ -159,6 +183,7 @@ object Form1: TForm1
           'xlsx (Excel 2007 and later)'
           'ods'
         )
+        OnSelectionChanged = RgFileFormatSelectionChanged
         TabOrder = 0
       end
       object BtnExport: TButton
@@ -249,6 +274,7 @@ object Form1: TForm1
         Anchors = [akTop, akLeft, akBottom]
         ItemHeight = 0
         OnClick = FileListClick
+        Options = [lboDrawFocusRect]
         TabOrder = 1
       end
       object Label3: TLabel

components/fpspreadsheet/examples/db_import_export/main.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  ComCtrls, ExtCtrls, db, dbf,
+  ComCtrls, ExtCtrls, db, dbf, BufDataset,
   fpstypes, fpspreadsheet, fpsallformats, fpsexport;
 
 type
@@ -17,7 +17,7 @@ type
     Bevel1: TBevel;
     Bevel2: TBevel;
     Bevel3: TBevel;
-    BtnCreateDbf: TButton;
+    BtnCreateDatabase: TButton;
     BtnExport: TButton;
     BtnImport: TButton;
     EdRecordCount: TEdit;
@@ -33,25 +33,28 @@ type
     Label3: TLabel;
     PageControl: TPageControl;
     Panel1: TPanel;
+    RgDatabaseType: TRadioGroup;
     RgFileFormat: TRadioGroup;
     RgExportMode: TRadioGroup;
     TabDataGenerator: TTabSheet;
     TabExport: TTabSheet;
     TabImport: TTabSheet;
-    procedure BtnCreateDbfClick(Sender: TObject);
+    procedure BtnCreateDatabaseClick(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);
+    procedure RgFileFormatSelectionChanged(Sender: TObject);
   private
     { private declarations }
-    FExportDataset: TDbf;
+    FExportDataset: TDataset;
     FImportDataset: TDbf;
     FWorkbook: TsWorkbook;
     FHeaderTemplateCell: PCell;
     FDateTemplateCell: PCell;
+    FCurrencyTemplatecell: PCell;
     FImportedFieldNames: TStringList;
     FImportedRowCells: Array of TCell;
     // Actual export code when using FPSpreadsheet's fpsexport:
@@ -82,6 +85,9 @@ implementation
 
 {$R *.lfm}
 
+uses
+  fpsNumFormat;
+
 type
   // Ways to export dbf/dataset. Corresponds to the items
   // of the RgExportMode radiogroup
@@ -106,7 +112,7 @@ const
     'New York', 'Los Angeles', 'San Francisco', 'Chicago', 'Miami',
     'New Orleans', 'Washington', 'Boston', 'Seattle', 'Las Vegas');
 
-  TABLENAME = 'people.dbf'; //name for the dbf table
+  TABLENAME = 'people'; //name for the database table, extension will be added
   DATADIR = 'data'; //subdirectory where .dbf is stored
 
   // File formats corresponding to the items of the RgFileFormat radiogroup
@@ -117,17 +123,21 @@ const
   // 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');
+  // Extension of database files supported
+  DB_EXT: array[0..1] of string = (
+    '.dbf', '.db');
 
 
 { TForm1 }
 
 { This procedure creates a test dbf table with random data for us to play with }
-procedure TForm1.BtnCreateDbfClick(Sender: TObject);
+procedure TForm1.BtnCreateDatabaseClick(Sender: TObject);
 var
   i: Integer;
   startDate: TDate;
   maxAge: Integer = 80 * 365;
   f: TField;
+  fn: String;
 begin
   if FExportDataset <> nil then
     FExportDataset.Free;
@@ -135,11 +145,21 @@ begin
   ForceDirectories(DATADIR);
   startDate := EncodeDate(2010, 8, 1);
 
+  fn := DATADIR + DirectorySeparator + TABLENAME + DB_EXT[RgDatabaseType.itemIndex];
+  case RgDatabaseType.ItemIndex of
+    0: begin
          FExportDataset := TDbf.Create(self);
-  FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
+         TDbf(FExportDataset).FilePathFull := ExtractFilePath(fn);
-  FExportDataset.TableName := TABLENAME;
+         TDbf(FExportDataset).TableName := ExtractFileName(fn);
-  FExportDataset.TableLevel := 4;  // DBase IV: most widely used.
+//         TDbf(FExportDataset).TableLevel := 4;  // DBase IV: most widely used.
-  FExportDataset.TableLevel := 25;   // FoxPro supports FieldType nfCurrency
+         TDbf(FExportDataset).TableLevel := 25;   // FoxPro supports FieldType nfCurrency
+       end;
+    1: begin
+         FExportDataset := TBufDataset.Create(self);
+         TBufDataset(FExportDataset).Filename := fn;
+       end;
+    2: raise Exception.Create('Database type not supported');
+  end;
   FExportDataset.FieldDefs.Add('Last name', ftString);
   FExportDataset.FieldDefs.Add('First name', ftString);
   FExportDataset.FieldDefs.Add('City', ftString);
@@ -147,8 +167,12 @@ begin
   FExportDataset.FieldDefs.Add('Salary', ftCurrency);
   FExportDataset.FieldDefs.Add('Work begin', ftDateTime);
   FExportDataset.FieldDefs.Add('Work end', ftDateTime);
-  DeleteFile(FExportDataset.FilePathFull + FExportDataset.TableName);
+  FExportDataset.FieldDefs.Add('Size', ftFloat);
-  FExportDataset.CreateTable;
+  DeleteFile(fn);
+  case RgDatabaseType.ItemIndex of
+    0: TDbf(FExportDataset).CreateTable;
+    1: TBufDataset(FExportDataset).CreateDataset;
+  end;
 
   FExportDataset.Open;
   // We generate random records by combining first names, last names and cities
@@ -158,6 +182,8 @@ begin
   for i:=1 to StrToInt(EdRecordCount.Text) do begin
     if (i mod 1000 = 0) then
     begin
+      if FExportDataset is TBufDataset then
+        TBufDataset(FExportDataset).MergeChangeLog;
       InfoLabel1.Caption := Format('Adding record %d...', [i]);
       Application.ProcessMessages;
     end;
@@ -167,14 +193,16 @@ begin
     FExportDataset.FieldByName('City').AsString := CITIES[Random(NUM_CITIES)];
     FExportDataset.FieldByName('Birthday').AsDateTime := startDate - random(maxAge);
     FExportDataset.FieldByName('Salary').AsFloat := 1000+Random(9000);
-//    FExportDataSet.FieldByName('Work begin').AsDateTime := 40000+EncodeTime(6+Random(4), Random(60), Random(60), 0);
+    FExportDataset.FieldByName('Size').AsFloat := (160 + Random(50)) / 100;
-//    FExportDataSet.FieldByName('Work end').AsDateTime := EncodeTime(15+Random(4), Random(60), Random(60), 0);
+    FExportDataSet.FieldByName('Work begin').AsDateTime := 40000+EncodeTime(6+Random(4), Random(60), Random(60), 0);
+    FExportDataSet.FieldByName('Work end').AsDateTime := EncodeTime(15+Random(4), Random(60), Random(60), 0);
     FExportDataset.Post;
   end;
+
   FExportDataset.Close;
 
   InfoLabel1.Caption := Format('Done. Created file "%s" in folder "data".', [
-    FExportDataset.TableName, FExportDataset.FilePathFull
+    ExtractFileName(fn), ExtractFileDir(fn)
   ]);
   InfoLabel2.Caption := '';
   InfoLabel3.Caption := '';
@@ -191,18 +219,27 @@ begin
   InfoLabel2.Caption := '';
   Application.ProcessMessages;
 
+  DataFileName := DATADIR + DirectorySeparator + TABLENAME + DB_EXT[RgDatabaseType.ItemIndex];;
   if FExportDataset = nil then
   begin
+    case RgDatabaseType.ItemIndex of
+      0: begin
            FExportDataset := TDbf.Create(self);
-    FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
+           TDbf(FExportDataset).FilePathFull := ExtractFilePath(DatafileName);
-    FExportDataset.TableName := TABLENAME;
+           TDbf(FExportDataset).TableName := ExtractFileName(DatafileName);
+         end;
+      1: begin
+           FExportDataset := TBufDataset.Create(self);
+           TBufDataset(FExportDataset).FileName := DatafileName;
+         end;
+      else
+        raise Exception.Create('Database type not supported.');
+    end;
   end;
 
-  DataFileName := FExportDataset.FilePathFull + FExportDataset.TableName;
   if not FileExists(DataFileName) then
   begin
-    MessageDlg(Format('Database file "%s" not found. Please run "Create '
+    MessageDlg(Format('Database file "%s" not found. Please run "Create database" first.',
-      +'database" first.',
       [DataFileName]), mtError, [mbOK], 0);
     exit;
   end;
@@ -229,7 +266,7 @@ begin
   end;
 
   InfoLabel2.Caption := Format('Done. Database exported to file "%s" in folder "%s"', [
-    ChangeFileExt(FExportDataset.TableName, FILE_EXT[RgFileFormat.ItemIndex]),
+    ChangeFileExt(ExtractFileName(DataFileName), FILE_EXT[RgFileFormat.ItemIndex]),
     DATADIR
   ]);
 end;
@@ -283,7 +320,7 @@ begin
       FImportDataset.Free;
     FImportDataset := TDbf.Create(self);
     FImportDataset.FilePathFull := DATADIR + DirectorySeparator;
-    FImportDataset.TableName := 'imported_' + TABLENAME;
+    FImportDataset.TableName := 'imported_' + TABLENAME + '.dbf';
     FImportDataset.TableLevel := 4; //DBase IV; most widely used.
     DeleteFile(FImportDataset.FilePathFull + FImportDataset.TableName);
 
@@ -378,14 +415,14 @@ begin
       Exporter.ExportFields.AddField('Birthday');
       Exporter.Execute;
 
-      // On the second sheet we want "Last name", "First name" and "Income"
+      // On the third sheet we want "Last name", "First name" and "Income"
       Exporter.ExportFields.Clear;
       Exporter.ExportFields.AddField('Last name');
       Exporter.ExportFields.AddField('First name');
       Exporter.ExportFields.AddField('Salary');
       Exporter.Execute;
 
-      // On the second sheet we want "Last name", "First name" and "Work begin/end times"
+      // On the 4th sheet we want "Last name", "First name" and "Work begin/end times"
       Exporter.ExportFields.Clear;
       Exporter.ExportFields.AddField('Last name');
       Exporter.ExportFields.AddField('First name');
@@ -393,6 +430,13 @@ begin
       Exporter.ExportFields.AddField('Work end');
       Exporter.Execute;
 
+      // On the 5th sheet we want "Last name", "First name" and "Size"
+      Exporter.ExportFields.Clear;
+      Exporter.ExportFields.AddField('Last name');
+      Exporter.ExportFields.AddField('First name');
+      Exporter.ExportFields.AddField('Size');
+      Exporter.Execute;
+
       // Export complete --> we can write to file
       Exporter.WriteExportFile;
     end
@@ -433,7 +477,7 @@ var
 begin
   if PageControl.ActivePage = TabImport then begin
     FileList.Clear;
-    if FindFirst(DATADIR + DirectorySeparator + ChangeFileExt(TABLENAME, '') + '*.*', faAnyFile, sr) = 0
+    if FindFirst(DATADIR + DirectorySeparator + TABLENAME + '*.*', faAnyFile, sr) = 0
     then begin
       repeat
         if (sr.Name = '.') or (sr.Name = '..') then
@@ -451,6 +495,7 @@ end;
 procedure TForm1.ExportUsingVirtualMode(var DataFileName: string);
 var
   worksheet: TsWorksheet;
+  tablename: String;
 begin
   {
   if FILE_FORMATS[RgFileFormat.ItemIndex] = sfOpenDocument then
@@ -461,9 +506,15 @@ begin
    }
   FExportDataset.Open;
 
+  case RgDatabaseType.ItemIndex of
+    0: tablename := TDbf(FExportDataset).TableName;
+    1: tablename := ExtractFilename(TBufDataset(FExportDataset).FileName);
+    else raise Exception.Create('Database type not supported.');
+  end;
+
   FWorkbook := TsWorkbook.Create;
   try
-    worksheet := FWorkbook.AddWorksheet(FExportDataset.TableName);
+    worksheet := FWorkbook.AddWorksheet(tableName);
 
     // Make header line frozen - but not in Excel2 where frozen panes do not yet work properly
     if FILE_FORMATS[RgFileFormat.ItemIndex] <> sfExcel2 then begin
@@ -482,6 +533,10 @@ begin
     FDateTemplateCell := worksheet.GetCell(0, 1);
     worksheet.WriteDateTimeFormat(FDateTemplateCell, nfShortDate);
 
+    // Use cell C1 as format template of currency column
+    FCurrencyTemplateCell := worksheet.GetCell(0, 2);
+    worksheet.WriteNumberFormat(FCurrencyTemplateCell, nfCurrency);
+
     // Make rows a bit wider
     worksheet.WriteColWidth(0, 20);
     worksheet.WriteColWidth(1, 20);
@@ -514,6 +569,7 @@ begin
     1: ASheetName := 'Birthday';
     2: ASheetName := 'Salary';
     3: ASheetName := 'Work time';
+    4: ASheetName := 'Size';
   end;
 end;
 
@@ -529,6 +585,8 @@ procedure TForm1.ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
 var
   i: Integer;
   fieldType: TFieldType;
+  fmt: TsCellFormat;
+  nfp: TsNumFormatParams;
 begin
   // The first row (index 0) holds the field names. We temporarily store the
   // field names in a stringlist because we don't know the data types of the
@@ -550,8 +608,11 @@ begin
       // Add fields - the required information is stored in FImportedFieldNames
       // and FImportedFieldTypes
       for i:=0 to High(FImportedRowCells) do begin
+        fmt := TsWorksheet(ADataCell^.Worksheet).ReadCellFormat(ADataCell);
+        nfp := FWorkbook.GetNumberFormat(fmt.NumberFormatIndex);
         case FImportedRowCells[i].ContentType of
-          cctNumber     : fieldType := ftFloat;
+          cctNumber     : if IsCurrencyFormat(nfp) then fieldType := ftCurrency
+                            else fieldType := ftFloat;
           cctDateTime   : fieldType := ftDateTime;
           cctUTF8String : fieldType := ftString;
         end;
@@ -596,6 +657,11 @@ begin
   end;
 end;
 
+procedure TForm1.RgFileFormatSelectionChanged(Sender: TObject);
+begin
+  RgExportMode.Controls[2].Enabled := RgFileFormat.ItemIndex <> 0;
+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. }
@@ -615,7 +681,10 @@ begin
   begin
     AValue := FExportDataset.Fields[ACol].Value;
     if FExportDataset.Fields[ACol].DataType = ftDate then
-      AStyleCell := FDateTemplateCell;
+      AStyleCell := FDateTemplateCell
+    else if FExportDataset.Fields[ACol].DataType = ftCurrency then
+      AStyleCell := FCurrencyTemplateCell;
+
     if ACol = Sender.VirtualColCount-1 then
     begin
       // Move to next record after last field has been written