From 098b7daf326d8f1797b94074c2645302a010b73f Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 19 Dec 2014 21:45:44 +0000 Subject: [PATCH] fpspreadsheet: FPSExport tries to determine cell format from the exported database field types. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3845 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/db_import_export/main.lfm | 104 +++++++++--------- .../examples/db_import_export/main.pas | 33 +++++- components/fpspreadsheet/fpsexport.pas | 36 ++++-- 3 files changed, 104 insertions(+), 69 deletions(-) diff --git a/components/fpspreadsheet/examples/db_import_export/main.lfm b/components/fpspreadsheet/examples/db_import_export/main.lfm index eff471bc1..4daba6db2 100644 --- a/components/fpspreadsheet/examples/db_import_export/main.lfm +++ b/components/fpspreadsheet/examples/db_import_export/main.lfm @@ -2,10 +2,10 @@ object Form1: TForm1 Left = 340 Height = 310 Top = 154 - Width = 639 + Width = 521 Caption = 'db_Export_Import' ClientHeight = 310 - ClientWidth = 639 + ClientWidth = 521 OnCreate = FormCreate OnDestroy = FormDestroy LCLVersion = '1.3' @@ -13,22 +13,22 @@ object Form1: TForm1 Left = 4 Height = 302 Top = 4 - Width = 631 - ActivePage = TabExport + Width = 513 + ActivePage = TabDataGenerator Align = alClient BorderSpacing.Around = 4 - TabIndex = 1 + TabIndex = 0 TabOrder = 0 OnChange = PageControlChange object TabDataGenerator: TTabSheet Caption = '1 - Create database' - ClientHeight = 269 - ClientWidth = 623 + ClientHeight = 274 + ClientWidth = 505 object Label2: TLabel Left = 4 - Height = 20 + Height = 15 Top = 4 - Width = 615 + Width = 497 Align = alTop BorderSpacing.Around = 4 Caption = 'Create a database with random records' @@ -38,25 +38,25 @@ object Form1: TForm1 end object Panel1: TPanel Left = 0 - Height = 241 - Top = 28 - Width = 623 + Height = 251 + Top = 23 + Width = 505 Align = alClient BevelOuter = bvNone - ClientHeight = 241 - ClientWidth = 623 + ClientHeight = 251 + ClientWidth = 505 TabOrder = 0 object HeaderLabel1: TLabel Left = 8 - Height = 20 + Height = 15 Top = 11 - Width = 88 + Width = 71 Caption = 'Record count' ParentColor = False end object EdRecordCount: TEdit Left = 107 - Height = 28 + Height = 23 Top = 8 Width = 64 Alignment = taRightJustify @@ -64,9 +64,9 @@ object Form1: TForm1 Text = '50000' end object BtnCreateDbf: TButton - Left = 515 + Left = 397 Height = 28 - Top = 208 + Top = 218 Width = 99 Anchors = [akRight, akBottom] Caption = 'Run' @@ -77,15 +77,15 @@ object Form1: TForm1 Left = 0 Height = 3 Top = 0 - Width = 623 + Width = 505 Align = alTop Shape = bsTopLine end object InfoLabel1: TLabel Left = 8 - Height = 20 - Top = 216 - Width = 496 + Height = 15 + Top = 231 + Width = 378 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Around = 4 Caption = 'InfoLabel1' @@ -93,9 +93,9 @@ object Form1: TForm1 end object Label1: TLabel Left = 8 - Height = 20 + Height = 15 Top = 40 - Width = 409 + Width = 324 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 = 269 - ClientWidth = 623 + ClientHeight = 274 + ClientWidth = 505 object HeaderLabel2: TLabel Left = 4 - Height = 20 + Height = 15 Top = 4 - Width = 615 + Width = 497 Align = alTop BorderSpacing.Around = 4 Caption = 'Export database table to spreadsheet file' @@ -120,16 +120,16 @@ object Form1: TForm1 object Bevel2: TBevel Left = 0 Height = 3 - Top = 28 - Width = 623 + Top = 23 + Width = 505 Align = alTop Shape = bsTopLine end object InfoLabel2: TLabel Left = 8 - Height = 20 - Top = 244 - Width = 504 + Height = 15 + Top = 254 + Width = 386 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Around = 4 Caption = 'InfoLabel2' @@ -149,7 +149,7 @@ object Form1: TForm1 ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 133 + ClientHeight = 138 ClientWidth = 228 ItemIndex = 2 Items.Strings = ( @@ -162,9 +162,9 @@ object Form1: TForm1 TabOrder = 0 end object BtnExport: TButton - Left = 515 + Left = 397 Height = 28 - Top = 236 + Top = 241 Width = 99 Anchors = [akRight, akBottom] Caption = 'Run' @@ -185,7 +185,7 @@ object Form1: TForm1 ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 133 + ClientHeight = 138 ClientWidth = 228 ItemIndex = 0 Items.Strings = ( @@ -198,13 +198,13 @@ object Form1: TForm1 end object TabImport: TTabSheet Caption = '3 - Import from spreadsheet' - ClientHeight = 276 - ClientWidth = 623 + ClientHeight = 274 + ClientWidth = 505 object HeaderLabel3: TLabel Left = 4 - Height = 13 + Height = 15 Top = 4 - Width = 615 + Width = 497 Align = alTop BorderSpacing.Around = 4 Caption = 'Import spreadsheet file in database table' @@ -215,25 +215,25 @@ object Form1: TForm1 object Bevel3: TBevel Left = 0 Height = 3 - Top = 21 - Width = 623 + Top = 23 + Width = 505 Align = alTop Shape = bsTopLine end object InfoLabel3: TLabel Left = 8 - Height = 13 - Top = 258 - Width = 51 + Height = 15 + Top = 254 + Width = 55 Anchors = [akLeft, akBottom] BorderSpacing.Around = 4 Caption = 'InfoLabel3' ParentColor = False end object BtnImport: TButton - Left = 515 + Left = 397 Height = 28 - Top = 243 + Top = 241 Width = 99 Anchors = [akRight, akBottom] Caption = 'Run' @@ -243,7 +243,7 @@ object Form1: TForm1 end object FileList: TListBox Left = 8 - Height = 188 + Height = 186 Top = 56 Width = 292 Anchors = [akTop, akLeft, akBottom] @@ -253,9 +253,9 @@ object Form1: TForm1 end object Label3: TLabel Left = 8 - Height = 13 + Height = 15 Top = 33 - Width = 205 + Width = 221 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 d4d87004b..79db4d7ef 100644 --- a/components/fpspreadsheet/examples/db_import_export/main.pas +++ b/components/fpspreadsheet/examples/db_import_export/main.pas @@ -136,11 +136,15 @@ begin FExportDataset := TDbf.Create(self); FExportDataset.FilePathFull := DATADIR + DirectorySeparator; FExportDataset.TableName := TABLENAME; - FExportDataset.TableLevel := 4; //DBase IV; most widely used. +// FExportDataset.TableLevel := 4; // DBase IV: most widely used. + FExportDataset.TableLevel := 25; // FoxPro supports FieldType nfCurrency FExportDataset.FieldDefs.Add('Last name', ftString); FExportDataset.FieldDefs.Add('First name', ftString); FExportDataset.FieldDefs.Add('City', ftString); - FExportDataset.FieldDefs.Add('Birthday', ftDateTime); + FExportDataset.FieldDefs.Add('Birthday', ftDate); + FExportDataset.FieldDefs.Add('Salary', ftCurrency); + FExportDataset.FieldDefs.Add('Work begin', ftDateTime); + FExportDataset.FieldDefs.Add('Work end', ftDateTime); DeleteFile(FExportDataset.FilePathFull + FExportDataset.TableName); FExportDataset.CreateTable; @@ -159,7 +163,9 @@ begin 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 + FExportDataset.FieldByName('Salary').AsFloat := 1000+Random(9000); + FExportDataSet.FieldByName('Work begin').AsDateTime := 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; @@ -369,6 +375,21 @@ begin Exporter.ExportFields.AddField('Birthday'); Exporter.Execute; + // On the second 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" + Exporter.ExportFields.Clear; + Exporter.ExportFields.AddField('Last name'); + Exporter.ExportFields.AddField('First name'); + Exporter.ExportFields.AddField('Work begin'); + Exporter.ExportFields.AddField('Work end'); + Exporter.Execute; + // Export complete --> we can write to file Exporter.WriteExportFile; end @@ -485,8 +506,10 @@ procedure TForm1.ExporterGetSheetNameHandler(Sender: TObject; ASheetIndex: Integ var ASheetName: String); begin case ASheetIndex of - 0: ASheetName := 'Cities'; - 1: ASheetName := 'Birthdays'; + 0: ASheetName := 'City'; + 1: ASheetName := 'Birthday'; + 2: ASheetName := 'Salary'; + 3: ASheetName := 'Work time'; end; end; diff --git a/components/fpspreadsheet/fpsexport.pas b/components/fpspreadsheet/fpsexport.pas index afaa0709b..b31e67089 100644 --- a/components/fpspreadsheet/fpsexport.pas +++ b/components/fpspreadsheet/fpsexport.pas @@ -134,7 +134,7 @@ end; destructor TCustomFPSExport.Destroy; begin - // Last chance to save file if calling WriteExportFile has been forgottem + // Last chance to save file if calling WriteExportFile has been forgotten // in case of multiple sheets. if FMultipleSheets and (FSpreadsheet <> nil) then begin @@ -290,32 +290,44 @@ end; procedure TCustomFPSExport.ExportField(EF: TExportFieldItem); var F : TFPSExportFieldItem; + dt: TDateTime; begin - F:=EF as TFPSExportFieldItem; + F := EF as TFPSExportFieldItem; with F do begin // Export depending on field datatype; // Fall back to string if unknown datatype If Field.IsNull then - FSheet.WriteUTF8Text(FRow,EF.Index,'') + FSheet.WriteBlank(FRow, EF.Index) else if Field.Datatype in (IntFieldTypes+[ftAutoInc,ftLargeInt]) then - FSheet.WriteNumber(FRow,EF.Index,Field.AsInteger) + FSheet.WriteNumber(FRow, EF.Index,Field.AsInteger) else if Field.Datatype in [ftBCD,ftCurrency,ftFloat,ftFMTBcd] then - FSheet.WriteNumber(FRow,EF.Index,Field.AsFloat) + FSheet.WriteCurrency(FRow, EF.Index, Field.AsFloat) else if Field.DataType in [ftString,ftFixedChar] then - FSheet.WriteUTF8Text(FRow,EF.Index,Field.AsString) + FSheet.WriteUTF8Text(FRow, EF.Index, Field.AsString) else if (Field.DataType in ([ftWideMemo,ftWideString,ftFixedWideChar]+BlobFieldTypes)) then - FSheet.WriteUTF8Text(FRow,EF.Index,UTF8Encode(Field.AsWideString)) + FSheet.WriteUTF8Text(FRow, EF.Index, UTF8Encode(Field.AsWideString)) { Note: we test for the wide text fields before the MemoFieldTypes, in order to let ftWideMemo end up at the right place } else if Field.DataType in MemoFieldTypes then - FSheet.WriteUTF8Text(FRow,EF.Index,Field.AsString) + FSheet.WriteUTF8Text(FRow, EF.Index, Field.AsString) else if Field.DataType=ftBoolean then - FSheet.WriteBoolValue(FRow,EF.Index,Field.AsBoolean) - else if field.DataType in DateFieldTypes then - FSheet.WriteDateTime(FRow,EF.Index,Field.AsDateTime) + FSheet.WriteBoolValue(FRow, EF.Index, Field.AsBoolean) + else if Field.DataType in DateFieldTypes then + case Field.DataType of + ftDate: FSheet.WriteDateTime(FRow, EF.Index, Field.AsDateTime, nfShortDate); + ftTime: FSheet.WriteDateTime(FRow, EF.Index, Field.AsDatetime, nfLongTime); + else // try to guess best format if Field.DataType is ftDateTime + dt := Field.AsDateTime; + if dt < 1.0 then + FSheet.WriteDateTime(FRow, EF.Index, Field.AsDateTime, nfLongTime) + else if frac(dt) = 0 then + FSheet.WriteDateTime(FRow, EF.Index, Field.AsDateTime, nfShortDate) + else + FSheet.WriteDateTime(FRow, EF.Index, Field.AsDateTime, nfShortDateTime); + end else //fallback to string - FSheet.WriteUTF8Text(FRow,EF.Index,Field.AsString); + FSheet.WriteUTF8Text(FRow, EF.Index, Field.AsString); end; end;