ddhdyndb.pas

Delphi高级开发指南是开发程序的好帮手

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'])) 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 desing time)
  ATable.DesignInfo := MakeLong (20, 20);

  // create a DataSource
  ADataSource := TDataSource.Create (Result);
  ADataSource.DataSet := ATable;
  ADataSource.Name := 'DataSource1';
  // component position (at desing 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, Graphics, Controls,'#13 +
    '  Forms, Dialogs, DB, DBTables, DBCtrls, 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.