Dynamic Delphi Form Generation


A while ago I asked if anyone had a dynamic form generation component. Mr. George Vavoulogiannis offered a unit he has used for a while. http://delphi-inspired.blogspot.com/2012/04/how-to-on-fly-create-runtime-data-aware.html.
The unit as offered was not readily usable in the Delphi XE environment. After several unsuccessful attempts at persuading Mr. Vavoulogiannis to produce a readable and usable unit I decided to make the unit readily usable in Delphi XE.
Several changes were made to make the code compatible with Delphi XE. If you carefully examine both sets of source code you will readily recognize the differences.
We now have a unit that is usable in Delphi XE. I would encourage everyone to download the unit and make modifications then share the results with other group members by posting those results in the discussion group.
[codesyntax lang=”delphi”]

unit BCSFrmGenU;
interface
uses Classes, Controls, StdCtrls, DB, DbCtrls, Types, TypInfo;
implementation
var
  Label_W: integer = 200; { @ Width of the label controls }
  Control_W: integer = 500; { @ Max width of edit controls }
  Ctrl_Ident: integer = 2; { @ Distance between controls (horz & vert) }
function CreateDatasetEditor(COwner: TComponent;
  { @ The owner of control, it will be responsible for destruction }
  WParent: TWinControl; { @ The parent window where controls will live in }
  DSource: TDataSource; { @ TDataSource to be associated with controls }
  const Names, { @ Array of field names to use
    (optional, empty array will use all fields from TDataSource.Dataset }
  Labels: array of string; { @ Array of labels to use
    (optional, empty cells will use field.DisplayLabel }
  X: integer;
  Y: integer { X,Y coordinates in WParent to start positioning controls }
  ): TRect; { @ Result TRect used to place controls }
var
  i, j, iHigh: integer;
  c, ic: TControl;
  s: string;
  fld: TField;
  iL, iT: integer;
  Fields: TFields;
  Canvas: TControlCanvas;
  { @ Create a label control }
  procedure CreateDBLabel(ForField: TField; LabelText: string);
  begin
    with TLabel.Create(COwner) do
    begin
      Parent := WParent;
      AutoSize := False;
      Left := iL + Ctrl_Ident;
      Inc(iT, Ctrl_Ident);
      Top := iT;
      Width := Label_W;
      WordWrap := False;
      if LabelText <> '' then
        Caption := LabelText
      else
        Caption := ForField.DisplayLabel;
      Alignment := taRightJustify;
      AutoSize := True;
      Transparent := True;
    end;
  end;
{ @ Create editing data aware control }
  function CreateEditField(ForFld: TField; sLabel: string): TControl;
  var
    w, h: integer;
  begin
    { @ Create edit control's associated label }
    CreateDBLabel(ForFld, sLabel);
    { @ Create actual data aware control based on filed info }
    if (ForFld.DataType in [ftBoolean]) then
    begin
      Result := TDBCheckBox.Create(nil);
    end
    else if (ForFld.DataType in [ftMemo, ftFmtMemo]) then
    begin
      Result := TDBMemo.Create(nil);
      Result.Width := Control_W;
    end
    else if (ForFld.FieldKind = fkLookup) then
    begin
      Result := TDBLookupComboBox.Create(nil);
    end
    else
    begin
      Result := TDBEdit.Create(nil);
    end;
    { @ Insert created control to COwner component hierarchy (for destruction puproses) }
    COwner.InsertComponent(Result);
    { @ Set control parent, width and other properties }
    Canvas.Control := Result;
    Result.Parent := WParent;
    Result.Enabled := not ForFld.ReadOnly;
    case ForFld.DataType of
      ftWord, ftSmallInt, ftInteger, ftAutoInc, ftLargeint:
        w := Canvas.TextWidth('###,###,###,###,###') + 25;
      ftCurrency, ftFloat:
        w := Canvas.TextWidth('###,###,###,###,##0.00') + 25;
    else
      w := ForFld.DisplayWidth * Canvas.TextWidth('W') + 50;
      h := Canvas.TextWidth('Wq') + 3;
    end;
    if not(ForFld.DataType in [ftMemo, ftFmtMemo]) then
      if w > Control_W then
        Result.Width := Control_W
      else
        Result.Width := w;
    { @ Connect control to DataSource & Field }
    TypInfo.SetOrdProp(Result, 'DataSource', LongInt(DSource));
    TypInfo.SetPropValue(Result, 'DataField', ForFld.FieldName);
    { @ Final adjustment of control width }
    if Result.Width > Control_W then
      Result.Width := Control_W;
  end;
{ @ Position a control in sequence }
  procedure PositControl(c: TControl);
  begin
    c.Left := iL + Ctrl_Ident * 2 + Label_W;
    c.Top := iT;
    Inc(iT, c.Height);
    Result.Bottom := iT;
    if Result.Right < c.BoundsRect.Right then
      Result.Right := c.BoundsRect.Right;
  end;
begin
  if not Assigned(DSource.DataSet) then
    Exit;
  Fields := DSource.DataSet.Fields;
  iL := X;
  iT := Y;
  Result.Left := X;
  Result.Top := Y;
  Canvas := TControlCanvas.Create;
  try
    iHigh := High(Labels);
    if Length(Names) > 0 then
    begin // Create controls from Names array
      j := High(Names);
      for i := 0 to j do
      begin
        fld := Fields.FindField(Names[i]);
        if Assigned(fld) then
        begin
          s := '';
          if (i <= iHigh) then
            s := Labels[i];
          c := CreateEditField(fld, s);
          if Assigned(c) then
            PositControl(c);
        end;
      end;
    end
    else
    begin // Create controls from dataset.fields
      j := Fields.Count - 1;
      for i := 0 to j do
      begin
        s := '';
        if (i <= iHigh) then
          s := Labels[i];
        c := CreateEditField(Fields[i], s);
        if Assigned(c) then
          PositControl(c);
      end;
    end;
  finally
    Canvas.Free;
  end;
end;
end.

[/codesyntax]
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems authored this article.

Leave a Reply

Your email address will not be published. Required fields are marked *