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
This commit is contained in:
wp_xxyyzz
2017-03-27 09:57:37 +00:00
parent b90b0b5960
commit 979cd36e64
3 changed files with 129 additions and 34 deletions

View File

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

View File

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

View File

@ -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);
FExportDataset := TDbf.Create(self);
FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
FExportDataset.TableName := TABLENAME;
FExportDataset.TableLevel := 4; // DBase IV: most widely used.
FExportDataset.TableLevel := 25; // FoxPro supports FieldType nfCurrency
fn := DATADIR + DirectorySeparator + TABLENAME + DB_EXT[RgDatabaseType.itemIndex];
case RgDatabaseType.ItemIndex of
0: begin
FExportDataset := TDbf.Create(self);
TDbf(FExportDataset).FilePathFull := ExtractFilePath(fn);
TDbf(FExportDataset).TableName := ExtractFileName(fn);
// TDbf(FExportDataset).TableLevel := 4; // DBase IV: most widely used.
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.CreateTable;
FExportDataset.FieldDefs.Add('Size', ftFloat);
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('Work end').AsDateTime := EncodeTime(15+Random(4), Random(60), Random(60), 0);
FExportDataset.FieldByName('Size').AsFloat := (160 + Random(50)) / 100;
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
FExportDataset := TDbf.Create(self);
FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
FExportDataset.TableName := TABLENAME;
case RgDatabaseType.ItemIndex of
0: begin
FExportDataset := TDbf.Create(self);
TDbf(FExportDataset).FilePathFull := ExtractFilePath(DatafileName);
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 '
+'database" first.',
MessageDlg(Format('Database file "%s" not found. Please run "Create 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