diff --git a/components/fpspreadsheet/examples/db_import_export/main.lfm b/components/fpspreadsheet/examples/db_import_export/main.lfm index bb130f35b..eff471bc1 100644 --- a/components/fpspreadsheet/examples/db_import_export/main.lfm +++ b/components/fpspreadsheet/examples/db_import_export/main.lfm @@ -14,19 +14,19 @@ object Form1: TForm1 Height = 302 Top = 4 Width = 631 - ActivePage = TabDataGenerator + ActivePage = TabExport Align = alClient BorderSpacing.Around = 4 - TabIndex = 0 + TabIndex = 1 TabOrder = 0 OnChange = PageControlChange object TabDataGenerator: TTabSheet Caption = '1 - Create database' - ClientHeight = 276 + ClientHeight = 269 ClientWidth = 623 object Label2: TLabel Left = 4 - Height = 13 + Height = 20 Top = 4 Width = 615 Align = alTop @@ -38,25 +38,25 @@ object Form1: TForm1 end object Panel1: TPanel Left = 0 - Height = 255 - Top = 21 + Height = 241 + Top = 28 Width = 623 Align = alClient BevelOuter = bvNone - ClientHeight = 255 + ClientHeight = 241 ClientWidth = 623 TabOrder = 0 object HeaderLabel1: TLabel Left = 8 - Height = 13 + Height = 20 Top = 11 - Width = 64 + Width = 88 Caption = 'Record count' ParentColor = False end object EdRecordCount: TEdit Left = 107 - Height = 21 + Height = 28 Top = 8 Width = 64 Alignment = taRightJustify @@ -66,7 +66,7 @@ object Form1: TForm1 object BtnCreateDbf: TButton Left = 515 Height = 28 - Top = 222 + Top = 208 Width = 99 Anchors = [akRight, akBottom] Caption = 'Run' @@ -83,8 +83,8 @@ object Form1: TForm1 end object InfoLabel1: TLabel Left = 8 - Height = 13 - Top = 237 + Height = 20 + Top = 216 Width = 496 Anchors = [akLeft, akRight, akBottom] BorderSpacing.Around = 4 @@ -93,9 +93,9 @@ object Form1: TForm1 end object Label1: TLabel Left = 8 - Height = 13 + Height = 20 Top = 40 - Width = 304 + Width = 409 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 = 276 + ClientHeight = 269 ClientWidth = 623 object HeaderLabel2: TLabel Left = 4 - Height = 13 + Height = 20 Top = 4 Width = 615 Align = alTop @@ -120,15 +120,15 @@ object Form1: TForm1 object Bevel2: TBevel Left = 0 Height = 3 - Top = 21 + Top = 28 Width = 623 Align = alTop Shape = bsTopLine end object InfoLabel2: TLabel Left = 8 - Height = 13 - Top = 258 + Height = 20 + Top = 244 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 = 140 + ClientHeight = 133 ClientWidth = 228 ItemIndex = 2 Items.Strings = ( @@ -164,7 +164,7 @@ object Form1: TForm1 object BtnExport: TButton Left = 515 Height = 28 - Top = 243 + Top = 236 Width = 99 Anchors = [akRight, akBottom] Caption = 'Run' @@ -185,12 +185,13 @@ object Form1: TForm1 ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 140 + ClientHeight = 133 ClientWidth = 228 ItemIndex = 0 Items.Strings = ( 'Virtual mode (memory saving)' 'FPSExport' + 'FPSExport (multiple sheets)' ) TabOrder = 2 end diff --git a/components/fpspreadsheet/examples/db_import_export/main.pas b/components/fpspreadsheet/examples/db_import_export/main.pas index f8a7232d1..d4d87004b 100644 --- a/components/fpspreadsheet/examples/db_import_export/main.pas +++ b/components/fpspreadsheet/examples/db_import_export/main.pas @@ -56,11 +56,14 @@ type // Actual export code when using FPSpreadsheet's fpsexport: // reads dbf and writes to spreadsheet // Expects FExportDataset to be available - procedure ExportUsingFPSExport(var DataFileName: string); + procedure ExportUsingFPSExport(MultipleSheets: Boolean; 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); + // FPSExport: Get sheet name + procedure ExporterGetSheetNameHandler(Sender: TObject; ASheetIndex: Integer; + var ASheetName: 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); @@ -81,8 +84,11 @@ implementation 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}); + TsExportModes=( + seVirtual, {manual coding using Virtual Mode} + seFPSExport, {uses FpSpreadsheet's fpsexport - takes more memory} + seFPSExportMulti {uses FpSpreadsheetÄs fpsexport to multiple sheets} + ); const // Parameters for generating dbf file contents @@ -197,8 +203,12 @@ begin try InfoLabel1.Caption := ('Starting database export.'); case TsExportModes(RgExportMode.ItemIndex) of - seVirtual: ExportUsingVirtualMode(DataFileName); - seFPSExport: ExportUsingFPSExport(DataFileName); + seVirtual: + ExportUsingVirtualMode(DataFileName); + seFPSExport: + ExportUsingFPSExport(false, DataFileName); + seFPSExportMulti: + ExportUsingFPSExport(true, DataFileName); else begin ShowMessageFmt('Unknown export mode number %d. Please correct source code.',[RgExportMode.ItemIndex]); @@ -298,7 +308,8 @@ begin end; end; -procedure TForm1.ExportUsingFPSExport(var DataFileName: string); +procedure TForm1.ExportUsingFPSExport(MultipleSheets: Boolean; + var DataFileName: string); var Exporter: TFPSExport; ExportSettings: TFPSExportFormatSettings; @@ -315,18 +326,21 @@ begin 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; + 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; + begin + ShowMessage('Unknown export format. Please correct the source code.'); + exit; + end; end; // Actually apply settings Exporter.FormatSettings := ExportSettings; @@ -335,7 +349,32 @@ begin Exporter.Dataset := FExportDataset; Exporter.FileName := ChangeFileExt(DataFileName, FILE_EXT[ RgFileFormat.ItemIndex]); - Exporter.Execute; + + // Export to multiple sheets + if MultipleSheets then + begin + Exporter.MultipleSheets := true; + Exporter.OnGetSheetName := @ExporterGetSheetNameHandler; + + // On the first sheet we want "Last name", "First name" and "City" + Exporter.ExportFields.AddField('Last name'); + Exporter.ExportFields.AddField('First name'); + Exporter.ExportFields.AddField('City'); + Exporter.Execute; + + // On the second sheet we want "Last name", "First name" and "Birthday" + Exporter.ExportFields.Clear; + Exporter.ExportFields.AddField('Last name'); + Exporter.ExportFields.AddField('First name'); + Exporter.ExportFields.AddField('Birthday'); + Exporter.Execute; + + // Export complete --> we can write to file + Exporter.WriteExportFile; + end + // Export of all records to single sheet + else + Exporter.Execute; finally Exporter.Free; ExportSettings.Free; @@ -441,6 +480,16 @@ begin end; end; +{ Determines the sheet name of the export using FPExport } +procedure TForm1.ExporterGetSheetNameHandler(Sender: TObject; ASheetIndex: Integer; + var ASheetName: String); +begin + case ASheetIndex of + 0: ASheetName := 'Cities'; + 1: ASheetName := 'Birthdays'; + 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 diff --git a/components/fpspreadsheet/fpsexport.pas b/components/fpspreadsheet/fpsexport.pas index 6246849ec..afaa0709b 100644 --- a/components/fpspreadsheet/fpsexport.pas +++ b/components/fpspreadsheet/fpsexport.pas @@ -11,7 +11,8 @@ unit fpsexport; interface uses - Classes, SysUtils, db, fpsallformats, fpspreadsheet, fpsstrings, fpdbexport; + Classes, SysUtils, db, + {%H-}fpsallformats, fpspreadsheet, fpsstrings, fpdbexport; Type @@ -32,17 +33,24 @@ Type private FExportFormat: TExportFormat; FHeaderRow: boolean; + FSheetName: String; public procedure Assign(Source : TPersistent); override; procedure InitSettings; override; published {@@ File format for the export } property ExportFormat: TExportFormat read FExportFormat write FExportFormat; - {@@ Flag that determines whethe to write the field list to the first + {@@ Flag that determines whether to write the field list to the first row of the spreadsheet } property HeaderRow: boolean read FHeaderRow write FHeaderRow default false; + {@@ Sheet name } + property SheetName: String read FSheetName write FSheetName; end; + { TGetSheetNameEvent } + TsGetSheetNameEvent = procedure (Sender: TObject; ASheetIndex: Integer; + var ASheetName: String) of object; + { TCustomFPSExport } TCustomFPSExport = Class(TCustomDatasetExporter) private @@ -50,23 +58,36 @@ Type FSpreadsheet: TsWorkbook; FSheet: TsWorksheet; FFileName: string; + FMultipleSheets: Boolean; + FOnGetSheetName: TsGetSheetNameEvent; + function CalcSheetNameMask(const AMask: String): String; + function CalcUniqueSheetName(const AMask: String): String; function GetSettings: TFPSExportFormatSettings; + procedure SaveWorkbook; procedure SetSettings(const AValue: TFPSExportFormatSettings); protected - function CreateFormatSettings: TCustomExportFormatSettings; override; - function CreateExportFields: TExportFields; override; + function CreateFormatSettings: TCustomExportFormatSettings; override; procedure DoBeforeExecute; override; procedure DoAfterExecute; override; procedure DoDataHeader; override; procedure DoDataRowEnd; override; + function DoGetSheetName: String; virtual; procedure ExportField(EF : TExportFieldItem); override; property FileName: String read FFileName write FFileName; property Workbook: TsWorkbook read FSpreadsheet; + property RestorePosition default true; + property OnGetSheetName: TsGetSheetNameEvent read FOnGetSheetName write FOnGetSheetName; public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure WriteExportFile; {@@ Settings for the export. Note: a lot of generic settings are preent that are not relevant for this export, e.g. decimal point settings } property FormatSettings: TFPSExportFormatSettings read GetSettings write SetSettings; + {@@ MultipleSheets: export several datasets to multiple sheets in + the sasme file. Otherwise a single-sheet workbook is created. } + property MultipleSheets: Boolean read FMultipleSheets write FMultipleSheets default false; end; { TFPSExport } @@ -87,6 +108,8 @@ Type property RestorePosition; {@@ Procedure to run when exporting a row } property OnExportRow; + {@@ Determines the name of the worksheet } + property OnGetSheetName; end; {@@ Register export format with fpsdbexport so it can be dynamically used } @@ -103,6 +126,24 @@ implementation { TCustomFPSExport } +constructor TCustomFPSExport.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + RestorePosition := true; +end; + +destructor TCustomFPSExport.Destroy; +begin + // Last chance to save file if calling WriteExportFile has been forgottem + // in case of multiple sheets. + if FMultipleSheets and (FSpreadsheet <> nil) then + begin + SaveWorkbook; + FreeAndNil(FSpreadsheet); + end; + inherited; +end; + function TCustomFPSExport.GetSettings: TFPSExportFormatSettings; begin result:=TFPSExportFormatSettings(Inherited FormatSettings); @@ -129,11 +170,17 @@ begin Inherited; if FFileName='' then Raise EDataExporter.Create(rsExportFileIsRequired); - FSpreadsheet:=TsWorkbook.Create; - // For extra performance. Note that virtual mode is not an option - // due to the data export determining flow of the program. - FSpreadsheet.Options:=FSpreadsheet.Options+[boBufStream]; - FSheet:=FSpreadsheet.AddWorksheet('1'); + if (not RestorePosition) and FMultipleSheets then + Raise EDataExporter.Create(rsMultipleSheetsOnlyWithRestorePosition); + + if (not FMultipleSheets) or (FSpreadsheet = nil) then + begin + FSpreadsheet:=TsWorkbook.Create; + FSpreadsheet.Options:=FSpreadsheet.Options+[boBufStream]; + // For extra performance. Note that virtual mode is not an option + // due to the data export determining flow of the program. + end; + FSheet:=FSpreadsheet.AddWorksheet(DoGetSheetName); FRow:=0; end; @@ -152,25 +199,34 @@ begin inherited DoDataHeader; end; -procedure TCustomFPSExport.DoAfterExecute; +{ Writes the workbook populated during the export process to file } +procedure TCustomFPSExport.SaveWorkbook; begin FRow:=0; // Overwrite existing file similar to how dbf export does it case Formatsettings.ExportFormat of - efXLS: FSpreadSheet.WriteToFile(FFileName,sfExcel8,true); - efXLSX: FSpreadsheet.WriteToFile(FFilename,sfOOXML,true); - efODS: FSpreadSheet.WriteToFile(FFileName,sfOpenDocument,true); - efWikiTable: FSpreadSheet.WriteToFile(FFileName,sfWikitable_wikimedia,true); + efXLS: + FSpreadSheet.WriteToFile(FFileName,sfExcel8,true); + efXLSX: + FSpreadsheet.WriteToFile(FFilename,sfOOXML,true); + efODS: + FSpreadSheet.WriteToFile(FFileName,sfOpenDocument,true); + efWikiTable: + FSpreadSheet.WriteToFile(FFileName,sfWikitable_wikimedia,true); else - ;// raise error? + raise Exception.Create('[TCustomFPSExport.SaveWorkbook] ExportFormat unknown'); end; +end; - // Don't free FSheet; done by FSpreadsheet - try - FreeAndNil(FSpreadsheet); - finally - Inherited; +procedure TCustomFPSExport.DoAfterExecute; +begin + if not FMultipleSheets then + begin + SaveWorkbook; + FreeAndNil(FSpreadsheet); // Don't free FSheet; done by FSpreadsheet end; + // Multi-sheet workbooks are written when WriteExportFile is called. + inherited; end; procedure TCustomFPSExport.DoDataRowEnd; @@ -178,6 +234,59 @@ begin FRow:=FRow+1; end; +function TCustomFPSExport.CalcSheetNameMask(const AMask: String): String; +begin + Result := AMask; + // No %d in the mask string + if pos('%d', Result) = 0 then + begin + // If the mask string is already used we'll add a number to the sheet name + if not FSpreadsheet.ValidWorksheetName(Result) then + begin + Result := AMask + '%d'; + exit; + end; + end; +end; + +function TCustomFPSExport.CalcUniqueSheetName(const AMask: String): String; +var + i: Integer; +begin + if pos('%d', AMask) > 0 then + begin + i := 0; + repeat + inc(i); + Result := Format(AMask, [i]); + until (FSpreadsheet.GetWorksheetByName(Result) = nil); + end else + Result := AMask; + if not FSpreadsheet.ValidWorksheetName(Result) then + Raise EDataExporter.CreateFmt(rsInvalidWorksheetName, [Result]); +end; + +{ Method which provides the name of the worksheet into which the dataset is to + be exported. There are several cases: + (1) Use the name defined in the FormatSettings. + (2) Provide the name in an event handler for OnGetSheetname. + The name provided from these sources can contain a %d placeholder which will + be replaced by a number such that the sheet name is unique. + If it does not contain a %d then a %d may be added if needed to get a unique + sheet name. } +function TCustomFPSExport.DoGetSheetName: String; +var + mask: String; +begin + mask := CalcSheetNameMask(FormatSettings.SheetName); + Result := CalcUniqueSheetName(mask); + if Assigned(FOnGetSheetName) then + begin + FOnGetSheetName(Self, FSpreadsheet.GetWorksheetCount, mask); + Result := CalcUniqueSheetName(mask); + end; +end; + procedure TCustomFPSExport.ExportField(EF: TExportFieldItem); var F : TFPSExportFieldItem; @@ -210,6 +319,16 @@ begin end; end; +procedure TCustomFPSExport.WriteExportFile; +begin + if FMultipleSheets then begin + SaveWorkbook; + FreeAndNil(FSpreadsheet); + // Don't free FSheet; done by FSpreadsheet + end; +end; + + procedure RegisterFPSExportFormat; begin ExportFormats.RegisterExportFormat(SFPSExport,rsFPSExportDescription,SPFSExtension,TFPSExport); @@ -229,8 +348,9 @@ begin If Source is TFPSExportFormatSettings then begin FS:=Source as TFPSExportFormatSettings; - HeaderRow:=FS.HeaderRow; - ExportFormat:=FS.ExportFormat; + HeaderRow := FS.HeaderRow; + ExportFormat := FS.ExportFormat; + SheetName := FS.SheetName; end; inherited Assign(Source); end; @@ -238,7 +358,8 @@ end; procedure TFPSExportFormatSettings.InitSettings; begin inherited InitSettings; - FExportFormat:=efXLS; //often used format + FExportFormat := efXLS; //often used format + FSheetName := 'Sheet'; end; end. diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index 75cf9c818..496a47982 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -12,6 +12,8 @@ interface resourcestring rsExportFileIsRequired = 'Export file name is required'; rsFPSExportDescription = 'Spreadsheet file'; + rsMultipleSheetsOnlyWithRestorePosition = 'Export to multiple sheets is possible '+ + 'only if position is restored.'; rsUnsupportedReadFormat = 'Tried to read a spreadsheet using an unsupported format'; rsUnsupportedWriteFormat = 'Tried to write a spreadsheet using an unsupported format'; rsNoValidSpreadsheetFile = '"%s" is not a valid spreadsheet file';