{ ********************************************************************** This file is part of the Free Pascal run time library. See the file COPYING.FPC, included in this distribution, for details about the license. ********************************************************************** fpDBExport basic configuration dialog. Copyright (c) 2007 by Michael Van Canneyt, member of the Free Pascal development team } 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 FFieldMap : TExportFields; FFormatting : TCustomExportFormatSettings; procedure FormToExporter; procedure MoveFieldDown; function MoveFieldUp: Boolean; procedure SelectField(F: TExportFieldItem); procedure ShowSelectedField; public 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 ModalResult:=mrok; if EFileName.Text <> '' then FormToExporter else begin MessageDlg('Information','Filename cannot be blank',mtInformation,[mbok],0); EFileName.SetFocus; ModalResult:=mrnone; end; 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.