unit DdhDynDb;

interface

uses
  Controls, Db, Forms, Classes, DbTables;

function ConvertClass(FieldClass: TFieldClass): TControlClass;

procedure NormalizeString(var S: string);

procedure ConnectDataFields(DbComp: TControl;
  DataSource: TDataSource; FieldName: string);

function GenerateForm(StrList: TStringList;
  SourceTable: TTable): TForm;

function GenerateSource(AForm: TForm;
  FormName, UnitName: string): string;

implementation

uses
  TypInfo, DbCtrls, SysUtils, StdCtrls, ExtCtrls, Windows;

const
  FieldTypeCount = 15;

type
  CVTable = array[1..FieldTypeCount, 1..2] of TClass;

  // TBytesField and TVarBytesField are missing
const
  ConvertTable: CVTable = (
    (TAutoIncField, TDBEdit),
    (TStringField, TDBEdit),
    (TIntegerField, TDBEdit),
    (TSmallintField, TDBEdit),
    (TWordField, TDBEdit),
    (TFloatField, TDBEdit),
    (TCurrencyField, TDBEdit),
    (TBCDField, TDBEdit),
    (TBooleanField, TDBCheckBox),
    (TDateTimeField, TDBEdit),
    (TDateField, TDBEdit),
    (TTimeField, TDBEdit),
    (TMemoField, TDBMemo),
    (TBlobField, TDBImage), {just a guess}
    (TGraphicField, TDBImage));

function ConvertClass(FieldClass: TFieldClass):
  TControlClass;
var
  I: Integer;
begin
  Result := nil;
  for I := 1 to FieldTypeCount do
    if ConvertTable[I, 1] = FieldClass then
    begin
      Result := TControlClass(
        ConvertTable[I, 2]);
      break; // jump out of for loop
    end;
  if Result = nil then
    raise Exception.Create('ConvertClass failed');
end;

procedure NormalizeString(var S: string);
var
  N: Integer;
begin
  // remove the T
  Delete(S, 1, 1);
  {chek if the string is a valid Pascal identifier:
  if not, replace spaces and other characters with underscores}
  if not IsValidIdent(S) then
    for N := 1 to Length(S) do
      if not ((S[N] in ['A'..'Z']) or (S[N] in ['a'..'z'])
        or ((S[N] in ['0'..'9']) and (N <> 1))) then
        S[N] := '_';
end;

procedure ConnectDataFields(DbComp: TControl;
  DataSource: TDataSource; FieldName: string);
var
  PropInfo: PPropInfo;
begin
  if not Assigned(DbComp) then
    raise Exception.Create(
      'ConnectDataFields failed: Invalid control');

  // set the DataSource property
  PropInfo := GetPropInfo(
    DbComp.ClassInfo, 'DataSource');
  if PropInfo = nil then
    raise Exception.Create(
      'ConnectDataFields failed: Missing DataSource property');
  SetOrdProp(DbComp, PropInfo,
    Integer(Pointer(DataSource)));

  // set the DataField property
  PropInfo := GetPropInfo(
    DbComp.ClassInfo, 'DataField');
  if PropInfo = nil then
    raise Exception.Create(
      'ConnectDataFields failed: Missing DataField property');
  SetStrProp(DbComp, PropInfo, FieldName);
end;

function GenerateForm(StrList: TStringList;
  SourceTable: TTable): TForm;
var
  I, NumField, YComp, HForm, Hmax: Integer;
  NewName: string;
  NewLabel: TLabel;
  NewDBComp: TControl;
  CtrlClass: TControlClass;
  ATable: TTable;
  ADataSource: TDataSource;
  APanel: TPanel;
  ANavigator: TDBNavigator;
  AScrollbox: TScrollBox;
begin
  // generate the form and connect the table
  Result := TForm.Create(Application);
  Result.Position := poScreenCenter;
  Result.Width := Screen.Width div 2;
  Result.Caption := 'Table Form';

  // create a Table component in the result form
  ATable := TTable.Create(Result);
  ATable.DatabaseName := SourceTable.DatabaseName;
  ATable.TableName := SourceTable.TableName;
  ATable.Active := True;
  ATable.Name := 'Table1';
  // component position (at design time)
  ATable.DesignInfo := MakeLong(20, 20);

  // create a DataSource
  ADataSource := TDataSource.Create(Result);
  ADataSource.DataSet := ATable;
  ADataSource.Name := 'DataSource1';
  // component position (at design time)
  ADataSource.DesignInfo := MakeLong(60, 20);

  // create a toolbar panel
  APanel := TPanel.Create(Result);
  APanel.Parent := Result;
  APanel.Align := alTop;
  APanel.Name := 'Panel1';
  APanel.Caption := '';

  // place a DBNavigator inside it
  ANavigator := TDBNavigator.Create(Result);
  ANavigator.Parent := APanel;
  ANavigator.Left := 8;
  ANavigator.Top := 8;
  ANAvigator.Height := APanel.Height - 16;
  ANavigator.DataSource := ADataSource;
  ANavigator.Name := 'DbNavigator1';

  // create a scroll box
  AScrollbox := TScrollBox.Create(Result);
  AScrollbox.Parent := Result;
  AScrollbox.Width := Result.ClientWidth;
  AScrollbox.Align := alClient;
  AScrollbox.BorderStyle := bsNone;
  AScrollbox.Name := 'ScrollBox1';

  // generates field editors
  YComp := 10;
  for I := 0 to StrList.Count - 1 do
  begin
    NumField := Integer(StrList.Objects[I]);

    // create a label with the field name
    NewLabel := TLabel.Create(Result);
    NewLabel.Parent := AScrollBox;
    NewLabel.Name := 'Label' + IntToStr(I);
    NewLabel.Caption := StrList[I];
    NewLabel.Top := YComp;
    NewLabel.Left := 10;
    NewLabel.Width := 120;

    // create the data aware control
    CtrlClass := ConvertClass(
      ATable.FieldDefs[NumField].FieldClass);
    NewDBComp := CtrlClass.Create(Result);
    NewDBComp.Parent := AScrollBox;
    NewName := CtrlClass.ClassName +
      ATable.FieldDefs[NumField].Name;
    NormalizeString(NewName);
    NewDBComp.Name := NewName;
    NewDBComp.Top := YComp;
    NewDBComp.Left := 140;
    NewDbComp.Width :=
      AScrollBox.Width - 150; // width of label plus border

    // connect the control with the data source
    // and field using RTTI support
    ConnectDataFields(NewDbComp,
      ADataSource,
      ATable.FieldDefs[NumField].Name);

    // compute the position of the next component
    Inc(YComp, NewDBComp.Height + 10);
  end; // for each field

  // computed requested height for client area
  HForm := YComp + APanel.Height;
  // max client area hight = screen height - 40 - form border
  HMax := (Screen.Height - 40 -
    (Result.Height - Result.ClientHeight));
  // limit form height to HMax and reserve space for scrollbar
  if HForm > HMax then
  begin
    HForm := HMax;
    Result.Width := Result.Width +
      GetSystemMetrics(SM_CXVSCROLL);
  end;
  Result.ClientHeight := HForm;
end;

function GenerateSource(AForm: TForm;
  FormName, UnitName: string): string;
var
  I: Integer;
begin
  SetLength(Result, 20000);

  // generate the first part of the unit source
  Result :=
    'unit ' + UnitName + ';'#13#13 +
    'interface'#13#13 +
    'uses'#13 +
    '  SysUtils, WinTypes, WinProcs, Messages, Classes,'#13 +
    '  Forms, Graphics, Controls, Dialogs, DB, DBCtrls,'#13 +
    '  DBTables, ExtCtrls;'#13#13 +
    'type'#13 +
    '  T' + FormName + ' = class(TForm)'#13;

  // add each component of the form
  for I := 0 to AForm.ComponentCount - 1 do
    Result := Result +
      '    ' + AForm.Components[I].Name +
      ': ' + AForm.Components[I].ClassName + ';'#13;

  // generate the final part of the source code
  Result := Result +
    '  private'#13 +
    '    { Private declarations }'#13 +
    '  public'#13 +
    '    { Public declarations }'#13 +
    '  end;'#13#13 +
    'var'#13 +
    '  ' + FormName + ': T' + FormName + ';'#13#13 +
    'implementation'#13#13 +
    '{$R *.DFM}'#13#13 +
    'end.'#13;
end;

end.

unit DdhDbwF;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Grids, DB, DBTables,
  Buttons, Mask, DBCtrls;

type
  TFormDbWiz = class(TForm)
    Notebook1: TNotebook;
    Label1: TLabel;
    ListDatabases: TListBox;
    BitBtnNext1: TBitBtn;
    BitBtnNext2: TBitBtn;
    Label2: TLabel;
    ListTables: TListBox;
    BitBtnBack2: TBitBtn;
    ListFields: TListBox;
    Label3: TLabel;
    BitBtnNext3: TBitBtn;
    BitBtnBack3: TBitBtn;
    Label4: TLabel;
    BitBtnNext4: TBitBtn;
    BitBtnBack4: TBitBtn;
    GroupFilter: TRadioGroup;
    BitBtnAll: TBitBtn;
    BitBtnNone: TBitBtn;
    StringGrid1: TStringGrid;
    Table1: TTable;
    procedure Notebook1PageChanged(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListDatabasesClick(Sender: TObject);
    procedure BitBtnNext1Click(Sender: TObject);
    procedure ListTablesClick(Sender: TObject);
    procedure BitBtnBack2Click(Sender: TObject);
    procedure BitBtnNext2Click(Sender: TObject);
    procedure BitBtnBack3Click(Sender: TObject);
    procedure BitBtnAllClick(Sender: TObject);
    procedure BitBtnNoneClick(Sender: TObject);
    procedure BitBtnNext3Click(Sender: TObject);
    procedure BitBtnBack4Click(Sender: TObject);
    procedure ListFieldsClick(Sender: TObject);
    procedure BitBtnNext4Click(Sender: TObject);
  private
    { Private declarations }
  public
    SourceCode, FormName, UnitName: string;
    ResultForm: TForm;
    procedure GeneratedFormClose(
      Sender: TObject; var Action: TCloseAction);
  end;

var
  FormDbWiz: TFormDbWiz;

implementation

{$R *.DFM}

uses
  DdhDynDb, ExptIntf;

////// form code //////

procedure TFormDbWiz.Notebook1PageChanged(Sender: TObject);
begin
  // copy the name of the page into the caption
  Caption := Format(
    'Ddh DB Form Wizard - Page %d/%d: ',
    [NoteBook1.PageIndex + 1,
    NoteBook1.Pages.Count,
      NoteBook1.ActivePage]);
end;

procedure TFormDbWiz.FormCreate(Sender: TObject);
begin
  // fill the first listbox with database names
  Session.GetDatabaseNames(
    ListDatabases.Items);
  // start in the first page
  Notebook1.PageIndex := 0;
  // default values (modified by the wizard)
  FormName := 'TResultForm';
  UnitName := 'ResultUnit';
end;

procedure TFormDbWiz.ListDatabasesClick(Sender: TObject);
begin
  // database selected: enable the Next button
  BitBtnNext1.Enabled := True;
end;

procedure TFormDbWiz.BitBtnNext1Click(Sender: TObject);
var
  CurrentDB, CurrentFilter: string;
begin
  // get the database and filters
  CurrentDB := ListDatabases.Items[
    ListDatabases.ItemIndex];
  CurrentFilter := GroupFilter.Items[
    GroupFilter.ItemIndex];
  // retrieve the tables
  Session.GetTableNames(CurrentDB,
    CurrentFilter, True, False, ListTables.Items);
  // move to the next page
  NoteBook1.PageIndex := 1;
  BitBtnNext2.Enabled := False;
end;

procedure TFormDbWiz.ListTablesClick(Sender: TObject);
begin
  // table selected: enable next button
  BitBtnNext2.Enabled := True;
end;

procedure TFormDbWiz.BitBtnBack2Click(Sender: TObject);
begin
  // go back to first page
  NoteBook1.PageIndex := 0;
end;

procedure TFormDbWiz.BitBtnNext2Click(Sender: TObject);
var
  I: Integer;
begin
  // set the properties of the selected table
  with Table1 do
  begin
    DatabaseName := ListDatabases.Items[
      ListDatabases.ItemIndex];
    TableName := ListTables.Items[
      ListTables.ItemIndex];
    // load the field definitions
    FieldDefs.Update;
  end;
  // clear the list box, then fill it
  ListFields.Clear;
  for I := 0 to Table1.FieldDefs.Count - 1 do
    // add number, name, and class name of each field
    ListFields.Items.Add(Format(
      '%d) %s [%s]',
      [Table1.FieldDefs[I].FieldNo,
      Table1.FieldDefs[I].Name,
        Table1.FieldDefs[I].FieldClass.ClassName]));
  // move to the next page
  NoteBook1.PageIndex := 2;
  BitBtnNext3.Enabled := False;
end;

procedure TFormDbWiz.BitBtnBack3Click(Sender: TObject);
begin
  // back to the second page
  NoteBook1.PageIndex := 1;
end;

procedure TFormDbWiz.BitBtnAllClick(Sender: TObject);
var
  I: Integer;
begin
  // select every available field
  for I := 0 to ListFields.Items.Count - 1 do
    ListFields.Selected[I] := True;
  // enable Next button
  BitBtnNext3.Enabled := True;
end;

procedure TFormDbWiz.BitBtnNoneClick(Sender: TObject);
var
  I: Integer;
begin
  // deselect all the fields
  for I := 0 to ListFields.Items.Count - 1 do
    ListFields.Selected[I] := False;
  // disable next button (no fields are selected)
  BitBtnNext3.Enabled := False;
end;

procedure TFormDbWiz.ListFieldsClick(Sender: TObject);
begin
  // enable button if there at least one field selected
  BitBtnNext3.Enabled := ListFields.SelCount > 0;
end;

procedure TFormDbWiz.BitBtnNext3Click(Sender: TObject);
var
  I, RowNum: Integer;
begin
  // reserve enough rows in the string grid
  StringGrid1.RowCount := ListFields.Items.Count;
  // empty the string grid
  for I := 0 to StringGrid1.RowCount - 1 do
  begin
    StringGrid1.Cells[0, I] := '';
    StringGrid1.Cells[1, I] := '';
  end;
  // for each field, if selected list it with the
  // corresponding data aware component
  RowNum := 0;
  for I := 0 to ListFields.Items.Count - 1 do
    if ListFields.Selected[I] then
    begin
      StringGrid1.Cells[0, RowNum] := Format('%d) %s [%s]',
        // field number, name, classname of data aware control
        [Table1.FieldDefs[I].FieldNo,
        Table1.FieldDefs[I].Name,
          ConvertClass(Table1.FieldDefs[I].FieldClass).ClassName]);
      StringGrid1.Cells[1, RowNum] := Table1.FieldDefs[I].Name;
      Inc(RowNum);
    end;
  // set the real number of rows
  StringGrid1.RowCount := RowNum;
  NoteBook1.PageIndex := 3;
end;

procedure TFormDbWiz.BitBtnBack4Click(Sender: TObject);
begin
  NoteBook1.PageIndex := 2;
end;

// generate button

procedure TFormDbWiz.BitBtnNext4Click(Sender: TObject);
var
  StrList: TStringList;
  I, RowNum: Integer;
begin
  StrList := TStringList.Create;
  Screen.Cursor := crHourGlass;
  try
    RowNum := 0;
    for I := 0 to ListFields.Items.Count - 1 do
      if ListFields.Selected[I] then
      begin
        StrList.AddObject(
          StringGrid1.Cells[1, RowNum], TObject(I));
        // move to next row in string grid
        Inc(RowNum);
      end;
    ResultForm := GenerateForm(StrList, Table1);
    if not Assigned(ToolServices) then
    begin
      // stand alone form
      ResultForm.OnClose := GeneratedFormClose;
      ResultForm.Show;
    end
    else
    begin
      // wizard
      SourceCode := GenerateSource(ResultForm,
        FormName, UnitName);
      ModalResult := mrOK;
    end;
  finally
    Screen.Cursor := crDefault;
    StrList.Free;
  end;
end;

procedure TFormDbWiz.GeneratedFormClose(
  Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

end.