From ebf59489f268dd6f855d165162d2fe1d058a8005 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 6 Aug 2014 08:50:36 +0000 Subject: [PATCH] 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 --- .../{dbexport.lpi => db_export_import.lpi} | 6 +- .../{dbexport.lpr => db_export_import.lpr} | 2 +- .../examples/db_import_export/main.lfm | 143 +++++++++--------- .../examples/db_import_export/main.pas | 126 ++++++++++----- .../examples/db_import_export/readme.txt | 9 +- .../fpspreadsheet/tests/optiontests.pas | 27 ++++ components/fpspreadsheet/xlsbiff2.pas | 1 - 7 files changed, 201 insertions(+), 113 deletions(-) rename components/fpspreadsheet/examples/db_import_export/{dbexport.lpi => db_export_import.lpi} (94%) rename components/fpspreadsheet/examples/db_import_export/{dbexport.lpr => db_export_import.lpr} (92%) 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 @@ - + <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)"/> 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;