How to: on the fly create runtime data aware controls

There are many situations where you have a dataset with unknown fields structure or you just want to popup a small form and present to user some specific fields from the dataset , ie the fields need to be edited after an unsuccessful validation.

So, here is a simple function i have been using for long time ago to create data aware controls on panels, dialogs, scrollboxes:

uses StdCtrls, DB, DbCtrls, TypInfo;

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;

Have fun developing, because development is fun!

How to: Clone TField and TDataset fields structure

This is just a quick tip on how to copy field structure between TDatasets. The interesting part is the "CloneField" function that duplicates the exact class of a TField from one dataset to another.

First the loop that iterates through a source dataset fields collection and clones each item (TField) to  another dataset, the destination. It takes as parameters a source TDataset from where fields structure will be read, a destination TDataset where fields will be created and a boolean that instructs the procedure to add the fields to the existing structure or exactly clone the source structure.

procedure CopyFields(SourceDataset, DestDataset: TDataset; doAdd: Boolean);
var i,p: integer;
    Fld: TField;
    dFld: string;
begin
  if not doAdd then DestDataset.Fields.Clear;
  for i:=0 to SourceDataset.Fields.Count-1 do
    begin
    if Assigned(DestDataset.Fields.FindField(SourceDataset.Fields[i].FieldName)) then
       Continue;
    Fld := CloneField(SourceDataset.Fields[i], DestDataset.Fields.Dataset);
    Fld.DataSet := DestDataset.Fields.Dataset;
    end;
end;

Notice the lines:

Fld := CloneField(SourceDataset.Fields[i], DestDataset.Fields.Dataset);
Fld.DataSet := DestDataset.Fields.Dataset;

The first is the call to "CloneFields" function that creates and returns a new TField object and the second that actually binds the field to the destination dataset. This is required in order to have a functional field in the dataset. Do not rely to the owner of the field that could be any TComponent, ie the form, which is the owner of persistent fields we create with the Delphi form designer.

Now, the function that creates an exact TField descendant class based on another one:

function CloneField(Source: TField; AOwner: TComponent): TField;

  procedure SetProp(Name: string);
  var V: variant;
      PropInfo: PPropInfo;
  begin
   PropInfo := TypInfo.GetPropInfo(Source, Name);
   if PropInfo <> nil then 
     try V := TypInfo.GetPropValue(Source,Name);
      if not VarIsNull(V) then 
         TypInfo.SetPropValue(Result,Name,V); 
     except
      ; //just kill exception
     end;
  end;

begin
  Result := TFieldClass(Source.ClassType).Create(AOwner);

  Result.Alignment              := Source.Alignment;
  Result.AutoGenerateValue      := Source.AutoGenerateValue;
  Result.CustomConstraint       := Source.CustomConstraint;
  Result.ConstraintErrorMessage := Source.ConstraintErrorMessage;
  Result.DefaultExpression      := Source.DefaultExpression;
  Result.DisplayLabel           := Source.DisplayLabel;
  Result.DisplayWidth           := Source.DisplayWidth;
  Result.FieldKind              := Source.FieldKind;
  Result.FieldName              := Source.FieldName;
  Result.ImportedConstraint     := Source.ImportedConstraint;
  Result.LookupDataSet          := Source.LookupDataSet;
  Result.LookupKeyFields        := Source.LookupKeyFields;
  Result.LookupResultField      := Source.LookupResultField;
  Result.KeyFields              := Source.KeyFields;
  Result.LookupCache            := Source.LookupCache;
  Result.ProviderFlags          := Source.ProviderFlags;
  Result.ReadOnly               := Source.ReadOnly;
  Result.Required               := Source.Required;
  Result.Visible                := Source.Visible;

  SetProp('EditMask');
  SetProp('FixedChar');
  SetProp('Size');
  SetProp('Transliterate');
  SetProp('DisplayFormat');
  SetProp('EditFormat');
  SetProp('Currency');
  SetProp('MaxValue');
  SetProp('MinValue');
  SetProp('Precision');
  SetProp('DisplayValues');
  SetProp('BlobType');
  SetProp('ObjectType');
  SetProp('IncludeObjectField');
  SetProp('ReferenceTableName');
  SetProp('Active');
  SetProp('Expression');
  SetProp('GroupingLevel');
  SetProp('IndexName');
end;

The first line of code is the one that creates a new TField descendant from the actual source field class.
Then is the block of base TField common properties assignement, followed by a block of property assignements using runtime  library information (TypInfo) for properties that MAY exist in the actual class. If some of the properties do not exist in the actual class, then they are simply ignored.

Some things to remember:
1.The "doAdd" parameter in "CopyFields" when True results to fields added to the destination fields structure, whilst False forces first to clear the destination fields collection resulting to an exactly same field structure to the destination dataset as the source one.
2.DestDataset has to be inactive in order to call either of the above functions.
3.In "CloneField", if used stand-alone,  "AOwner" represents the TComponent parameter that will be responsible for freeing the field. Usually you will pass the TDataset that the resulting field belongs to, so when the dataset closes it will also be freed.

Have fun developing, cause development is fun!