paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3434 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-08-06 08:50:36 +00:00
parent 8409952071
commit ebf59489f2
7 changed files with 201 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpspreadsheet/examples/db_import_export/dbexport.lpi → components/fpspreadsheet/examples/db_import_export/db_export_import.lpi
View File

@ -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)"/>

2
components/fpspreadsheet/examples/db_import_export/dbexport.lpr → components/fpspreadsheet/examples/db_import_export/db_export_import.lpr
View File

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

143
components/fpspreadsheet/examples/db_import_export/main.lfm
View File

@ -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

126
components/fpspreadsheet/examples/db_import_export/main.pas
View File

@ -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;

9
components/fpspreadsheet/examples/db_import_export/readme.txt
View File

@ -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.

27
components/fpspreadsheet/tests/optiontests.pas
View File

@ -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

1
components/fpspreadsheet/xlsbiff2.pas
View File

@ -54,7 +54,6 @@ type
TsSpreadBIFF2Reader = class(TsSpreadBIFFReader)
private
WorkBookEncoding: TsEncoding;
FWorksheet: TsWorksheet;
FFont: TsFont;
protected
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); override;