lazarus/components/dbexport/frmbaseconfigexport.pp

{
 **********************************************************************
  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 (ItemIndex<Items.Count-1) then
      begin
      Items.Exchange(ItemIndex,ItemIndex+1);
      FFieldMap.Items[ItemIndex].Index:=ItemIndex+1;
      ItemIndex:=ItemIndex+1;
      end;
end;

procedure TBaseConfigExportForm.ADownUpdate(Sender: TObject);
begin
  With CLBFields do
    (Sender as Taction).Enabled:=(Itemindex<Items.Count-1);
end;

procedure TBaseConfigExportForm.AUpUpdate(Sender: TObject);
begin
  (Sender as Taction).Enabled:=(CLBFields.Itemindex>0)
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.