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

fpspreadsheet: FPSExport tries to determine cell format from the exported database field types.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3845 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-12-19 21:45:44 +00:00
parent aabdaed83f
commit 098b7daf32
3 changed files with 104 additions and 69 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,10 +2,10 @@ object Form1: TForm1
Left = 340 Left = 340
Height = 310 Height = 310
Top = 154 Top = 154
Width = 639 Width = 521
Caption = 'db_Export_Import' Caption = 'db_Export_Import'
ClientHeight = 310 ClientHeight = 310
ClientWidth = 639 ClientWidth = 521
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
LCLVersion = '1.3' LCLVersion = '1.3'
@ -13,22 +13,22 @@ object Form1: TForm1
Left = 4 Left = 4
Height = 302 Height = 302
Top = 4 Top = 4
Width = 631 Width = 513
ActivePage = TabExport ActivePage = TabDataGenerator
Align = alClient Align = alClient
BorderSpacing.Around = 4 BorderSpacing.Around = 4
TabIndex = 1 TabIndex = 0
TabOrder = 0 TabOrder = 0
OnChange = PageControlChange OnChange = PageControlChange
object TabDataGenerator: TTabSheet object TabDataGenerator: TTabSheet
Caption = '1 - Create database' Caption = '1 - Create database'
ClientHeight = 269 ClientHeight = 274
ClientWidth = 623 ClientWidth = 505
object Label2: TLabel object Label2: TLabel
Left = 4 Left = 4
Height = 20 Height = 15
Top = 4 Top = 4
Width = 615 Width = 497
Align = alTop Align = alTop
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Create a database with random records' Caption = 'Create a database with random records'
@ -38,25 +38,25 @@ object Form1: TForm1
end end
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 241 Height = 251
Top = 28 Top = 23
Width = 623 Width = 505
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 241 ClientHeight = 251
ClientWidth = 623 ClientWidth = 505
TabOrder = 0 TabOrder = 0
object HeaderLabel1: TLabel object HeaderLabel1: TLabel
Left = 8 Left = 8
Height = 20 Height = 15
Top = 11 Top = 11
Width = 88 Width = 71
Caption = 'Record count' Caption = 'Record count'
ParentColor = False ParentColor = False
end end
object EdRecordCount: TEdit object EdRecordCount: TEdit
Left = 107 Left = 107
Height = 28 Height = 23
Top = 8 Top = 8
Width = 64 Width = 64
Alignment = taRightJustify Alignment = taRightJustify
@ -64,9 +64,9 @@ object Form1: TForm1
Text = '50000' Text = '50000'
end end
object BtnCreateDbf: TButton object BtnCreateDbf: TButton
Left = 515 Left = 397
Height = 28 Height = 28
Top = 208 Top = 218
Width = 99 Width = 99
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Caption = 'Run' Caption = 'Run'
@ -77,15 +77,15 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 3 Height = 3
Top = 0 Top = 0
Width = 623 Width = 505
Align = alTop Align = alTop
Shape = bsTopLine Shape = bsTopLine
end end
object InfoLabel1: TLabel object InfoLabel1: TLabel
Left = 8 Left = 8
Height = 20 Height = 15
Top = 216 Top = 231
Width = 496 Width = 378
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'InfoLabel1' Caption = 'InfoLabel1'
@ -93,9 +93,9 @@ object Form1: TForm1
end end
object Label1: TLabel object Label1: TLabel
Left = 8 Left = 8
Height = 20 Height = 15
Top = 40 Top = 40
Width = 409 Width = 324
Caption = 'Please note: the binary xls files can handle only 65536 records.' Caption = 'Please note: the binary xls files can handle only 65536 records.'
ParentColor = False ParentColor = False
end end
@ -103,13 +103,13 @@ object Form1: TForm1
end end
object TabExport: TTabSheet object TabExport: TTabSheet
Caption = '2 - Export to spreadsheet' Caption = '2 - Export to spreadsheet'
ClientHeight = 269 ClientHeight = 274
ClientWidth = 623 ClientWidth = 505
object HeaderLabel2: TLabel object HeaderLabel2: TLabel
Left = 4 Left = 4
Height = 20 Height = 15
Top = 4 Top = 4
Width = 615 Width = 497
Align = alTop Align = alTop
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Export database table to spreadsheet file' Caption = 'Export database table to spreadsheet file'
@ -120,16 +120,16 @@ object Form1: TForm1
object Bevel2: TBevel object Bevel2: TBevel
Left = 0 Left = 0
Height = 3 Height = 3
Top = 28 Top = 23
Width = 623 Width = 505
Align = alTop Align = alTop
Shape = bsTopLine Shape = bsTopLine
end end
object InfoLabel2: TLabel object InfoLabel2: TLabel
Left = 8 Left = 8
Height = 20 Height = 15
Top = 244 Top = 254
Width = 504 Width = 386
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'InfoLabel2' Caption = 'InfoLabel2'
@ -149,7 +149,7 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1 ChildSizing.ControlsPerLine = 1
ClientHeight = 133 ClientHeight = 138
ClientWidth = 228 ClientWidth = 228
ItemIndex = 2 ItemIndex = 2
Items.Strings = ( Items.Strings = (
@ -162,9 +162,9 @@ object Form1: TForm1
TabOrder = 0 TabOrder = 0
end end
object BtnExport: TButton object BtnExport: TButton
Left = 515 Left = 397
Height = 28 Height = 28
Top = 236 Top = 241
Width = 99 Width = 99
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Caption = 'Run' Caption = 'Run'
@ -185,7 +185,7 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1 ChildSizing.ControlsPerLine = 1
ClientHeight = 133 ClientHeight = 138
ClientWidth = 228 ClientWidth = 228
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
@ -198,13 +198,13 @@ object Form1: TForm1
end end
object TabImport: TTabSheet object TabImport: TTabSheet
Caption = '3 - Import from spreadsheet' Caption = '3 - Import from spreadsheet'
ClientHeight = 276 ClientHeight = 274
ClientWidth = 623 ClientWidth = 505
object HeaderLabel3: TLabel object HeaderLabel3: TLabel
Left = 4 Left = 4
Height = 13 Height = 15
Top = 4 Top = 4
Width = 615 Width = 497
Align = alTop Align = alTop
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Import spreadsheet file in database table' Caption = 'Import spreadsheet file in database table'
@ -215,25 +215,25 @@ object Form1: TForm1
object Bevel3: TBevel object Bevel3: TBevel
Left = 0 Left = 0
Height = 3 Height = 3
Top = 21 Top = 23
Width = 623 Width = 505
Align = alTop Align = alTop
Shape = bsTopLine Shape = bsTopLine
end end
object InfoLabel3: TLabel object InfoLabel3: TLabel
Left = 8 Left = 8
Height = 13 Height = 15
Top = 258 Top = 254
Width = 51 Width = 55
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'InfoLabel3' Caption = 'InfoLabel3'
ParentColor = False ParentColor = False
end end
object BtnImport: TButton object BtnImport: TButton
Left = 515 Left = 397
Height = 28 Height = 28
Top = 243 Top = 241
Width = 99 Width = 99
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Caption = 'Run' Caption = 'Run'
@ -243,7 +243,7 @@ object Form1: TForm1
end end
object FileList: TListBox object FileList: TListBox
Left = 8 Left = 8
Height = 188 Height = 186
Top = 56 Top = 56
Width = 292 Width = 292
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
@ -253,9 +253,9 @@ object Form1: TForm1
end end
object Label3: TLabel object Label3: TLabel
Left = 8 Left = 8
Height = 13 Height = 15
Top = 33 Top = 33
Width = 205 Width = 221
Caption = 'Select the spreadsheet file to be imported:' Caption = 'Select the spreadsheet file to be imported:'
ParentColor = False ParentColor = False
end end

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

@ -136,11 +136,15 @@ begin
FExportDataset := TDbf.Create(self); FExportDataset := TDbf.Create(self);
FExportDataset.FilePathFull := DATADIR + DirectorySeparator; FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
FExportDataset.TableName := TABLENAME; 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('Last name', ftString);
FExportDataset.FieldDefs.Add('First name', ftString); FExportDataset.FieldDefs.Add('First name', ftString);
FExportDataset.FieldDefs.Add('City', 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); DeleteFile(FExportDataset.FilePathFull + FExportDataset.TableName);
FExportDataset.CreateTable; FExportDataset.CreateTable;
@ -159,7 +163,9 @@ begin
FExportDataset.FieldByName('First name').AsString := FIRST_NAMES[Random(NUM_FIRST_NAMES)]; FExportDataset.FieldByName('First name').AsString := FIRST_NAMES[Random(NUM_FIRST_NAMES)];
FExportDataset.FieldByName('City').AsString := CITIES[Random(NUM_CITIES)]; FExportDataset.FieldByName('City').AsString := CITIES[Random(NUM_CITIES)];
FExportDataset.FieldByName('Birthday').AsDateTime := startDate - random(maxAge); 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; FExportDataset.Post;
end; end;
FExportDataset.Close; FExportDataset.Close;
@ -369,6 +375,21 @@ begin
Exporter.ExportFields.AddField('Birthday'); Exporter.ExportFields.AddField('Birthday');
Exporter.Execute; 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 // Export complete --> we can write to file
Exporter.WriteExportFile; Exporter.WriteExportFile;
end end
@ -485,8 +506,10 @@ procedure TForm1.ExporterGetSheetNameHandler(Sender: TObject; ASheetIndex: Integ
var ASheetName: String); var ASheetName: String);
begin begin
case ASheetIndex of case ASheetIndex of
0: ASheetName := 'Cities'; 0: ASheetName := 'City';
1: ASheetName := 'Birthdays'; 1: ASheetName := 'Birthday';
2: ASheetName := 'Salary';
3: ASheetName := 'Work time';
end; end;
end; end;

22
components/fpspreadsheet/fpsexport.pas
View File

@ -134,7 +134,7 @@ end;
destructor TCustomFPSExport.Destroy; destructor TCustomFPSExport.Destroy;
begin 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. // in case of multiple sheets.
if FMultipleSheets and (FSpreadsheet <> nil) then if FMultipleSheets and (FSpreadsheet <> nil) then
begin begin
@ -290,6 +290,7 @@ end;
procedure TCustomFPSExport.ExportField(EF: TExportFieldItem); procedure TCustomFPSExport.ExportField(EF: TExportFieldItem);
var var
F : TFPSExportFieldItem; F : TFPSExportFieldItem;
dt: TDateTime;
begin begin
F := EF as TFPSExportFieldItem; F := EF as TFPSExportFieldItem;
with F do with F do
@ -297,11 +298,11 @@ begin
// Export depending on field datatype; // Export depending on field datatype;
// Fall back to string if unknown datatype // Fall back to string if unknown datatype
If Field.IsNull then If Field.IsNull then
FSheet.WriteUTF8Text(FRow,EF.Index,'') FSheet.WriteBlank(FRow, EF.Index)
else if Field.Datatype in (IntFieldTypes+[ftAutoInc,ftLargeInt]) then 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 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 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 else if (Field.DataType in ([ftWideMemo,ftWideString,ftFixedWideChar]+BlobFieldTypes)) then
@ -312,8 +313,19 @@ begin
FSheet.WriteUTF8Text(FRow, EF.Index, Field.AsString) FSheet.WriteUTF8Text(FRow, EF.Index, Field.AsString)
else if Field.DataType=ftBoolean then else if Field.DataType=ftBoolean then
FSheet.WriteBoolValue(FRow, EF.Index, Field.AsBoolean) FSheet.WriteBoolValue(FRow, EF.Index, Field.AsBoolean)
else if field.DataType in DateFieldTypes then else if Field.DataType in DateFieldTypes then
FSheet.WriteDateTime(FRow,EF.Index,Field.AsDateTime) 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 else //fallback to string
FSheet.WriteUTF8Text(FRow, EF.Index, Field.AsString); FSheet.WriteUTF8Text(FRow, EF.Index, Field.AsString);
end; end;