
{                                                                              }
{  IB_DataSourceEditor                                                         }
{                                                                              }

{***************************************************************}
{                                                               }
{          IB Objects Components and Resources Library          }
{                                                               }
{          Copyright (C) 1996-2007 Jason Wharton                }
{          and Computer Programming Solutions, Mesa, AZ         }
{                                                               }
{  This source code unit is released under the terms of the     }
{  CPS Trustware License.                                       }
{  It may be distributed or deployed as source code or in       }
{  compiled form only in compliance with the terms and          }
{  conditions of the CPS Trustware License which may be         )
{  examined at http://www.ibobjects.com/ibo_trustware.html      )
{                                                               }
{***************************************************************}

{******************************************************************************}
{  CONTRIBUTED MODIFICATIONS                                                   }
{  Additions or modifications listed below using format:                       }
{                                                                              }
{  Joe Citizen <joe@joecitizen.com>                                            }
{  mm/dd/yyyy                                                                  }
{     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                 }
{     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                 }
{     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                 }
{            Copyright (C) 2001 Joe Citizen                                    }
{                                                                              }
{------------------------------------------------------------------------------}
{  Place your credits and information in the top of the section                }
{  below with any other descriptions or explanations desired.                  }
{------------------------------------------------------------------------------}
{                                                                              }
{  Frank Ingermann <frank@fingerman.de>                                        }
{                                                                              }
{    a Component Editor for TIB_DataSource components: allows automatic        }
{    creation of TIB_* data aware controls for the fields of a DataSources'    }
{    DataSet.                                                                  }
{                                                                              }
{    portions of this code (mainly the drag'n'drop stuff) made by              }
{    Ales Kahanek, adapted from his IBF_FieldList unit.                        }
{                                                                              }
{    Revision history:                                                         }
{                                                                              }
{      2003/06/15: V1.0 @fi: initial release                                   }
{      2003/06/16: V1.1 @fi: rewritten to use Factories for the controls.      }
{      2003/06/18: V1.2 @fi: added persistent storage of layout in registry    }
{      2003/07/01: V1.3 @fi: code cleanup, minor fixes, some enhancements      }
{                                                                              }
{            Copyright (C) 2003 Frank Ingermann                                }
{                                                                              }
{******************************************************************************}

{$INCLUDE IB_Directives.inc}

unit
  IB_DataSourceEditor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, ComCtrls, ClipBrd, ToolWin, Registry,

  XSpin,
  IB_Constants,
  IB_Components,
  IB_Controls,
  IB_NavigationBar,
  IB_DatasetBar,
  IB_FieldDataLink,
  IB_Header,
  IBC_Label,

  {$IFDEF IBO_VCL60_OR_GREATER}
  DesignIntf, DesignEditors,
  {$ELSE}
  DsgnIntf,LibIntf,
  {$ENDIF}

  TypInfo,
  Menus;

type
  TIB_CtrlDirectionType = (cdtTopDown, cdtLeftRight);

  // data object for the layout information:

  TIB_CtrlLayoutInfo = class(TComponent)
  private
    FColumn: TIB_Column;
    FDatasource: TIB_DataSource;
    fDirection: TIB_CtrlDirectionType;
    fGap: Integer;
    fHeight: Integer;
    fLabelKind: TIB_AutoLabelKind;
    fLabelMargin: Integer;
    fLabelNamePrefix: string;
    fLabelRelPos: Integer;
    fLabelSuffix: String;
    fLeft: Integer;
    fNamePrefix: string;
    fTop: Integer;
    fUseControlHeight: Boolean;
    fUseDisplayWidth: Boolean;
    fUseIBLabel: Boolean;
    fWidth: Integer;

  published
    property DataSource:TIB_DataSource read FDatasource write FDatasource stored False;
    property Column:TIB_Column read FColumn write FColumn stored False;

    property NamePrefix:string read fNamePrefix write fNamePrefix;

    property Left:Integer read fLeft write fLeft;
    property Top:Integer read fTop write fTop;
    property Width:Integer read fWidth write fWidth;
    property Height:Integer read fHeight write fHeight;

    property UseDisplayWidth:Boolean read fUseDisplayWidth write fUseDisplayWidth;
    property UseControlHeight:Boolean read fUseControlHeight write fUseControlHeight;

    property Direction: TIB_CtrlDirectionType read fDirection write fDirection;
    property Gap:Integer read fGap write fGap;

    // IB_Label / AutoLabel stuff:

    property UseIBLabel:Boolean read fUseIBLabel write fUseIBLabel;

    property LabelKind:TIB_AutoLabelKind read fLabelKind write fLabelKind;

    property LabelRelPos:Integer read fLabelRelPos write fLabelRelPos;
    property LabelMargin:Integer read fLabelMargin write fLabelMargin;
    property LabelSuffix:String read fLabelSuffix write fLabelSuffix;
    property LabelNamePrefix:string read fLabelNamePrefix write fLabelNamePrefix;
  end;

  {****************************************************************************}

  // factory class that produces IB_* controls according to the CtrlInfo
  // provides the ability to plug in more factories for e.g.
  // Geoff Worboys' Enhanced conrols

  TIB_CtrlFactory = Class;

  TIB_CtrlFactoryClass = Class of TIB_CtrlFactory;

  TIB_CtrlFactory = class(TObject)
  public
    class procedure RegisterFactory(aFactoryClass:TIB_CtrlFactoryClass;
                                    aFactoryTitle:String);
      // every concrete control factory must register itself here

    class procedure EnumFactories(sl:TStrings);
      // this will fill sl with the Titles of all registered factories in
      // Strings[] and pointers to the concrete classes in the Objects[] }

    class function FactoryByTitle(aFactoryTitle:String):TIB_CtrlFactoryClass;

    class function CreateControl(
      aOwner: TComponent;
      aParent:TWinControl;
      aInfo:TIB_CtrlLayoutInfo): TControl; virtual;
      // override and implement this to actually create a control.
      // see IB_DSStdCtrlFactories on how to do this.

    class function CreateLabelForControl(
      aOwner: TComponent;
      aParent: TWinControl;
      aInfo: TIB_CtrlLayoutInfo;
      aControl: TControl): TControl; virtual;
      // this is a standard implementation, override it as needed.
  end;

  {****************************************************************************}

  // factory class that produces source code based on field (TIB_Column) lists
  // provides the ability to plug in more factories for other purposes.

  TIB_SrcGenFactory = Class;

  TIB_SrcGenFactoryClass = Class of TIB_SrcGenFactory;

  TIB_SrcGenFactory = class(TObject)
  public
    class procedure RegisterFactory(aFactoryClass:TIB_SrcGenFactoryClass;
                                    aFactoryTitle:String);
      // every concrete source code generator factory must register itself here

    class procedure EnumFactories(sl:TStrings);
      // this will fill sl with the Titles of all registered factories in
      // Strings[] and pointers to the concrete classes in the Objects[] }

    class function FactoryByTitle(aFactoryTitle:String):TIB_SrcGenFactoryClass;

    class function GenerateSourcecode(
      aDataSource:TIB_DataSource;
      aFieldList:TList): String; virtual;
      // when called from the editor, aFieldList contains the selected fields
      // (TIB_Columns) from the lbxFields on the form.
      // this base implementation simply makes a list of the field names.
  end;

  {****************************************************************************}

  // the control generator form:

  TfrmIB_DataSourceEditor = class(TForm)
    pnlHeader: TPanel;
    pnlBody: TPanel;
    pnlFooter: TPanel;
    lbxFields: TListBox;
    lblHeader: TLabel;
    btnInsertControls: TSpeedButton;
    pnlOptions: TPanel;
    spnTop: TXSpinEdit;
    lblTop: TLabel;
    lblDistance: TLabel;
    spnGap: TXSpinEdit;
    lblNamePrefix: TLabel;
    lblLeft: TLabel;
    spnLeft: TXSpinEdit;
    lblWidth: TLabel;
    spnWidth: TXSpinEdit;
    Panel1: TPanel;
    dsbar: TIB_DatasetBar;
    navbar: TIB_NavigationBar;
    gbxAutoLabel: TGroupBox;
    lblAutolabelSuffix: TLabel;
    lblAutolabelRelPos: TLabel;
    edtAutoLabelSuffix: TEdit;
    spnAutoLabelRelPos: TXSpinEdit;
    chxUseDisplayWidth: TCheckBox;
    chxSeparateLabel: TCheckBox;
    lblAutolabelNamePrefix: TLabel;
    edtLabelNamePrefix: TEdit;
    btnRemove: TSpeedButton;
    btnClose: TSpeedButton;
    edtNamePrefix: TComboBox;
    lblHeight: TLabel;
    spnHeight: TXSpinEdit;
    chxUseCtrlHeight: TCheckBox;
    spnAutoLabelMargin: TXSpinEdit;
    lblAutolabelMargin: TLabel;
    Panel2: TPanel;
    Label8: TLabel;
    cbxParent: TComboBox;
    Label10: TLabel;
    cbxFactory: TComboBox;
    cbxAutoLabelKind: TComboBox;
    lblAutolabelKind: TLabel;
    lblDirection: TLabel;
    cbxDirection: TComboBox;
    popMain: TPopupMenu;
    mniSelectAll: TMenuItem;
    mniCopyToClipboard: TMenuItem;
    mniCopySelected: TMenuItem;
    mniInvertSelection: TMenuItem;
    mniSrcGen: TMenuItem;
    N1: TMenuItem;
    mniEditPrefs: TMenuItem;
    pnlPrefs: TPanel;
    memPrefs: TMemo;
    dlgLoad: TOpenDialog;
    dlgSave: TSaveDialog;
    popPrefs: TPopupMenu;
    mniLoadPrefs: TMenuItem;
    mniSavePrefs: TMenuItem;
    mniSetPrefsDefault: TMenuItem;
    Panel3: TPanel;
    btnQuitPrefs: TSpeedButton;
    btnSetPrefsDefault: TSpeedButton;
    btnPrefs: TSpeedButton;
    mniSetLayoutDefault: TMenuItem;
    N2: TMenuItem;
    btnLeftStartSet: TSpeedButton;
    btnLeftStartReset: TSpeedButton;
    btnTopStartSet: TSpeedButton;
    btnTopStartReset: TSpeedButton;
    mniQuitPrefs: TMenuItem;
    mniN3: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure btnInsertControlsClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnQuitPrefsClick(Sender: TObject);
    procedure dsbarAfterAction(Sender: TObject);
    procedure lbxFieldsStartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure lbxFieldsDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure lbxFieldsDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure mniSelectAllClick(Sender: TObject);
    procedure mniCopyToClipboardClick(Sender: TObject);
    procedure mniCopySelectedClick(Sender: TObject);
    procedure mniInvertSelectionClick(Sender: TObject);
    procedure mniGenPBNCodeClick(Sender: TObject);
    procedure mniGenFBNCodeClick(Sender: TObject);
    procedure mniGenParamObjsClick(Sender: TObject);
    procedure mniEditPrefsClick(Sender: TObject);
    procedure mniLoadPrefsClick(Sender: TObject);
    procedure mniSavePrefsClick(Sender: TObject);
    procedure mniSetPrefsDefaultClick(Sender: TObject);
    procedure mniSetLayoutDefaultClick(Sender: TObject);
    procedure btnLeftStartSetClick(Sender: TObject);
    procedure btnLeftStartResetClick(Sender: TObject);
    procedure btnTopStartSetClick(Sender: TObject);
    procedure btnTopStartResetClick(Sender: TObject);
  private
    fDataSet : TIB_DataSet;
    fDataSource : TIB_DataSource;

    fCtrls: TList;

    fCtrlInfo: TIB_CtrlLayoutInfo;

    FDragObject: TDragObject;

    fBaseKey:String;

    fCtrlParent : TComponent;

    fLeftStart : Integer;
    fTopStart : Integer;

    procedure SetSrc(const value:TIB_Datasource);

  protected
    procedure FillFactoriesCbx;
    procedure FillParentCbx;
    procedure FillFieldsLbx;

    procedure FillSrcGenMenu;

    procedure DoonSrcGenMenuClick(Sender:TObject);

    procedure GetLayoutInfos(aCtrlInfo: TIB_CtrlLayoutInfo);
    procedure SetLayoutInfos(aCtrlInfo: TIB_CtrlLayoutInfo);

    procedure ReadLayoutInfosFromRegistry;
    procedure WriteLayoutInfosToRegistry;

    procedure ReadPrefsFromRegistry;
    procedure WritePrefsToRegistry;

    function FindPrefs(column : TIB_Column;
                       var factory : TIB_CtrlFactoryClass;
                       var prefix : String):Boolean; virtual;

    procedure GenerateXByNameCode(PorF:String);
    procedure GenerateParamObjectsCode;

    procedure InsertControls;
    procedure RemoveControls;

  public
    property DataSource : TIB_DataSource read fDataSource write SetSrc;
  end;

  {****************************************************************************}

  // the Component Editor:

  TIB_DataSourceEditor = Class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function  GetVerb(Index: Integer): string; override;
    function  GetVerbCount: Integer; override;
    procedure Edit; override;
  end;

procedure Register;

var
  frmIB_DataSourceEditor: TfrmIB_DataSourceEditor;

{******************************************************************************}

implementation

{$R *.DFM}

{******************************************************************************}

procedure Register;
begin
  RegisterComponentEditor(TIB_DataSource, TIB_DataSourceEditor);
end;

{******************************************************************************}

TYPE
  // concrete control factories for all the standard IB_* controls:

  TIB_EditCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_ComboboxCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_TextCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_CheckBoxCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_MemoCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_DateTimePickerCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_ListboxCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_DateCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_RichEditCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_RadioGroupCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_ImageCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  TIB_CurrencyCtrlFactory = class(TIB_CtrlFactory)
  public
    class function CreateControl(AOwner: TComponent; AParent:TWinControl;
      AInfo:TIB_CtrlLayoutInfo): TControl; override;
  end;

  {****************************************************************************}

  // concrete src gen factories for some common tasks:

  TIB_FieldByNameSrcGenFactory = class(TIB_SrcGenFactory)
  public
    class function DoGenerateSourceCode(
      aDataSource:TIB_DataSource;
      aFieldList:TList;
      aFunctionname:String): String;

    class function GenerateSourcecode(
      aDataSource:TIB_DataSource;
      aFieldList:TList): String; override;
  end;

  TIB_ParamByNameSrcGenFactory = class(TIB_SrcGenFactory)
  public
    class function GenerateSourcecode(
      aDataSource:TIB_DataSource;
      aFieldList:TList): String; override;
  end;

  TIB_ParamObjectSrcGenFactory = class(TIB_SrcGenFactory)
  public
    class function GenerateSourcecode(
      aDataSource:TIB_DataSource;
      aFieldList:TList): String; override;
  end;

{******************************************************************************}

// utility funcs


//PV: FreeAndNIL was only added in D5, so:

{$IFNDEF IBO_VCL50_OR_GREATER}
procedure FreeAndNil( var Obj );
begin
  if TObject( Obj ) <> nil then
  begin
    TObject( Obj ).Free;
    TObject( Obj ) := nil;
  end
end;
{$ENDIF}



function FilterToDelphiName( AName: string ): string;
var ii: integer;
begin
  Result := '';
  for ii := 1 to Length( AName ) do
  begin
    if ii = 1 then
    begin
      if AName[ii] in ['a'..'z','A'..'Z','_'] then
        Result := Result + AName[ii];
    end
    else
      if AName[ii] in ['a'..'z','A'..'Z','_','0'..'9'] then
        Result := Result + AName[ii];
  end;
end;

// return the length of the longest field name

function MaxFieldnameLength(lst:TList):Integer;
var
  I: Integer;
begin
  Result := 0;

  for I := 0 to lst.Count - 1 do
  begin
    if Length(TIB_Column(lst[i]).BestFieldName)>Result then
      Result := Length(TIB_Column(lst[i]).BestFieldName);
  end;
end;

function Pad(s:String;len:Integer):String;
begin
  Result := s;
  while length(result)<len do
    Result := Result+' ';
end;

function AsTypeStrForColumn( aColumn: TIB_Column ):String;
begin
  case aColumn.SQLType of
    SQL_FLOAT,
    SQL_FLOAT_:     Result := 'AsFloat';
    SQL_DOUBLE,
    SQL_DOUBLE_:    Result := 'AsDouble';
    SQL_SHORT,
    SQL_SHORT_:     Result := 'AsInteger';
    SQL_LONG,
    SQL_LONG_:      Result := 'AsInteger';
    SQL_QUAD,
    SQL_QUAD_,
    SQL_INT64,
    SQL_INT64_:     Result := 'AsInt64';
    SQL_TYPE_DATE,
    SQL_TYPE_DATE_: Result := 'AsDate';
    SQL_TYPE_TIME,
    SQL_TYPE_TIME_: Result := 'AsDateTime';
    SQL_TIMESTAMP,
    SQL_TIMESTAMP_: Result := 'AsDateTime';
    SQL_TEXT,
    SQL_TEXT_:      Result := 'AsString';
    SQL_VARYING,
    SQL_VARYING_:   Result := 'AsString';
    SQL_BLOB,
    SQL_BLOB_:      Result := 'AsString';
  end;
end;

function DefaultValueStrForColumn( aColumn: TIB_Column ):String;
begin
  case aColumn.SQLType of
    SQL_FLOAT,
    SQL_FLOAT_:     Result := '0.0';
    SQL_DOUBLE,
    SQL_DOUBLE_:    Result := '0.0';
    SQL_SHORT,
    SQL_SHORT_:     Result := '0';
    SQL_LONG,
    SQL_LONG_:      Result := '0';
    SQL_QUAD,
    SQL_QUAD_,
    SQL_INT64,
    SQL_INT64_:     Result := '0';
    SQL_TYPE_DATE,
    SQL_TYPE_DATE_: Result := 'NOW';
    SQL_TYPE_TIME,
    SQL_TYPE_TIME_: Result := 'NOW';
    SQL_TIMESTAMP,
    SQL_TIMESTAMP_: Result := 'NOW';
    SQL_TEXT,
    SQL_TEXT_:      Result := '''''';
    SQL_VARYING,
    SQL_VARYING_:   Result := '''''';
    SQL_BLOB,
    SQL_BLOB_:      Result := '''''';
  end;
end;

// component loading & saving in DFM format

function LoadComponentFromStrings(_cmp:TComponent;_sl:TStrings):Boolean;
var
  dfmStream,txtstream : TStream;
begin
  Result := True;

  dfmStream := TMemoryStream.Create;
  txtstream := TMemoryStream.Create;
  try
    _sl.SaveToStream(txtstream);
    txtstream.seek(0,soFromBeginning);

    ObjectTextToBinary(txtstream,dfmstream);

    try
      dfmstream.Seek(0,soFromBeginning);
      dfmStream.ReadComponent(_cmp); // read our own props from the stream
    except
      on E:Exception do
      begin
        Application.ShowException(E);
        Result := False;
      end;
    end;

  finally
    dfmStream.Free;
    txtstream.free;
  end;
end;

function SaveComponentToStrings(_cmp:TComponent;_sl:TStrings):Boolean;
var
  dfmStream,txtstream : TStream;
begin
  Result := True;

  _sl.Clear;

  dfmStream := TMemoryStream.Create;
  txtstream := TMemoryStream.Create;
  try
    dfmStream.Seek(0,soFromBeginning);
    dfmStream.WriteComponent(_cmp);    // write the props to the stream
    dfmStream.Seek(0,soFromBeginning); // back to start

    ObjectBinaryToText(dfmstream,txtstream);

    txtStream.Seek(0,soFromBeginning);

    _sl.LoadFromStream(txtstream);
  finally
    dfmStream.Free;
    txtstream.free;
  end;
end;

{******************************************************************************}

{ TIB_DragFields }

type
  TIB_DragFields = class(TDragControlObject)
  private
    FfrmIB_DataSourceEditor: TfrmIB_DataSourceEditor;
  public
    constructor Create( AControl: TControl;
                        AfrmIB_DataSourceEditor: TfrmIB_DataSourceEditor );
                                                                    reintroduce;
    property frmIB_DataSourceEditor: TfrmIB_DataSourceEditor
        read FfrmIB_DataSourceEditor;
  end;

constructor TIB_DragFields.Create( AControl: TControl;
                              AfrmIB_DataSourceEditor: TfrmIB_DataSourceEditor);
begin
  inherited Create(AControl);
  FfrmIB_DataSourceEditor := AfrmIB_DataSourceEditor;
end;

{******************************************************************************}

{ TIB_FieldsTarget }

type
  TIB_FieldsTarget = class(TDragTarget)
  public
    function DragOver(Target, Source: TObject; X, Y: Integer;
      State: TDragState): Boolean; override;
    procedure DragDrop(Target, Source: TObject; X, Y: Integer); override;
  end;

function TIB_FieldsTarget.DragOver(Target, Source: TObject; X, Y: Integer;
  State: TDragState): Boolean;

var
  frmIB_DataSourceEditor: TfrmIB_DataSourceEditor;
begin
  frmIB_DataSourceEditor := TIB_DragFields(Source).frmIB_DataSourceEditor;

  // only allow drop if target is on the form with the datasource:
  // (gives funny effects in the form designer otherwise...)

  Result := (frmIB_DataSourceEditor.DataSource.Owner =
              (Target as TComponent)) // the form itself
            OR
            (frmIB_DataSourceEditor.DataSource.Owner =
              (Target as TComponent).Owner); // e.g. a Panel on the form
end;

procedure TIB_FieldsTarget.DragDrop(Target, Source: TObject; X, Y: Integer);
var
  frmIB_DataSourceEditor: TfrmIB_DataSourceEditor;
begin
  frmIB_DataSourceEditor := TIB_DragFields(Source).frmIB_DataSourceEditor;

  with frmIB_DataSourceEditor do
  begin
    fCtrlParent := (Target as TComponent);

    spnLeft.Value := x;
    spnTop.Value := y;

    InsertControls;
  end;
end;

{******************************************************************************}

var
  ConcreteCtrlFactories:TStrings;

{ TIB_CtrlFactory }

class procedure TIB_CtrlFactory.RegisterFactory(
  aFactoryClass: TIB_CtrlFactoryClass; aFactoryTitle: String);
var
  idx : Integer;
begin
  // prevent multiple insertion of same factory, either by name or by class
  idx := ConcreteCtrlFactories.IndexOfObject(TObject(aFactoryClass));

  if idx<0 then  // class not in, check title
    idx := ConcreteCtrlFactories.IndexOf(aFactoryTitle);

  if idx>=0 then
  begin
    ConcreteCtrlFactories.Strings[idx] := aFactoryTitle;
    ConcreteCtrlFactories.Objects[idx] := TObject(aFactoryClass);
  end
  else
    ConcreteCtrlFactories.AddObject(aFactoryTitle,TObject(aFactoryClass));
end;

class procedure TIB_CtrlFactory.EnumFactories(sl: TStrings);
begin
  sl.Assign(ConcreteCtrlFactories)
end;

class function TIB_CtrlFactory.FactoryByTitle(
  aFactoryTitle:String):TIB_CtrlFactoryClass;
var
  idx : Integer;
begin
  idx := ConcreteCtrlFactories.IndexOf(aFactoryTitle);
  if idx>=0 then
    result := TIB_CtrlFactoryClass(ConcreteCtrlFactories.Objects[idx])
  else
    result := nil;
end;

class function TIB_CtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_Edit;
begin
  ctrl := TIB_Edit.Create(aOwner); // default behaviour: create a TIB_Edit
  {$I IB_DataSourceEditor.imp}
end;

class function TIB_CtrlFactory.CreateLabelForControl(
  AOwner: TComponent; AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo;
  AControl: TControl): TControl;
var
  lbl : TIB_Label;
  albl : TIB_AutoLabel;
//PV: need following var for D4 (and lower?), near end of function
  pi : PPropInfo;
begin
  result := nil;
  lbl := nil;

  if aInfo.UseIBLabel then
  begin
    if (aInfo.LabelKind<>albNone) and
       (aControl IS TWinControl) then // can't set graphic ctrl as FocusControl
    begin
      lbl := TIB_Label.Create(aOwner);
      lbl.Parent := aParent;
      lbl.FocusControl := aControl AS TWinControl;

      lbl.Name := aInfo.LabelNamePrefix + aInfo.Column.Fieldname;
      lbl.Suffix := aInfo.LabelSuffix;

      // this next section is adapted from TIB_AutoLabel.Make so that a
      // separate TIB_Label will behave similarly:

      case aInfo.LabelKind of
        albLeft :
          begin
            if (aInfo.LabelRelPos <> 0) then
            begin
              lbl.Left := aControl.Left + aInfo.LabelRelPos;
              if (aInfo.LabelRelPos < 0) then
                lbl.Width := -aInfo.LabelRelPos;
              lbl.Alignment := taLeftJustify;
            end
            else
            begin
              lbl.Alignment := taRightJustify;
              lbl.Left := aControl.Left - lbl.Width - 3;
            end;
            lbl.Top := aControl.Top + aInfo.LabelMargin;
            lbl.Height := aControl.Height - aInfo.LabelMargin;
          end;
        albTop:
          begin
            if (aInfo.LabelRelPos <> 0) then
              lbl.Top := aControl.Top + aInfo.LabelRelPos
            else
              lbl.Top := aControl.Top - lbl.Height;

            lbl.Left := aControl.Left + aInfo.LabelMargin;
            lbl.Alignment := taLeftJustify;
          end;
      end; // case
    end;
  end
  else
  begin
    // the quick'n'dirty RTTI way to get to the autolabel regardless
    // of aControl's class...

  {$IFDEF IBO_VCL50_OR_GREATER}
    if not IsPublishedProp(aControl,'AutoLabel') then
      exit;
  {$ENDIF}

//PV: D4 doesn't seem to support the string version of GetOrdProp, so I
//    replaced the next line:
{
    albl := TIB_AutoLabel(GetOrdProp(aControl,'AutoLabel'));
}
//    ...with these three (which also work in later versions):

    pi := getPropInfo( pTypeInfo( aControl.ClassInfo ), 'AutoLabel' );
    if pi = NIL then Exit;
    aLbl := TIB_AutoLabel( getOrdProp( aControl, pi ) );


    if aLbl<>NIL then // it actually has an AutoLabel
    begin
      albl.Kind   := aInfo.LabelKind;
      albl.Suffix := aInfo.LabelSuffix;
      albl.Margin := aInfo.LabelMargin;
      albl.RelativePosition := aInfo.LabelRelPos;
    end;

  end;

  // if we created a seperate TIB_Label, return it for the undo list
  Result := lbl;
end;

{******************************************************************************}

{ TIB_EditCtrlFactory }

class function TIB_EditCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_Edit;
begin
  ctrl := TIB_Edit.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_ComboboxCtrlFactory }

class function TIB_ComboboxCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_Combobox;
begin
  ctrl := TIB_Combobox.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_TextCtrlFactory }

class function TIB_TextCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_Text;
begin
  ctrl := TIB_Text.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_CheckBoxCtrlFactory }

class function TIB_CheckBoxCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_CheckBox;
begin
  ctrl := TIB_CheckBox.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_MemoCtrlFactory }

class function TIB_MemoCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_Memo;
begin
  ctrl := TIB_Memo.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_DateTimePickerCtrlFactory }

class function TIB_DateTimePickerCtrlFactory.CreateControl(
  AOwner: TComponent; AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_DateTimePicker;
begin
  ctrl := TIB_DateTimePicker.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_ListboxCtrlFactory }

class function TIB_ListboxCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_Listbox;
begin
  ctrl := TIB_Listbox.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_DateCtrlFactory }

class function TIB_DateCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_Date;
begin
  ctrl := TIB_Date.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_RichEditCtrlFactory }

class function TIB_RichEditCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_RichEdit;
begin
  ctrl := TIB_RichEdit.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_RadioGroupCtrlFactory }

class function TIB_RadioGroupCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_RadioGroup;
begin
  ctrl := TIB_RadioGroup.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_ImageCtrlFactory }

class function TIB_ImageCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_Image;
begin
  ctrl := TIB_Image.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{ TIB_CurrencyCtrlFactory }

class function TIB_CurrencyCtrlFactory.CreateControl(AOwner: TComponent;
  AParent: TWinControl; AInfo: TIB_CtrlLayoutInfo): TControl;
var
  ctrl : TIB_Currency;
begin
  ctrl := TIB_Currency.Create(AOwner);
  {$I IB_DataSourceEditor.imp}
end;

{******************************************************************************}

var
  ConcreteSrcGenFactories:TStrings;

{ TIB_SrcGenFactory }

class procedure TIB_SrcGenFactory.RegisterFactory(
  aFactoryClass: TIB_SrcGenFactoryClass; aFactoryTitle: String);
var
  idx : Integer;
begin
  // prevent multiple insertion of same factory, either by name or by class
  idx := ConcreteSrcGenFactories.IndexOfObject(TObject(aFactoryClass));

  if idx<0 then  // class not in, check title
    idx := ConcreteSrcGenFactories.IndexOf(aFactoryTitle);

  if idx>=0 then
  begin
    ConcreteSrcGenFactories.Strings[idx] := aFactoryTitle;
    ConcreteSrcGenFactories.Objects[idx] := TObject(aFactoryClass);
  end
  else
    ConcreteSrcGenFactories.AddObject(aFactoryTitle,TObject(aFactoryClass));
end;

class procedure TIB_SrcGenFactory.EnumFactories(sl: TStrings);
begin
  sl.Assign(ConcreteSrcGenFactories);
end;

class function TIB_SrcGenFactory.FactoryByTitle(
  aFactoryTitle: String): TIB_SrcGenFactoryClass;
var
  idx : Integer;
begin
  idx := ConcreteSrcGenFactories.IndexOf(aFactoryTitle);
  if idx>=0 then
    result := TIB_SrcGenFactoryClass(ConcreteSrcGenFactories.Objects[idx])
  else
    result := nil;
end;

class function TIB_SrcGenFactory.GenerateSourcecode(
  aDataSource: TIB_DataSource; aFieldList: TList): String;
var
  i : Integer;
begin
  result := '';

  for i := 0 to aFieldList.Count - 1 do
    Result := Result + TIB_Column(aFieldList[i]).FieldName + #13#10;
end;

{******************************************************************************}

{ TIB_FieldByNameSrcGenFactory }

class function TIB_FieldByNameSrcGenFactory.DoGenerateSourceCode(
  aDataSource: TIB_DataSource; aFieldList: TList;
  aFunctionname: String): String;
var
  i: integer;
  s : string;
  col : TIB_Column;
  astype,defaultvalue : String;
  fldname : String;
  maxlen : Integer;
begin
  s := '';

  maxlen := MaxFieldnameLength(aFieldList);

  for i := 0 to aFieldList.Count-1 do
  begin
    col := TIB_Column(aFieldList[i]);

    AsType       := Pad(AsTypeStrForColumn(col),10);
    defaultvalue := DefaultValueStrForColumn(col);

    fldname := Pad(''''+col.BestFieldName+'''',maxlen+2);

    s := s + Format('%s(%s).%s := %s;'#13#10,
                    [aFunctionName, fldname, astype, defaultvalue]);
  end;

  Result := s;
end;

class function TIB_FieldByNameSrcGenFactory.GenerateSourcecode(
  aDataSource: TIB_DataSource; aFieldList: TList): String;
begin
  Result := DoGenerateSourceCode(aDataSource,aFieldList,'FieldByName');
end;

{ TIB_ParamByNameSrcGenFactory }

class function TIB_ParamByNameSrcGenFactory.GenerateSourcecode(
  aDataSource: TIB_DataSource; aFieldList: TList): String;
begin
  Result := TIB_FieldByNameSrcGenFactory.DoGenerateSourceCode(
              aDataSource,aFieldList,'ParamByName');

end;

{ TIB_ParamObjectSrcGenFactory }

class function TIB_ParamObjectSrcGenFactory.GenerateSourcecode(
  aDataSource: TIB_DataSource; aFieldList: TList): String;
var
  i: integer;
  s : string;
  col : TIB_Column;
  astype,defaultvalue : String;
  maxlen : integer;
begin
  s := 'var'+#13#10;

  maxlen := MaxFieldnameLength(aFieldList);

  for i := 0 to aFieldList.Count-1 do
  begin
    col := TIB_Column(aFieldList[i]);

    s := s + '  par'+Pad(col.BestFieldName,maxlen)+' : TIB_Column;'+#13#10;
  end;

  s := s + 'begin'+#13#10;
  s := s + '  with '+aDataSource.DataSet.Name+' do'+#13#10;
  s := s + '  begin'+#13#10;
  s := s + '    if not prepared then prepare;'+#13#10;
  s := s + #13#10;

  for i := 0 to aFieldList.Count-1 do
  begin
    col := TIB_Column(aFieldList[i]);

    s := s + '    par'+Pad(col.BestFieldName,maxlen)
           + ' := ParamByName('''+col.BestFieldName+''');'+#13#10;
  end;

  s := s + #13#10;
  s := s + '    while not <condition> do'+ #13#10;
  s := s + '    begin'+ #13#10;

  for i := 0 to aFieldList.Count-1 do
  begin
    col := TIB_Column(aFieldList[i]);

    AsType       := Pad(AsTypeStrForColumn(col),10);
    defaultvalue := DefaultValueStrForColumn(col);

    s := s + '      par'+Pad(col.BestFieldName,maxlen)+'.'+AsType
           + ' := '+defaultValue+';'+#13#10;
  end;
  s := s + '      // Execute / Next / ...'+ #13#10;
  s := s + '    end;'+ #13#10;

  s := s + #13#10;
  s := s + '  end;'#13#10;

  Result := s;
end;

{******************************************************************************}

{ TfrmIB_DataSourceEditor }

procedure TfrmIB_DataSourceEditor.FormCreate(Sender: TObject);
begin
  fCtrls := TList.Create;
  fCtrlInfo := TIB_CtrlLayoutInfo.Create(self);

  cbxDirection.ItemIndex := 0;
  cbxAutoLabelKind.ItemIndex := 0;

  FillFactoriesCbx;
  FillSrcGenMenu;

  fBaseKey := IBO_BASEKEY + '\Editors\DataSource';

  ReadPrefsFromRegistry;
  ReadLayoutInfosFromRegistry;
end;

procedure TfrmIB_DataSourceEditor.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if memprefs.Modified then
  begin
    case MessageDlg('Preferences modified. Save persistently?',
                  mtWarning,[mbYes,mbNo,mbCancel],0) of
      mrYes: WritePrefsToRegistry;
      mrCancel: CanClose := False;
      mrNo: ; //exit without saving prefs
    end;
  end;
end;

procedure TfrmIB_DataSourceEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmIB_DataSourceEditor.FormDestroy(Sender: TObject);
begin
  if FDragObject<>NIL then
    FreeAndNIL(FDragObject);

  FreeAndNil(fCtrls);
  FreeAndNIL(fCtrlInfo);
end;

// attach to the datasource

procedure TfrmIB_DataSourceEditor.SetSrc(const value:TIB_Datasource);
begin
  fDataSource := Value;

  dsbar.Datasource := Value;
  navbar.Datasource := Value;

  fDataSet:= Value.Dataset;

  Assert(fDataSet<>NIL,'DataSet is NIL!');

  FillParentCbx;

  FillFieldsLbx;

  lblHeader.Caption :=
    fDataSource.Owner.Name+': '+fDataSource.Name+' -> '+fDataSet.name;
end;

// populate "class" combobox with the list of registered control factories

procedure TfrmIB_DataSourceEditor.FillFactoriesCbx;
begin
  TIB_CtrlFactory.EnumFactories(cbxFactory.Items);

  cbxFactory.Items.InsertObject(0,'< automatic >',nil);

  cbxFactory.DropDownCount := cbxFactory.Items.Count;
  cbxFactory.ItemIndex := 0;
end;

// fill the Parent combobox with all controls on the form that accept controls

procedure TfrmIB_DataSourceEditor.FillParentCbx;
var
  I: Integer;
  cmp : TComponent;
begin
  cbxParent.Items.AddObject(fDataSource.owner.Name,fDataSource.Owner);

  for I := 0 to fDataSource.owner.ComponentCount - 1 do
  begin
    cmp := fDataSource.owner.Components[i];

    if (cmp is TWinControl) and
       (csAcceptsControls in (cmp as TWinControl).ControlStyle) then
      cbxParent.Items.AddObject(cmp.Name,cmp);
  end;

  cbxParent.ItemIndex := 0;
end;

// fill the Fields listbox with all columns in the dataset

procedure TfrmIB_DataSourceEditor.FillFieldsLbx;
var
  i: Integer;
  col : TIB_Column;
begin
  lbxFields.Items.Clear;

  if (fDataSet=nil) or not (fDataSet.prepared) then exit;

  if fDataSet.Fields.ColumnCount > 0 then
    for i:=0 TO fDataSet.Fields.ColumnCount-1 do
    begin
      col := fDataSet.Fields.Columns[i];

      lbxFields.Items.AddObject( col.FieldName + ' ' +
                                 Lowercase( col.sqltypesource[true] ),
                                 col);

      lbxFields.Selected[i] := True;
    end;
end;

procedure TfrmIB_DataSourceEditor.FillSrcGenMenu;
var
  sl : TStrings;
  i : integer;
  mni : TMenuItem;
begin
  sl := TStringList.Create;

  TIB_SrcGenFactory.EnumFactories(sl);

  try
    for I := 0 to sl.Count - 1 do
    begin
      mni := TMenuItem.Create(self);
      mni.OnClick := DoonSrcGenMenuClick;
      mni.Caption := sl[i];
      mni.Tag := Integer(sl.Objects[i]); // pointer to the factory class

      mniSrcGen.Add(mni);
    end;
  finally
    sl.Free;
  end;
end;

procedure TfrmIB_DataSourceEditor.DoonSrcGenMenuClick(Sender: TObject);
var
  i : Integer;
  fct : TIB_SrcGenFactoryClass;
  lst : TList;
  srccode : String;
begin
  fct := TIB_SrcGenFactoryClass((Sender as TMenuItem).Tag);

  lst := TList.Create;
  try
    for i := 0 to lbxFields.Items.Count - 1 do
      if lbxFields.Selected[i] then
        lst.Add(lbxFields.Items.Objects[i]); // the TIB_Column

    srccode := fct.GenerateSourceCode(fDataSource,lst);

    ClipBoard.AsText := srccode;

    ShowMessage('OK, generated source code copied to clipboard.');
  finally
    lst.Free;
  end;
end;

// copy the layout control's contents to the Info obj passed to the factory

procedure TfrmIB_DataSourceEditor.GetLayoutInfos(aCtrlInfo:TIB_CtrlLayoutInfo);
begin
  with aCtrlInfo do
  begin
    NamePrefix       := edtNamePrefix.Text;

    DataSource       := fDataSource;

    Left             := spnLeft.Value;
    Top              := spnTop.Value;

    Width            := spnWidth.Value;
    Height           := spnHeight.Value;

    UseDisplayWidth  := chxUseDisplayWidth.Checked;
    UseControlHeight := chxUseCtrlHeight.Checked;

    Direction        := TIB_CtrlDirectionType(cbxDirection.ItemIndex);
    Gap              := spnGap.Value;

    LabelKind        := TIB_AutoLabelKind(cbxAutoLabelKind.ItemIndex);
    LabelSuffix      := edtAutoLabelSuffix.Text;

    LabelMargin      := spnAutoLabelMargin.Value;
    LabelRelPos      := spnAutoLabelRelPos.Value;

    UseIBLabel       := chxSeparateLabel.Checked;
    LabelNamePrefix  := edtLabelNamePrefix.Text;
  end;
end;

procedure TfrmIB_DataSourceEditor.SetLayoutInfos(aCtrlInfo: TIB_CtrlLayoutInfo);
begin
  with aCtrlInfo do
  begin
    edtNamePrefix.Text := NamePrefix;

    spnLeft.Value := Left;
    spnTop.Value := Top;

    fLeftStart := Left;
    fTopStart := Top;

    spnWidth.Value := Width;
    spnHeight.Value := Height;

    chxUseDisplayWidth.Checked := UseDisplayWidth;
    chxUseCtrlHeight.Checked := UseControlHeight;

    cbxDirection.ItemIndex := Ord(Direction);
    spnGap.Value := Gap;

    cbxAutoLabelKind.ItemIndex := ord(LabelKind);
    edtAutoLabelSuffix.Text := LabelSuffix;

    spnAutoLabelMargin.Value := LabelMargin;
    spnAutoLabelRelPos.Value := LabelRelPos;

    chxSeparateLabel.Checked := UseIBLabel;
    edtLabelNamePrefix.Text := LabelNamePrefix;
  end;
end;

procedure TfrmIB_DataSourceEditor.ReadLayoutInfosFromRegistry;
var
  Reg: TRegistry;
  sl: TStrings;
begin
  sl := TStringList.Create;;
  try
    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.OpenKey( fBaseKey, false ) then
      begin
        sl.Text := Reg.ReadString('Layout');
        Reg.CloseKey();

        if length(sl.Text)>6 then // 'object'
        begin
          LoadComponentFromStrings(fCtrlInfo,sl);
          SetLayoutInfos(fCtrlInfo);
        end
        else
        begin
          GetLayoutInfos(fCtrlInfo);
          WriteLayoutInfosToRegistry;
        end;
      end
      else  // store initial defaults
      begin
        GetLayoutInfos(fCtrlInfo);
        WriteLayoutInfosToRegistry;
      end;
    finally
      Reg.Free;
    end;

  finally
    sl.Free;
  end;
end;

procedure TfrmIB_DataSourceEditor.WriteLayoutInfosToRegistry;
var
  Reg: TRegistry;
  sl: TStrings;
begin
  GetLayoutInfos(fCtrlInfo);

  sl := TStringList.Create;

  try
    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY_CURRENT_USER;
      if Reg.OpenKey( fBaseKey, True) then
      begin
        SaveComponentToStrings(fCtrlInfo,sl);

        Reg.WriteString('Layout',sl.Text+#0);
        Reg.CloseKey();
      end
      else
        ShowMessage('Cannot write registry: '+fBaseKey);

    finally
      Reg.Free;
    end;

  finally
    sl.Free;
  end;
end;

procedure TfrmIB_DataSourceEditor.ReadPrefsFromRegistry;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey( fBaseKey, false ) then
    begin
      if Reg.ValueExists('Preferences') then
        memPrefs.Lines.Text := Reg.ReadString('Preferences')
      else
        WritePrefsToRegistry;

      Reg.CloseKey();
    end
    else
      WritePrefsToRegistry;
  finally
    Reg.Free;
  end;
end;

procedure TfrmIB_DataSourceEditor.WritePrefsToRegistry;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey( fBaseKey, true ) then
    begin
      Reg.WriteString('Preferences',memPrefs.Lines.Text+#0);
      Reg.CloseKey();
    end
    else
      ShowMessage('Cannot write registry: '+fBaseKey);
  finally
    Reg.Free;
    memprefs.Modified := False;
  end;
end;

// find the preferences for a column.

function TfrmIB_DataSourceEditor.FindPrefs(column: TIB_Column;
  var factory: TIB_CtrlFactoryClass; var prefix: String): Boolean;

    function FindEntry(title:String;
      var factory: TIB_CtrlFactoryClass; var prefix: String):Boolean;
    var
      v,factoryname : String;
      idx : Integer;
    begin
      idx := memprefs.Lines.IndexOfName(title);

      result := idx>=0;

      if result then
      begin
        v := memprefs.Lines.Values[title];
        factoryname := Copy(v,1,Pos(',',v)-1);
        factory := TIB_CtrlFactory.FactoryByTitle(factoryname);
        prefix := copy(v,Pos(',',v)+1,maxint);
      end;
    end;

    function fixtypename(s:string):String; // varchar( 20 ) -> varchar
    begin
      if pos('(',s)>0 then
        result := copy(s,1,pos('(',s)-1)
      else
        result := s;
    end;

begin
  Result :=
    FindEntry('FIELD:'+column.relname+'.'+column.sqlname, factory, prefix) OR
    FindEntry('FIELDNAME:'+column.sqlname, factory, prefix) OR
    FindEntry('DOMAIN:'+column.domainname, factory, prefix) OR
    FindEntry('TYPE:'+fixtypename(column.sqltypesource[true]), factory, prefix);

  if result then
    result := factory<>NIL;
end;

// the workhorse - insert a control of the specified type for all selected
// fields/columns:

procedure TfrmIB_DataSourceEditor.InsertControls;
var
  frm : TForm;
  prnt : TWinControl;

  i : Integer;

  factory : TIB_CtrlFactoryClass;

  ctrl,lbl : TControl;

  autofactory : Boolean;

  prefix, dstname : String;

begin
  if fDataSource<>NIL then
  try
    // fetch the layout controls' settings
    GetLayoutInfos(fCtrlInfo);

    factory :=
      TIB_CtrlFactoryClass(cbxFactory.Items.Objects[cbxFactory.ItemIndex]);

    autofactory := (factory=NIL);

    // note: this assumes the TIB_Datasource lies on the form where the controls
    // will be placed...
    frm := fDataSource.Owner AS TForm;

    prnt := fCtrlParent as TWinControl;

    ctrl := NIL;

    for I := 0 to lbxFields.Items.Count - 1 do
      if lbxFields.Selected[i] then
      begin
        fCtrlInfo.Column := lbxFields.Items.objects[i] as TIB_Column;

        // create the data-aware control...

        if autofactory then
          if not FindPrefs(fCtrlInfo.Column,factory,prefix) then
            ShowMessage('No preferences found for column '+fCtrlInfo.Column.BestFieldName);

        if factory <> NIL then
        begin
          if edtnameprefix.ItemIndex<=0 then // auto
            fCtrlInfo.NamePrefix := prefix;

          ctrl := factory.CreateControl(frm,prnt,fCtrlInfo);

          dstname := FilterToDelphiName(fCtrlinfo.NamePrefix + fCtrlinfo.Column.Fieldname);

          if frm.FindComponent(dstname)<>NIL then // already there, get other name
//PV: in D4 IDesigner doesn't have method UniqueName, need to cast in that case.
//    But in D7 (and D6? and D5?) IFormDesigner seems to have vanished from the
//    face of the Earth, hence the conditionals.
{$IFDEF IBO_VCL50_OR_GREATER}
            ctrl.Name := frm.Designer.UniqueName(dstname)
{$ELSE}
            ctrl.Name := (frm.Designer as IFormDesigner).UniqueName(dstname)
{$ENDIF}
          else
            ctrl.Name := dstname;

          fCtrls.Add(ctrl);

          // ...and hook up the IB_Label -or- set up the AutoLabel

          lbl := factory.CreateLabelForControl(frm,prnt,fCtrlInfo,ctrl);

          if lbl<>NIL then
          begin
            dstname := FilterToDelphiName(fCtrlinfo.LabelNamePrefix + fCtrlinfo.Column.Fieldname);


            if frm.FindComponent(dstname)<>NIL then // already there, get other name
//PV: in D4 IDesigner doesn't have method UniqueName, need to cast in that case.
//    But in D7 (and D6? and D5?) IFormDesigner seems to have vanished from the
//    face of the Earth, hence the conditionals.
{$IFDEF IBO_VCL50_OR_GREATER}
              lbl.Name := frm.Designer.UniqueName(dstname)
{$ELSE}
              lbl.Name := (frm.Designer as IFormDesigner).UniqueName(dstname)
{$ENDIF}
            else
              lbl.name := dstname;

            fCtrls.Add(lbl); // add label to undo list if one was created
          end;

          // advance current position in the right direction

          case fCtrlInfo.Direction of
            cdtTopDown   : fCtrlInfo.Top  :=
                             fCtrlInfo.Top + ctrl.Height + fCtrlInfo.Gap;
            cdtLeftRight : fCtrlInfo.Left :=
                             fCtrlInfo.Left + ctrl.Width + fCtrlInfo.Gap;
          end;
        end;
      end;

    // set ending pos. for next run

    if ctrl<>NIL then
      case fCtrlInfo.Direction of
        cdtTopDown   : spnTop.Value  := fCtrlInfo.Top;
        cdtLeftRight : spnLeft.Value := fCtrlInfo.Left;
      end;
  except
    on e:Exception do
      Application.ShowException(e);
  end;
end;

// the "reverse workhorse": remove all inserted controls (aka undo)

procedure TfrmIB_DataSourceEditor.RemoveControls;
var
  i : Integer;
begin
  try
    for I := 0 to fCtrls.Count - 1 do
      try
        TComponent(fCtrls[i]).Free;
      except
        // if control was manually deleted from designer, ignore exception
      end;
  finally
    fCtrls.Clear;
  end;

  spnLeft.Value := fLeftStart;
  spnTop.Value := fTopStart;
end;

procedure TfrmIB_DataSourceEditor.btnInsertControlsClick(Sender: TObject);
begin
  fCtrlParent := cbxParent.Items.Objects[cbxParent.Itemindex] as TWinControl;

  InsertControls;
end;

procedure TfrmIB_DataSourceEditor.btnRemoveClick(Sender: TObject);
begin
  RemoveControls;
end;

// if Dataset is prepared / unprepared using the bar, update Fields list

procedure TfrmIB_DataSourceEditor.dsbarAfterAction(Sender: TObject);
begin
  FillFieldsLbx;
end;

// init drag'n'drop to form designer

procedure TfrmIB_DataSourceEditor.lbxFieldsStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  if lbxFields.Items.Count > 0 then
  begin
    if FDragObject = nil then
      FDragObject := TIB_DragFields.Create(lbxFields, Self);

    DragObject := FDragObject;
  end;
end;

// drag'n'drop inside Fields listbox for reordering

procedure TfrmIB_DataSourceEditor.lbxFieldsDragOver(Sender,
  Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := TIB_DragFields(Source).Control = lbxFields;
end;

procedure TfrmIB_DataSourceEditor.lbxFieldsDragDrop(Sender,
  Source: TObject; X, Y: Integer);
var
  dstidx:integer;
begin
  with lbxFields do
  begin
    dstidx := ItemAtPos(Point(x,y),true);

    if (dstidx>=0) and (dstidx<=Items.Count) then
    begin
      Items.Move(ItemIndex,dstidx);
      ItemIndex := dstidx;
    end;
  end;
end;

// popup menu handlers

procedure TfrmIB_DataSourceEditor.mniSelectAllClick(Sender: TObject);
var
  i : Integer;
begin
  with lbxFields do
    for I := 0 to Items.Count - 1 do
      Selected[i] := True;
end;

procedure TfrmIB_DataSourceEditor.mniCopyToClipboardClick(
  Sender: TObject);
var
  i: integer;
  s : string;
begin
  s := '';

  with lbxFields do
  begin
    for i := 0 to Items.Count-1 do
    begin
      if Length(s) > 0 then
        s := s + #13#10;
      s := s + TIB_Column(Items.Objects[i]).BestFieldName;
    end;
  end;

  Clipboard.AsText := s;
end;

procedure TfrmIB_DataSourceEditor.mniCopySelectedClick(Sender: TObject);
var
  i: integer;
  s : string;
begin
  s := '';
  with lbxFields do
  begin
    for i := 0 to Items.Count-1 do
    begin
      if Selected[i] then
      begin
        if Length(s) > 0 then
          s := s + #13#10;
        s := s + TIB_Column(Items.Objects[i]).BestFieldName;
      end;
    end;
  end;
  Clipboard.AsText := s;
end;

procedure TfrmIB_DataSourceEditor.mniInvertSelectionClick(
  Sender: TObject);
var
  i : Integer;
begin
  with lbxFields do
    for I := 0 to Items.Count - 1 do
      Selected[i] := NOT Selected[i];
end;

procedure TfrmIB_DataSourceEditor.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmIB_DataSourceEditor.mniGenPBNCodeClick(Sender: TObject);
begin
  GenerateXByNameCode('Param');
end;

procedure TfrmIB_DataSourceEditor.mniGenFBNCodeClick(Sender: TObject);
begin
  GenerateXByNameCode('Field');
end;

procedure TfrmIB_DataSourceEditor.mniGenParamObjsClick(Sender: TObject);
begin
  GenerateParamObjectsCode;
end;

procedure TfrmIB_DataSourceEditor.GenerateXByNameCode(PorF: String);
var
  i: integer;
  s : string;
  col : TIB_Column;
  astype,defaultvalue : String;
begin
  s := '';

  with lbxFields do
  begin
    for i := 0 to Items.Count-1 do
    begin
      if Selected[i] then
      begin
        col := TIB_Column(Items.Objects[i]);

        if Length(s) > 0 then
          s := s + #13#10;

        AsType := 'String';   //todo: automatic as type detection
        defaultvalue := ''''; //todo: automatic default setting

        s := s + '  '+PorF+'ByName('''+ col.BestFieldName +''').As'+astype+' := ;';
      end;
    end;
  end;
  Clipboard.AsText := s;
  ShowMessage('Done! (generated source code is in the clipboard)');
end;

procedure TfrmIB_DataSourceEditor.GenerateParamObjectsCode;
var
  i: integer;
  s : string;
  col : TIB_Column;
begin
  s := '';

  with lbxFields do
  begin
    s := 'var'#13#10;

    for i := 0 to Items.Count-1 do
    begin
      if Selected[i] then
      begin
        col := TIB_Column(Items.Objects[i]);

        s := s + '  par'+col.BestFieldName+' : TIB_Column;'+#13#10;
      end;
    end;

    s := s + 'begin'#13#10;
    s := s + '  with qr do'#13#10;
    s := s + '  begin'#13#10;
    s := s + '    if not prepared then prepare;'#13#10;

    for i := 0 to Items.Count-1 do
    begin
      if Selected[i] then
      begin
        col := TIB_Column(Items.Objects[i]);

        s := s + '    par'+col.BestFieldName+' := ParamByName('''+col.BestFieldName+''');'+#13#10;
      end;
    end;
    s := s + '    {...working code...}'#13#10;
    s := s + '  end;'#13#10;
  end;
  Clipboard.AsText := s;
  ShowMessage('Done! (generated source code is in the clipboard)');
end;

procedure TfrmIB_DataSourceEditor.mniEditPrefsClick(Sender: TObject);
begin
  mniEditPrefs.Checked := NOT mniEditPrefs.Checked;

  pnlPrefs.Visible := mniEditPrefs.Checked;
  pnlOptions.Visible := not pnlPrefs.Visible;
  pnlFooter.Visible := not pnlPrefs.Visible;
end;

procedure TfrmIB_DataSourceEditor.mniLoadPrefsClick(Sender: TObject);
begin
  if dlgLoad.Execute then
  begin
    memPrefs.Lines.LoadFromFile(dlgLoad.Filename);
    dlgSave.Filename := dlgLoad.Filename;
  end;
end;

procedure TfrmIB_DataSourceEditor.mniSavePrefsClick(Sender: TObject);
begin
  if dlgSave.Execute then
  begin
    memPrefs.Lines.SaveToFile(dlgSave.Filename);
    dlgLoad.Filename := dlgSave.Filename;
  end;
end;

procedure TfrmIB_DataSourceEditor.btnQuitPrefsClick(Sender: TObject);
begin
  mniEditPrefsClick(Self);
end;

procedure TfrmIB_DataSourceEditor.mniSetPrefsDefaultClick(
  Sender: TObject);
begin
  WritePrefsToRegistry;
end;

procedure TfrmIB_DataSourceEditor.mniSetLayoutDefaultClick(
  Sender: TObject);
begin
  WriteLayoutInfosToRegistry;
end;

procedure TfrmIB_DataSourceEditor.btnLeftStartSetClick(Sender: TObject);
begin
  fLeftStart := spnLeft.Value
end;

procedure TfrmIB_DataSourceEditor.btnLeftStartResetClick(Sender: TObject);
begin
  spnLeft.Value := fLeftStart;
end;

procedure TfrmIB_DataSourceEditor.btnTopStartSetClick(Sender: TObject);
begin
  fTopStart := spnTop.Value
end;

procedure TfrmIB_DataSourceEditor.btnTopStartResetClick(Sender: TObject);
begin
  spnTop.Value := fTopStart;
end;

{******************************************************************************}

function TIB_DataSourceEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

function TIB_DataSourceEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0 : result := 'create IB_* Controls...';
  end;
end;

procedure TIB_DataSourceEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0 : Edit;
  end;
end;

procedure TIB_DataSourceEditor.Edit;
begin
  if (Component AS TIB_DataSource).DataSet=NIL then
  begin
    // no dataset - no fields to generate controls for...
    ShowMessage('Assign dataset first!');
    exit;
  end;

  with TfrmIB_DataSourceEditor.Create(Application) do
  begin
    DataSource := Component AS TIB_DataSource;
    Show;
  end;
end;

initialization
  {$IFDEF IBO_VCL60_OR_GREATER}
  RegisterDragTarget(TIB_DragFields.ClassName, TIB_FieldsTarget);
  {$ELSE}
  if Assigned(CompLib) then
    CompLib.RegisterDragTarget(TIB_DragFields.ClassName, TIB_FieldsTarget);
  {$ENDIF}

  ConcreteCtrlFactories := TStringList.Create;

  with TIB_CtrlFactory do
  begin
    RegisterFactory(TIB_CtrlFactory,              'default (TIB_Edit)');

    RegisterFactory(TIB_EditCtrlFactory,          'TIB_Edit');
    RegisterFactory(TIB_ComboboxCtrlFactory,      'TIB_ComboBox');
    RegisterFactory(TIB_TextCtrlFactory,          'TIB_Text');
    RegisterFactory(TIB_CheckboxCtrlFactory,      'TIB_Checkbox');
    RegisterFactory(TIB_MemoCtrlFactory,          'TIB_Memo');
    RegisterFactory(TIB_DateTimePickerCtrlFactory,'TIB_DateTimePicker');
    RegisterFactory(TIB_DateCtrlFactory,          'TIB_Date');
    RegisterFactory(TIB_ListboxCtrlFactory,       'TIB_Listbox');
    RegisterFactory(TIB_RichEditCtrlFactory,      'TIB_RichEdit');
    RegisterFactory(TIB_RadioGroupCtrlFactory,    'TIB_RadioGroup');
    RegisterFactory(TIB_ImageCtrlFactory,         'TIB_Image');
    RegisterFactory(TIB_CurrencyCtrlFactory,      'TIB_Currency');
  end;

  ConcreteSrcGenFactories := TStringList.Create;

  with TIB_SrcGenFactory do
  begin
    RegisterFactory(TIB_SrcGenFactory, 'field name list');
    RegisterFactory(TIB_FieldByNameSrcGenFactory, 'FieldByName code snippet');
    RegisterFactory(TIB_ParamByNameSrcGenFactory, 'ParamByName code snippet');
    RegisterFactory(TIB_ParamObjectSrcGenFactory, 'Param Objects code snippet');
  end;

finalization
  FreeAndNIL(ConcreteCtrlFactories);
  FreeAndNIL(ConcreteSrcGenFactories);
end.
