Project Structure

• CustomFields.dpr
• CustomFields_MainForm.pas
• CustomFields_MainForm.dfm {FormCustomFields}

program CustomFields;

uses
  Forms,
  CustomFields_MainForm in 'CustomFields_MainForm.pas' {FormCustomFields};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormCustomFields, FormCustomFields);
  Application.Run;
end.

unit CustomFields_MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, Grids, DBGrids, DB, DBClient, StdCtrls;

type
  TFormCustomFields = class(TForm)
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ToolBar1: TToolBar;
    btnOpen: TToolButton;
    btnFieldDef: TToolButton;
    btnField: TToolButton;
    Memo1: TMemo;
    procedure btnOpenClick(Sender: TObject);
    procedure btnFieldDefClick(Sender: TObject);
    procedure btnFieldClick(Sender: TObject);
    procedure Log (const strMsg: string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormCustomFields: TFormCustomFields;

implementation

{$R *.dfm}

type
  TMyFieldDef = class (TFieldDef)
  private
    FExtraDescription: string;
    procedure SetExtraDescription(const Value: string);
  public
    function ToString: string; override;
    property ExtraDescription: string read FExtraDescription write SetExtraDescription;
  end;

  TMyStringField = class (TStringField)
  protected
    function GetAsString: string; override;
  end;

procedure TFormCustomFields.btnOpenClick(Sender: TObject);
begin
  ClientDataSet1.Filename :=
    'C:\Program Files\Common Files\CodeGear Shared\Data\customer.cds';
  ClientDataSet1.Open;
end;

procedure TFormCustomFields.Log(const strMsg: string);
begin
  Memo1.Lines.Add (strMsg);
end;

{ TMyFieldDefClass }

procedure TMyFieldDef.SetExtraDescription(const Value: string);
begin
  FExtraDescription := Value;
end;

procedure TFormCustomFields.btnFieldDefClick(Sender: TObject);
begin
  (ClientDataSet1.FieldDefs[0] as TMyFieldDef).
    ExtraDescription := 'This is the first column';
  Log ('ClientDataSet1.FieldDefs[0].ToString: '  +
    ClientDataSet1.FieldDefs[0].ToString);
end;

procedure TFormCustomFields.btnFieldClick(Sender: TObject);
begin
  Log ('ClientDataSet1.Fields[1].ToString: '  +
    ClientDataSet1.Fields[1].ToString);
end;

function TMyFieldDef.ToString: string;
begin
  Result := Name + ' - ' + ExtraDescription + ' [' + ClassName + ']';
end;

{ TMyWideStringField }

function TMyStringField.GetAsString: string;
begin
  Result := inherited GetAsString + ' is not Unicode';
end;

initialization
  DefaultFieldDefClass := TMyFieldDef;
  DefaultFieldClasses [ftString] := TMyStringField;

end.

object FormCustomFields: TFormCustomFields
  Left = 0
  Top = 0
  Caption = 'CustomFields'
  ClientHeight = 386
  ClientWidth = 631
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object DBGrid1: TDBGrid
    Left = 0
    Top = 21
    Width = 631
    Height = 276
    Align = alClient
    DataSource = DataSource1
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'Tahoma'
    TitleFont.Style = []
  end
  object ToolBar1: TToolBar
    Left = 0
    Top = 0
    Width = 631
    Height = 21
    AutoSize = True
    ButtonHeight = 21
    ButtonWidth = 97
    Caption = 'ToolBar1'
    ShowCaptions = True
    TabOrder = 1
    object btnOpen: TToolButton
      AlignWithMargins = True
      Left = 0
      Top = 0
      Caption = 'Open'
      ImageIndex = 0
      OnClick = btnOpenClick
    end
    object btnFieldDef: TToolButton
      Left = 97
      Top = 0
      Caption = 'Get Field Definition'
      ImageIndex = 1
      OnClick = btnFieldDefClick
    end
    object btnField: TToolButton
      Left = 194
      Top = 0
      Caption = 'Get Field Class'
      ImageIndex = 2
      OnClick = btnFieldClick
    end
  end
  object Memo1: TMemo
    Left = 0
    Top = 297
    Width = 631
    Height = 89
    Align = alBottom
    TabOrder = 2
    ExplicitLeft = 304
    ExplicitTop = 312
    ExplicitWidth = 185
  end
  object ClientDataSet1: TClientDataSet
    Aggregates = <>
    Params = <>
    Left = 120
    Top = 168
  end
  object DataSource1: TDataSource
    DataSet = ClientDataSet1
    Left = 208
    Top = 208
  end
end