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

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

@ -136,11 +136,15 @@ begin
FExportDataset := TDbf.Create(self);
FExportDataset.FilePathFull := DATADIR + DirectorySeparator;
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('First name', 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);
FExportDataset.CreateTable;
@ -159,7 +163,9 @@ begin
FExportDataset.FieldByName('First name').AsString := FIRST_NAMES[Random(NUM_FIRST_NAMES)];
FExportDataset.FieldByName('City').AsString := CITIES[Random(NUM_CITIES)];
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;
end;
FExportDataset.Close;
@ -369,6 +375,21 @@ begin
Exporter.ExportFields.AddField('Birthday');
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
Exporter.WriteExportFile;
end
@ -485,8 +506,10 @@ procedure TForm1.ExporterGetSheetNameHandler(Sender: TObject; ASheetIndex: Integ
var ASheetName: String);
begin
case ASheetIndex of
0: ASheetName := 'Cities';
1: ASheetName := 'Birthdays';
0: ASheetName := 'City';
1: ASheetName := 'Birthday';
2: ASheetName := 'Salary';
3: ASheetName := 'Work time';
end;
end;

36
components/fpspreadsheet/fpsexport.pas
View File

@ -134,7 +134,7 @@ end;
destructor TCustomFPSExport.Destroy;
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.
if FMultipleSheets and (FSpreadsheet <> nil) then
begin
@ -290,32 +290,44 @@ end;
procedure TCustomFPSExport.ExportField(EF: TExportFieldItem);
var
F : TFPSExportFieldItem;
dt: TDateTime;
begin
F:=EF as TFPSExportFieldItem;
F := EF as TFPSExportFieldItem;
with F do
begin
// Export depending on field datatype;
// Fall back to string if unknown datatype
If Field.IsNull then
FSheet.WriteUTF8Text(FRow,EF.Index,'')
FSheet.WriteBlank(FRow, EF.Index)
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
FSheet.WriteNumber(FRow,EF.Index,Field.AsFloat)
FSheet.WriteCurrency(FRow, EF.Index, Field.AsFloat)
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
FSheet.WriteUTF8Text(FRow,EF.Index,UTF8Encode(Field.AsWideString))
FSheet.WriteUTF8Text(FRow, EF.Index, UTF8Encode(Field.AsWideString))
{ Note: we test for the wide text fields before the MemoFieldTypes, in order to
let ftWideMemo end up at the right place }
else if Field.DataType in MemoFieldTypes then
FSheet.WriteUTF8Text(FRow,EF.Index,Field.AsString)
FSheet.WriteUTF8Text(FRow, EF.Index, Field.AsString)
else if Field.DataType=ftBoolean then
FSheet.WriteBoolValue(FRow,EF.Index,Field.AsBoolean)
else if field.DataType in DateFieldTypes then
FSheet.WriteDateTime(FRow,EF.Index,Field.AsDateTime)
FSheet.WriteBoolValue(FRow, EF.Index, Field.AsBoolean)
else if Field.DataType in DateFieldTypes then
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
FSheet.WriteUTF8Text(FRow,EF.Index,Field.AsString);
FSheet.WriteUTF8Text(FRow, EF.Index, Field.AsString);
end;
end;