{ This file is part of the Free Pascal run time library. Copyright (c) 2007 by Michael Van Canneyt, member of the Free Pascal development team fpDBExport basic configuration dialog. See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit frmBaseConfigExport; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ButtonPanel, EditBtn, CheckLst, ComCtrls, RTTIGrids, fpdbexport, Buttons, ActnList, sdb_consts; type { TBaseConfigExportForm } TBaseConfigExportForm = class(TForm) AUp: TAction; ADown: TAction; ALFields: TActionList; CLBFields: TCheckListBox; EFileName: TFileNameEdit; LEFileName: TLabel; Label2: TLabel; LCLBFields: TLabel; PExportFieldList: TPanel; PUPDown: TPanel; PFieldProps: TPanel; PFieldsTop: TPanel; PCFields: TPageControl; PFileName: TPanel; PButtons: TButtonPanel; GFormatting: TTIPropertyGrid; SBup: TSpeedButton; SBDown: TSpeedButton; TSFields: TTabSheet; TSFormatting: TTabSheet; SplitterFields: TSplitter; GFieldProps: TTIPropertyGrid; FExporter: TCustomDatasetExporter; procedure ADownExecute(Sender: TObject); procedure ADownUpdate(Sender: TObject); procedure AUpExecute(Sender: TObject); procedure AUpUpdate(Sender: TObject); procedure CLBFieldsClick(Sender: TObject); procedure CLBFieldsItemClick(Sender: TObject; Index: integer); procedure CLBFieldsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure SetExporter(const AValue: TCustomDatasetExporter); Procedure OnOKClick(Sender : TObject); procedure ExporterToForm; private { private declarations } FFieldMap : TExportFields; FFormatting : TCustomExportFormatSettings; procedure FormToExporter; procedure MoveFieldDown; function MoveFieldUp: Boolean; procedure SelectField(F: TExportFieldItem); procedure ShowSelectedField; public { public declarations } Property Exporter : TCustomDatasetExporter Read FExporter Write SetExporter; end; var BaseConfigExportForm: TBaseConfigExportForm; Function ShowBaseExportConfig (AExporter : TCustomDatasetExporter) : Boolean; Procedure RegisterBaseExportConfigForm; implementation uses typinfo,lcltype; {$R *.lfm} Function ShowBaseExportConfig (AExporter : TCustomDatasetExporter) : Boolean; begin With TBaseConfigExportForm.Create(Application) do Try Exporter:=AExporter; Result:=(ShowModal=mrOK); Finally Free; end; end; Type { TShowBaseConfigDialog } TShowBaseConfigDialog = Class(TObject) Public Function ShowConfig (AExporter : TCustomDatasetExporter) : Boolean; end; { TShowBaseConfigDialog } function TShowBaseConfigDialog.ShowConfig(AExporter: TCustomDatasetExporter ): Boolean; begin Result:=ShowBaseExportConfig(AExporter); end; Var DLG : TShowBaseConfigDialog; Procedure RegisterBaseExportConfigForm; Var EF : TExportFormats; I : Integer; begin EF:=ExportFormats; For I:=0 to EF.Count-1 do begin If Not assigned(EF[i].OnConfigureDialog) then begin If DLG=Nil then DLG:=TShowBaseConfigDialog.Create; EF[i].OnConfigureDialog:=@DLG.ShowConfig; end; end; end; { TBaseConfigExportForm } procedure TBaseConfigExportForm.SetExporter(const AValue: TCustomDatasetExporter); begin if (FExporter=AValue) then exit; FExporter:=AValue; If Assigned(FExporter) then ExporterToForm; end; procedure TBaseConfigExportForm.OnOKClick(Sender: TObject); begin FormToExporter; end; procedure TBaseConfigExportForm.CLBFieldsItemClick(Sender: TObject; Index: integer); begin CLBFields.ItemIndex:=Index; ShowSelectedField; With CLBFields do If (ItemIndex<>-1) then begin FFieldMap[ItemIndex].Enabled:=Checked[ItemIndex]; GFieldProps.PropertyEditorHook.RefreshPropertyValues; end; end; procedure TBaseConfigExportForm.CLBFieldsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Shift=[ssShift] then begin If (Key=VK_UP) then MoveFieldUp else if (Key=VK_DOWN) then MoveFieldDown end; end; procedure TBaseConfigExportForm.CLBFieldsClick(Sender: TObject); begin ShowSelectedField; end; procedure TBaseConfigExportForm.ShowSelectedField; begin If (CLBFields.ItemIndex=-1) then SelectField(Nil) else SelectField(FFieldMap[CLBFields.ItemIndex]); end; procedure TBaseConfigExportForm.AUpExecute(Sender: TObject); begin MoveFieldUp; end; Function TBaseConfigExportForm.MoveFieldUp : Boolean; begin Result:=false; With CLBFields do If (ItemIndex>0) then begin Items.Exchange(ItemIndex,ItemIndex-1); FFieldMap.Items[ItemIndex].Index:=ItemIndex-1; ItemIndex:=ItemIndex-1; end; end; procedure TBaseConfigExportForm.ADownExecute(Sender: TObject); begin MoveFieldDown; end; procedure TBaseConfigExportForm.MoveFieldDown; begin With CLBFields do If (ItemIndex0) end; procedure TBaseConfigExportForm.FormCreate(Sender: TObject); begin // Caption:= sdb_Configuredataexport; LEFileName.Caption:= sdb_Filename; TSFields.Caption:= sdb_Fields; TSFormatting.Caption:= sdb_Formatting; LCLBFields.Caption:= sdb_Selectfieldstoexport; Label2.Caption:= sdb_Propertiesforselectedfield; SBup.Hint:= sdb_Moveselectedfieldup; SBDown.Hint:= sdb_Moveselectedfielddown; // PButtons.OKButton.OnClick:=@OnOKClick; end; procedure TBaseConfigExportForm.SelectField(F : TExportFieldItem); begin GFieldProps.TIObject:=F; GFieldProps.Enabled:=(F<>Nil); end; procedure TBaseConfigExportForm.FormDestroy(Sender: TObject); begin FreeAndNil(FFieldMap); FreeAndNil(FFormatting); end; procedure TBaseConfigExportForm.ExporterToForm; Var B : Boolean; EF : TExportFieldItem; I,J : Integer; FS : TCustomExportFormatSettings; begin B:=Exporter is TCustomFileExporter; B:=B or (FindPropInfo(Exporter,'FileName')<>Nil); PFileName.Visible:=B; If B then begin if Exporter is TCustomFileExporter then EFileName.FileName:=TCustomFileExporter(Exporter).FileName else EFileName.FileName:=GetStrProp(Exporter,'FileName'); EFileName.Filter:=ExportFormats.ConstructFilter(Exporter); end; { The following construct means that only explicitly added can be configured, or all fields. } FreeAndNil(FFieldMap); FFieldMap:=TExportFields.Create(Exporter.ExportFields.ItemClass); If (Exporter.ExportFields.Count=0) then Exporter.BuildDefaultFieldMap(FFieldMap) else For I:=0 to Exporter.ExportFields.Count-1 do FFieldMap.Add.Assign(Exporter.ExportFields[i]); For I:=0 to FFieldMap.Count-1 do begin EF:=FFieldMap[i]; J:=CLBFields.Items.AddObject(EF.FieldName,EF); CLBFields.Checked[J]:=EF.Enabled; end; If (CLBFields.Items.Count>0) then begin CLBFields.ItemIndex:=0; SelectField(FFieldMap[0]) end else begin CLBFields.ItemIndex:=-1; SelectField(Nil); end; B:=FindPropInfo(Exporter,'FormatSettings')<>Nil; TSFormatting.TabVisible:=B; If B then begin FS:=TCustomExportFormatSettings(GetObjectProp(Exporter,'FormatSettings')); FFormatting:=TCustomExportFormatSettingsClass(FS.ClassType).Create(False); FFormatting.Assign(FS); GFormatting.TIObject:=FFormatting; end else FreeAndNil(FFormatting); end; procedure TBaseConfigExportForm.FormToExporter; Var I : Integer; FS : TCustomExportFormatSettings; begin If PFileName.Visible then if (Exporter is TCustomFileExporter) then TCustomFileExporter(Exporter).FileName:=EFileName.FileName else SetStrProp(Exporter,'FileName',EFileName.FileName); If (Exporter.ExportFields.Count=0) then begin For I:=0 to FFieldMap.Count-1 do Exporter.ExportFields.Add.Assign(FFieldMap[i]); end else For I:=0 to FFieldMap.Count-1 do Exporter.ExportFields[I].Assign(FFieldMap[i]); If Assigned(FFormatting) then begin FS:=TCustomExportFormatSettings(GetObjectProp(Exporter,'FormatSettings')); FS.Assign(FFormatting); end; end; finalization FreeAndNil(DLG); end.