pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

* fpspreadsheet: db_import_export example: add fpsexport method to existing virtual mode code.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3708 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
bigchimp
2014-11-08 11:22:06 +00:00
parent ee8eb09244
commit a8582a0471
4 changed files with 261 additions and 137 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,11 +22,11 @@ object Form1: TForm1
OnChange = PageControlChange
object TabDataGenerator: TTabSheet
Caption = '1 - Create database'
ClientHeight = 274
ClientHeight = 276
ClientWidth = 623
object Label2: TLabel
Left = 4
Height = 15
Height = 13
Top = 4
Width = 615
Align = alTop
@ -38,25 +38,25 @@ object Form1: TForm1
end
object Panel1: TPanel
Left = 0
Height = 251
Top = 23
Height = 255
Top = 21
Width = 623
Align = alClient
BevelOuter = bvNone
ClientHeight = 251
ClientHeight = 255
ClientWidth = 623
TabOrder = 0
object HeaderLabel1: TLabel
Left = 8
Height = 15
Height = 13
Top = 11
Width = 71
Width = 64
Caption = 'Record count'
ParentColor = False
end
object EdRecordCount: TEdit
Left = 107
Height = 23
Height = 21
Top = 8
Width = 64
Alignment = taRightJustify
@ -66,7 +66,7 @@ object Form1: TForm1
object BtnCreateDbf: TButton
Left = 515
Height = 28
Top = 218
Top = 222
Width = 99
Anchors = [akRight, akBottom]
Caption = 'Run'
@ -83,8 +83,8 @@ object Form1: TForm1
end
object InfoLabel1: TLabel
Left = 8
Height = 15
Top = 231
Height = 13
Top = 237
Width = 496
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Around = 4
@ -93,9 +93,9 @@ object Form1: TForm1
end
object Label1: TLabel
Left = 8
Height = 15
Height = 13
Top = 40
Width = 324
Width = 304
Caption = 'Please note: the binary xls files can handle only 65536 records.'
ParentColor = False
end
@ -103,11 +103,11 @@ object Form1: TForm1
end
object TabExport: TTabSheet
Caption = '2 - Export to spreadsheet'
ClientHeight = 269
ClientHeight = 276
ClientWidth = 623
object HeaderLabel2: TLabel
Left = 4
Height = 20
Height = 13
Top = 4
Width = 615
Align = alTop
@ -120,15 +120,15 @@ object Form1: TForm1
object Bevel2: TBevel
Left = 0
Height = 3
Top = 28
Top = 21
Width = 623
Align = alTop
Shape = bsTopLine
end
object InfoLabel2: TLabel
Left = 8
Height = 20
Top = 244
Height = 13
Top = 258
Width = 504
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Around = 4
@ -149,7 +149,7 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 138
ClientHeight = 140
ClientWidth = 228
ItemIndex = 2
Items.Strings = (
@ -164,21 +164,44 @@ object Form1: TForm1
object BtnExport: TButton
Left = 515
Height = 28
Top = 236
Top = 243
Width = 99
Anchors = [akRight, akBottom]
Caption = 'Run'
OnClick = BtnExportClick
TabOrder = 1
end
object RgExportMode: TRadioGroup
Left = 256
Height = 158
Top = 32
Width = 232
AutoFill = True
Caption = 'Export method'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 140
ClientWidth = 228
ItemIndex = 0
Items.Strings = (
'Virtual mode (memory saving)'
'FPSExport'
)
TabOrder = 2
end
end
object TabImport: TTabSheet
Caption = '3 - Import from spreadsheet'
ClientHeight = 269
ClientHeight = 276
ClientWidth = 623
object HeaderLabel3: TLabel
Left = 4
Height = 20
Height = 13
Top = 4
Width = 615
Align = alTop
@ -191,16 +214,16 @@ object Form1: TForm1
object Bevel3: TBevel
Left = 0
Height = 3
Top = 28
Top = 21
Width = 623
Align = alTop
Shape = bsTopLine
end
object InfoLabel3: TLabel
Left = 8
Height = 20
Top = 244
Width = 70
Height = 13
Top = 258
Width = 51
Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4
Caption = 'InfoLabel3'
@ -209,7 +232,7 @@ object Form1: TForm1
object BtnImport: TButton
Left = 515
Height = 28
Top = 236
Top = 243
Width = 99
Anchors = [akRight, akBottom]
Caption = 'Run'
@ -219,7 +242,7 @@ object Form1: TForm1
end
object FileList: TListBox
Left = 8
Height = 181
Height = 188
Top = 56
Width = 292
Anchors = [akTop, akLeft, akBottom]
@ -229,9 +252,9 @@ object Form1: TForm1
end
object Label3: TLabel
Left = 8
Height = 20
Height = 13
Top = 33
Width = 282
Width = 205
Caption = 'Select the spreadsheet file to be imported:'
ParentColor = False
end

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

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ComCtrls, ExtCtrls, db, dbf, fpspreadsheet, fpsallformats;
ComCtrls, ExtCtrls, db, dbf, fpspreadsheet, fpsallformats, fpsexport;
type
@ -33,6 +33,7 @@ type
PageControl: TPageControl;
Panel1: TPanel;
RgFileFormat: TRadioGroup;
RgExportMode: TRadioGroup;
TabDataGenerator: TTabSheet;
TabExport: TTabSheet;
TabImport: TTabSheet;
@ -52,10 +53,18 @@ type
FDateTemplateCell: PCell;
FImportedFieldNames: TStringList;
FImportedRowCells: Array of TCell;
// For reading: all data for the database is generated here out of the spreadsheet file
// Actual export code when using FPSpreadsheet's fpsexport:
// reads dbf and writes to spreadsheet
// Expects FExportDataset to be available
procedure ExportUsingFPSExport(var DataFileName: string);
// Actual export code when using virtual mode:
// reads dbf and writes to spreadsheet
// Expects FExportDataset to be available
procedure ExportUsingVirtualMode(var DataFileName: string);
// Virtual mode: 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)
// Virtual mode: 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
@ -69,6 +78,12 @@ implementation
{$R *.lfm}
type
// Ways to export dbf/dataset. Corresponds to the items
// of the RgExportMode radiogroup
TsExportModes=(seVirtual {manual coding using Virtual Mode},
seFPSExport {uses FpSpreadsheet's fpsexport - takes more memory});
const
// Parameters for generating dbf file contents
NUM_LAST_NAMES = 8;
@ -88,6 +103,7 @@ const
DATADIR = 'data'; //subdirectory where .dbf is stored
// File formats corresponding to the items of the RgFileFormat radiogroup
// Items in RadioGroup in Export tab match this order
FILE_FORMATS: array[0..4] of TsSpreadsheetFormat = (
sfExcel2, sfExcel5, sfExcel8, sfOOXML, sfOpenDocument
);
@ -155,18 +171,11 @@ end;
memory load of this process }
procedure TForm1.BtnExportClick(Sender: TObject);
var
DataFileName: String;
worksheet: TsWorksheet;
DataFileName: string; //export file name
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);
@ -177,52 +186,27 @@ begin
DataFileName := FExportDataset.FilePathFull + FExportDataset.TableName;
if not FileExists(DataFileName) then
begin
MessageDlg(Format('Database file "%s" not found. Please run "Create database" first.',
MessageDlg(Format('Database file "%s" not found. Please run "Create '
+'database" first.',
[DataFileName]), mtError, [mbOK], 0);
exit;
end;
FExportDataset.Open;
FWorkbook := TsWorkbook.Create;
// Make user aware export may take some time by changing cursor
Screen.Cursor := crHourGlass;
try
worksheet := FWorkbook.AddWorksheet(FExportDataset.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
worksheet.Options := worksheet.Options + [soHasFrozenPanes];
worksheet.TopPaneHeight := 1;
InfoLabel1.Caption := ('Starting database export.');
case TsExportModes(RgExportMode.ItemIndex) of
seVirtual: ExportUsingVirtualMode(DataFileName);
seFPSExport: ExportUsingFPSExport(DataFileName);
else
begin
ShowMessageFmt('Unknown export mode number %d. Please correct source code.',[RgExportMode.ItemIndex]);
exit;
end;
end;
// Use cell A1 as format template of header line
FHeaderTemplateCell := worksheet.GetCell(0, 0);
worksheet.WriteFontStyle(FHeaderTemplateCell, [fssBold]);
worksheet.WriteBackgroundColor(FHeaderTemplateCell, scGray);
if FILE_FORMATS[RgFileFormat.ItemIndex] <> sfExcel2 then
worksheet.WriteFontColor(FHeaderTemplateCell, scWhite); // Does not look nice in the limited Excel2 format
// Use cell B1 as format template of date column
FDateTemplateCell := worksheet.GetCell(0, 1);
worksheet.WriteDateTimeFormat(FDateTemplateCell, nfShortDate);
// 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];
FWorkbook.Options := FWorkbook.Options + [boVirtualMode];
FWorkbook.OnWriteCellData := @WriteCellDataHandler;
FWorkbook.VirtualRowCount := FExportDataset.RecordCount + 1; // +1 for the header line
FWorkbook.VirtualColCount := FExportDataset.FieldCount;
// Write
DataFileName := ChangeFileExt(DataFileName, FILE_EXT[RgFileFormat.ItemIndex]);
FWorkbook.WriteToFile(DataFileName, FILE_FORMATS[RgFileFormat.ItemIndex], true);
finally
FreeAndNil(FWorkbook);
Screen.Cursor := crDefault;
end;
InfoLabel2.Caption := Format('Done. Database exported to file "%s" in folder "%s"', [
@ -248,60 +232,113 @@ begin
// 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
case ext of
'.xls':
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;
'.xlsx':
fmt := sfOOXML;
'.ods':
fmt := sfOpenDocument;
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;
begin
MessageDlg('Unknown spreadsheet file format.', mtError, [mbOK], 0);
exit;
end;
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 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;
// Make user aware import may take some time by changing cursor
Screen.Cursor := crHourglass;
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 not 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]);
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 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;
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 not 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;
finally
FWorkbook.Free;
Screen.Cursor := crDefault;
end;
end;
procedure TForm1.ExportUsingFPSExport(var DataFileName: string);
var
Exporter: TFPSExport;
ExportSettings: TFPSExportFormatSettings;
begin
FExportDataset.Open;
// TCustomDatasetExporter dsecendants like TFPSExport will start to export
// from current record so make sure we get everything
FExportDataset.First;
Exporter := TFPSExport.Create(nil);
ExportSettings := TFPSExportFormatSettings.Create(true);
try
// Write header row with field names
ExportSettings.HeaderRow := true;
case FILE_FORMATS[RgFileFormat.ItemIndex] of
sfExcel2, sfExcel5:
begin
ShowMessage('Format not supported using this mode.');
exit;
end;
sfExcel8: ExportSettings.ExportFormat := efXLS;
sfOOXML: ExportSettings.ExportFormat := efXLSX;
sfOpenDocument: ExportSettings.ExportFormat := efODS;
else
begin
ShowMessage('Unknown export format. Please correct the source code.');
exit;
end;
end;
// Actually apply settings
Exporter.FormatSettings := ExportSettings;
// Write
Exporter.Dataset := FExportDataset;
Exporter.FileName := ChangeFileExt(DataFileName, FILE_EXT[
RgFileFormat.ItemIndex]);
Exporter.Execute;
finally
Exporter.Free;
ExportSettings.Free;
end;
end;
@ -348,6 +385,62 @@ begin
end;
end;
procedure TForm1.ExportUsingVirtualMode(var DataFileName: string);
var
worksheet: TsWorksheet;
begin
if FILE_FORMATS[RgFileFormat.ItemIndex] = sfOpenDocument then
begin
MessageDlg('Virtual mode is not yet implemented for .ods files.', mtError, [mbOK], 0);
exit;
end;
FExportDataset.Open;
FWorkbook := TsWorkbook.Create;
try
worksheet := FWorkbook.AddWorksheet(FExportDataset.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
worksheet.Options := worksheet.Options + [soHasFrozenPanes];
worksheet.TopPaneHeight := 1;
end;
// Use cell A1 as format template of header line
FHeaderTemplateCell := worksheet.GetCell(0, 0);
worksheet.WriteFontStyle(FHeaderTemplateCell, [fssBold]);
worksheet.WriteBackgroundColor(FHeaderTemplateCell, scGray);
if FILE_FORMATS[RgFileFormat.ItemIndex] <> sfExcel2 then
worksheet.WriteFontColor(FHeaderTemplateCell, scWhite); // Does not look nice in the limited Excel2 format
// Use cell B1 as format template of date column
FDateTemplateCell := worksheet.GetCell(0, 1);
worksheet.WriteDateTimeFormat(FDateTemplateCell, nfShortDate);
// 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];
FWorkbook.Options := FWorkbook.Options + [boVirtualMode];
FWorkbook.OnWriteCellData := @WriteCellDataHandler;
FWorkbook.VirtualRowCount := FExportDataset.RecordCount + 1; // +1 for the header line
FWorkbook.VirtualColCount := FExportDataset.FieldCount;
// Write
DataFileName := ChangeFileExt(DataFileName, FILE_EXT[
RgFileFormat.ItemIndex]);
FWorkbook.WriteToFile(DataFileName, FILE_FORMATS[RgFileFormat.ItemIndex],
true);
finally
FreeAndNil(FWorkbook);
end;
end;
{ This is the event handler for reading a spreadsheet file in virtual mode.
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
@ -355,7 +448,7 @@ end;
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;
procedure TForm1.ReadCellDataHandler(Sender: TObject; ARow, ACol: Cardinal;
const ADataCell: PCell);
var
i: Integer;
@ -375,7 +468,8 @@ begin
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
// 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
@ -440,8 +534,8 @@ 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.
// 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

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

@ -1,11 +1,17 @@
This example program shows how a large database table can be exported to and
imported from a spreadsheet file using virtual mode.
This example program shows how a large database table can be exported to a
spreadsheet using virtual mode or fpspreadsheet's fpsexport.
It also shows importing a spreadsheet file into a database 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. Finally, in section 3, another dBase file can be created from a
selected spreadsheet file.
Export using virtual mode has the advantage that this takes less memory for the
spreadsheet contents, but requires some more coding. It is also quite fast.
Exporting using fpsexport needs less code but takes more memory (important for
large amounts of data) and seems slower.
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.

5
components/fpspreadsheet/fpsexport.pas
View File

@ -79,11 +79,12 @@ Type
property Dataset;
{@@ Fields to be exported }
property ExportFields;
{@@ Settings - e.g. export format - to be used }
property FormatSettings;
{@@ Export starting from current record or beginning. }
property FromCurrent;
{@@ Flag indicating whether to return to current dataset position after export }
property RestorePosition;
property FormatSettings;
{@@ Procedure to run when exporting a row }
property OnExportRow;
end;
@ -237,7 +238,7 @@ end;
procedure TFPSExportFormatSettings.InitSettings;
begin
inherited InitSettings;
FExportFormat:=efXLS; //often used
FExportFormat:=efXLS; //often used format
end;
end.