_VISUALLY CONSTRUCTING DELPHI COMPONENTS_
by Al Williams

Listing One

unit Sdimain;
{ DDJ Component Builder -- Al Williams }
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Menus,
  Dialogs, StdCtrls, Buttons, ExtCtrls,SysUtils,
  IniCombo;
type
  TMainForm = class(TForm)
    MainMenu: TMainMenu;
    FileMenu: TMenuItem;
    SaveItem: TMenuItem;
    ExitItem: TMenuItem;
    N1: TMenuItem;
    SaveDialog: TSaveDialog;
    Help1: TMenuItem;
    About1: TMenuItem;
    StatusBar: TPanel;
    SpeedPanel: TPanel;
    SaveBtn: TSpeedButton;
    ExitBtn: TSpeedButton;
    CName: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    CBase: TIniCombo;
    CGroup: TIniCombo;
    GroupBox1: TGroupBox;
    CProp: TEdit;
    PRead: TEdit;
    PType: TIniCombo;
    PWrite: TEdit;
    PDefault: TEdit;
    PAdd: TButton;
    PRemove: TButton;
    PBox: TListBox;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    CComment: TMemo;
    BPublish: TRadioButton;
    BPublic: TRadioButton;
    New1: TMenuItem;
    NewBtn: TSpeedButton;
    procedure ShowHint(Sender: TObject);
    procedure ExitItemClick(Sender: TObject);
    procedure SaveItemClick(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CNameChange(Sender: TObject);
    procedure CPropChange(Sender: TObject);

    procedure PAddClick(Sender: TObject);
    procedure PBoxClick(Sender: TObject);
    procedure PChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PRemoveClick(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure ComboExit(Sender: TObject);
    procedure ComboKey(Sender: TObject; var Key: Word; Shift: TShiftState);
   private
    { Private declarations }
    procedure Init;  { make new document }
  public
    { No Public declarations }
  end;
  PType = (pPublic,pPublished); { Type of property }
{ This non-visual object represents one property associated with the component.
  SetValues and GetValues methods transfer data from the form to/from object }
  TPropVals = class(TObject)
    PropName : String;
    PropType : String;
    ReadName : String;
    WriteName : String;
    Default : String;
    PrType : PType;
  public
  procedure SetValues(nm : TEdit; typ : TComboBox; r,w,d :
      TEdit; pubsh, publc : TRadioButton);
  procedure GetValues(nm : TEdit; typ : TComboBox; r,w,d :
      TEdit; pubsh, publc : TRadioButton);
end;
var
  MainForm: TMainForm;
implementation
uses About;
{$R *.DFM}
procedure TMainForm.ShowHint(Sender: TObject);
begin
  StatusBar.Caption := Application.Hint;
end;
procedure TMainForm.ExitItemClick(Sender: TObject);
begin
  Close;
end;
{ The save is the bulk of the code we need to write the unit name (based on 
  the file name), the uses clause, the type and implementation sections with
  stubs for all the functions.
}
procedure TMainForm.SaveItemClick(Sender: TObject);
const
  cr = chr(10);
var
  fout : TextFile;
  i : Integer;
  ct : Integer;
  vals : TPropVals;
  unitname : String;
begin
  if SaveDialog.Execute then
    begin
    AssignFile(fout,SaveDialog.FileName);
    Rewrite(fout);
    unitname:=ExtractFileName(SaveDialog.Filename);
    i:=Pos('.',unitname);
    if i<>0 then
      unitname:=Copy(unitname,1,i-1); { remove extension }
    Writeln(fout,'Unit ' + unitname + ';'+cr);
    if CComment.Text <> '' then
      Writeln(fout,'{' + CComment.Text + '}'+cr);
    Writeln(fout,'interface'+cr);
    Writeln(fout,'uses SysUtils, WinTypes, WinProcs, Messages, Classes,');
    Writeln(fout,'     Graphics, Controls, Forms, Dialogs, StdCtrls;'+cr);
    Writeln(fout,'type');
    Writeln(fout,CName.Text + '= class('+ CBase.Text +')');
    Writeln(fout,'private');
    ct := PBox.Items.Count;
    { dump property variables here }
    for i:=0 to ct-1 do
      begin
      vals:=TPropVals(PBox.Items.Objects[i]);
      Writeln(fout,'  F'+vals.PropName + ':' + vals.PropType+';');
      end;
    { dump property functions here }
    for i:= 0 to ct-1 do
      begin
      vals:=TPropVals(PBox.Items.Objects[i]);
      if (vals.ReadName <> '') and (vals.ReadName <> 'F'+vals.PropName) then
          Writeln(fout,'  function '+vals.ReadName+' : '+vals.PropType+';');
      if (vals.WriteName <>'') and (vals.WriteName <> 'F' + vals.PropName) then
          Writeln(fout,'  procedure '+vals.WriteName+'( const Value : '+
            vals.PropType+');');
      end;
{ Write constructor header }
    Writeln(fout,cr+'public');
    Writeln(fout,'  constructor Create(AOwner : TComponent); override;');
{ Public properties }
    for i:= 0 to ct-1 do
      begin

      vals:=TPropVals(PBox.Items.Objects[i]);
      if vals.PrType=pPublic then
        begin
        Write(fout,'  property ' + vals.PropName + ' : ' + vals.PropType);
        if vals.ReadName<>'' then
          Write(fout,' read '+vals.ReadName);
        if vals.WriteName<>'' then
          Write(fout,' write '+vals.WriteName);
        if vals.Default<>'' then
          Write(fout,' default '+vals.Default);
        Writeln(fout,';');
        end;
      end;
{ Published properties }
    Writeln(fout,cr+'published');
    for i:= 0 to ct-1 do
      begin
      vals:=TPropVals(PBox.Items.Objects[i]);
      if vals.PrType=pPublished then
        begin
        Write(fout,'  property ' + vals.PropName + ' : ' + vals.PropType);
        if vals.ReadName<>'' then
          Write(fout,' read '+vals.ReadName);
        if vals.WriteName<>'' then
          Write(fout,' write '+vals.WriteName);
        if vals.Default<>'' then
          Write(fout,' default '+vals.Default);
        Writeln(fout,';');
      end;
    end;
    Writeln(fout,'end;');
{ Take care of Register function and implemenation }
    Writeln(fout,cr+'procedure Register;'+cr);
    Writeln(fout,'implementation');
    Writeln(fout,cr+'procedure Register;');
    Writeln(fout,'begin');
    Writeln(fout,' RegisterComponents('''+CGroup.Text+''',['+CName.Text+']);');
    Writeln(fout,'end;');
{ write constructor }
    Writeln(fout,cr+'constructor '+CName.Text+'.Create(AOwner:TComponent);');
    Writeln(fout,'begin');
    Writeln(fout,'  inherited Create(AOwner);');
{ Set up defaults here }
    for i:= 0 to ct-1 do
      begin
      vals:=TPropVals(PBox.Items.Objects[i]);
      if vals.Default<>'' then
          Writeln(fout,'   '+vals.PropName+':='+vals.Default+';');
      end;
    Writeln(fout,'  { your code here }');
    Writeln(fout,'end;');
{ Write get/set functions }
    for i:= 0 to ct-1 do
      begin

      vals:=TPropVals(PBox.Items.Objects[i]);
      if (vals.ReadName<>'') and (vals.ReadName <> 'F'+vals.PropName) then
          begin
          Writeln(fout,cr+'function '+Cname.Text+'.'+vals.ReadName+
            ' : '+vals.PropType+';');
          Writeln(fout,'begin');
          Writeln(fout,'  result:=F'+vals.PropName+';');
          Writeln(fout,'end;');
          end;
        if (vals.WriteName<>'') and (vals.WriteName <> 'F'+vals.PropName) then
          begin
          Writeln(fout,cr+'procedure '+Cname.Text+'.'+vals.WriteName+
            '(const Value : '+vals.PropType+');');
          Writeln(fout,'begin');
          Writeln(fout,'  F'+vals.PropName+':=Value;');
          Writeln(fout,'end;');
          end;
    end;
    Writeln(fout,cr+'end.');
    CloseFile(fout);
    end;
end;
procedure TMainForm.About1Click(Sender: TObject);
begin
  AboutBox.ShowModal;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnHint := ShowHint;
  Init;  { Set up as new document }
end;
{ The TPropVal object contains information about a property }
{ Set up component values from a TPropVals object }
procedure TPropVals.SetValues(nm : TEdit; typ : TComboBox; r,w,d :
      TEdit; pubsh, publc : TRadioButton);
begin
  nm.Text:=PropName;
  typ.Text:=PropType;
  r.Text:=ReadName;
  w.Text:=WriteName;
  d.Text:=Default;
  if PrType = pPublished then
    pubsh.Checked:=True
  else
    publc.Checked:=True;
end;
{ Set up a TPropVal based on component values }

procedure TPropVals.GetValues(nm : TEdit; typ : TComboBox; r,w,d :
      TEdit; pubsh, publc : TRadioButton);
begin
  PropName:=nm.Text;
  PropType:=typ.Text;
  ReadName:=r.Text;
  WriteName:=w.Text;
  Default:=d.Text;
  if (pubsh.Checked) then
    PrType:=pPublished
  else
    PrType:=pPublic;
end;
{ Come here when name changes }
procedure TMainForm.CNameChange(Sender: TObject);
var en : Boolean;
begin
if CName.Text = '' then
  en:=false
else
  en:=true;
CProp.Enabled:=en;
PBox.Enabled:=en;
end;
{ Come here when property name changes }
procedure TMainForm.CPropChange(Sender: TObject);
var
  en : Boolean;
begin
if CProp.Text='' then
  en := false
else
  en := true;
PType.Enabled:=en;
PRead.Enabled:=en;
PWrite.Enabled:=en;
PDefault.Enabled:=en;
BPublish.Enabled:=en;
BPublic.Enabled:=en;
PAdd.Enabled:=en;
PRead.Text:='F'+CProp.Text;
PWrite.Text:='F'+CProp.Text;
PDefault.Text:='';
end;
{ Click on Add button }
procedure TMainForm.PAddClick(Sender: TObject);
var
 vals : TPropVals;
 idx : Integer;
 istring : String;
begin

  vals:=TPropVals.Create;
  vals.GetValues(CProp,PType,PRead,PWrite,PDefault,BPublish,BPublic);
  istring:=Cprop.Text;
  idx := PBox.Items.IndexOf(istring);
  if idx = -1 then      { new item }
    idx:=PBox.Items.AddObject(istring,vals)
  else
    begin              { replace item }
    PBox.Items.Objects[idx].Free;
    PBox.Items.Objects[idx]:=vals;
    end;
  PBox.ItemIndex:=idx;
  PBoxClick(nil);   { Update remove button, et. al. }
  ActiveControl:=CProp;  { reset to property field }
  CProp.SelectAll;
end;
{ Click on list box }
procedure TMainForm.PBoxClick(Sender: TObject);
var
vals : TPropVals;
begin
if PBox.ItemIndex <> -1 then
  begin
  vals:=TPropVals(PBox.Items.Objects[PBox.ItemIndex]);
  vals.SetValues(CProp,PType,PRead,PWrite,PDefault,BPublish,BPublic);
  PRemove.Enabled:=True;
  end
else
  PRemove.Enabled:=False;
end;
{ Come here when any property field changes }
procedure TMainForm.PChange(Sender: TObject);
var
 vals : TPropVals;
 idx : Integer;
 istring : String;
begin
  vals:=TPropVals.Create;
  vals.GetValues(CProp,PType,PRead,PWrite,PDefault,BPublish,BPublic);
  istring:=CProp.Text;
  idx := PBox.Items.IndexOf(istring);
  if idx <> -1 then
    begin
    PBox.Items.Objects[idx].Free;  
    PBox.Items.Objects[idx]:=vals;
    end;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin

if MessageDlg('Really Quit?',mtConfirmation,[mbOK,mbCancel],0)=mrOK then
  Action:=caFree
else
  Action:=caNone;
end;
{ On Remove Button }
procedure TMainForm.PRemoveClick(Sender: TObject);
begin
Pbox.Items.Delete(PBox.ItemIndex);
CProp.Text:='';
PRead.Text:='';
PWrite.Text:='';
PDefault.Text:='';
PBoxClick(nil);
end;
procedure TMainForm.New1Click(Sender: TObject);
begin
if MessageDlg('Start new component?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
  Init;
end;
procedure TMainForm.Init;
begin
  { empty form }
  CName.Text:='';
  CBase.Text:='TComponent';
  CGroup.Text:='Samples';
  CComment.Text:='';
  PBox.Clear;
  BPublish.Checked:=True;
  CProp.Text:='';
  PRead.Text:='';
  PWrite.Text:='';
  PDefault.Text:='';
end;
{ When combo box exits, add any new item to the list and write to INI file}
procedure TMainForm.ComboExit(Sender: TObject);
var
  cb : TIniCombo;
  temp : String;
begin
  cb:=Sender as TIniCombo;
  if cb.Items.IndexOf(cb.Text)=-1 then
    begin
    temp:=cb.Text;
    cb.Items.Add(temp);
    cb.Write;
    cb.ReRead;
    cb.ItemIndex:=cb.Items.IndexOf(temp);
    end;
end;

{ Look for ^Del and remove item from INI file and list }
procedure TMainForm.ComboKey(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
cb : TIniCombo;
begin
  if (Key=VK_DELETE) and (Shift=[ssCtrl]) then
    begin
      cb:=Sender as TIniCombo;
      cb.Items.Delete(cb.Items.IndexOf(cb.Text));
      cb.Text:='';
      cb.Write;
    end;
end;
end.


Listing Two

unit Inicombo;

interface
uses
  SysUtils,
  WinTypes,
  WinProcs,
  Messages,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  IniFiles,
  DsgnIntf;
type
  TIniFileName = String[255];
  TIniCombo = class(TComboBox)
  private
    FFilename : TIniFileName;
    FSection : String;
    FItem : String;
    FSeparator : Char;
  protected
    procedure Loaded; override;
  public
    procedure Reread;
    procedure Write;
    constructor Create(AOwner : TComponent); override;
  published

    property Filename : TIniFileName read FFilename write FFilename;
    property Section : String read FSection write FSection;
    property Item : String read FItem write FItem;
    property Separator : Char read FSeparator write FSeparator default '|';
  end;
TIniFileNameEditor=class(TPropertyEditor)
public
  function GetValue : String; override;
  procedure SetValue(const Value : String); override;
  function GetAttributes : TPropertyAttributes; override;
  procedure Edit; override;
end;
procedure Register;
implementation
procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(TIniFileName),nil,'',TIniFileNameEditor);
  RegisterComponents('Samples', [TIniCombo]);
end;
constructor TIniCombo.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  Separator:='|';      { default value }
end;
{ Setup after everthing is ready }
procedure TIniCombo.Loaded;
begin
  inherited Loaded;
  if Filename <> '' then Reread;
end;
procedure TIniCombo.Reread;
var
Ini : TIniFile;
Work : String;
Entry : String;
n : Integer;
begin
Ini:=TIniFile.Create(FFilename);
Work := Ini.ReadString(FSection,FItem,'');
if Work <> '' then Clear;
n:=Pos(FSeparator,Work);
while n<>0 do
  begin
  Entry:=Copy(Work,1,n-1);
  Items.Add(Entry);
  Delete(Work,1,n);
  n:=Pos(FSeparator,Work);
  end;

{ Add last one }
if Length(Work)<>0 then Items.Add(Work);
end;
procedure TIniCombo.Write;
var
Ini : TIniFile;
Work : String;
Entry : String;
n : Integer;
begin;
Ini:=TIniFile.Create(FFilename);
{ build string }
Work:='';
for n:=0 to Items.Count do
  begin
  Work:=Work + Items[n];
  if n<> Items.Count then Work:=Work + FSeparator;
  end;
Ini.WriteString(FSection,FItem,Work);
end;
function TIniFileNameEditor.GetAttributes : TPropertyAttributes;
begin
  result:=[paMultiSelect,paDialog];
end;
function TIniFileNameEditor.GetValue : String;
begin
  result:=GetStrValue;
end;
procedure TIniFileNameEditor.SetValue(const Value : String);
begin
  SetStrValue(Value);
end;
procedure TIniFileNameEditor.Edit;
var
dlg : TOpenDialog;
dbuf : array[0..255] of Char;
begin
  dlg:=TOpenDialog.Create(Application);
  try
    dlg.Filename:=GetStrValue;
    dlg.DefaultExt:='INI';
    dlg.Filter:='Ini Files|*.INI|All Files|*.*';
    GetWindowsDirectory(dbuf,256);
    dlg.InitialDir:=StrPas(dbuf);
    if dlg.Execute=TRUE then
    SetStrValue(ExtractFileName(dlg.FileName));
  finally
    dlg.Free;
  end;

end;
end.


Example 1:

unit DDJ;
interface

uses
  SysUtils, WinTypes, WinProcs, 
  Messages, Classes, Graphics,
  Controls, Forms, Dialogs,
  ExtCtrls;
type
  TDDJComponent = class(TComboBox)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
  end;
procedure Register;
implementation
procedure Register;
begin
  RegisterComponents('Samples', [TDDJComponent]);
end;
end.


Example 2:

type
  TDDJComponent = class(TComboBox)
  private
     FDelimiter : Char;
  published
     property Delimiter : Char read FDelimiter write FDelimiter 
       default ',' ;
  end;


Example 3:

type
  TDDJComponent = class(TComboBox)
  private
    function GetDynProp : Integer;
    procedure SetDynProp(const value :Integer);
  published
    property DynamicProp : Integer read GetDynProp write SetDynProp;
  end;


Example 4:

{ Define message }
const WM_MYMSG=WM_USER;
{ Event Structure (  parses arguments }
TMyMsg = record
  Msg: Cardinal;
  Unused : Word; { wParam }
  Flag : LongInt;{ lParam }
  Result : LongInt;
end;
{ Define event type }
TMyEvent = procedure(Sender : TObject;
  Flag : LongInt) of object;
 .
 .
 .
public:
{ Event handler pointer }
  FOnMyEvent : TMyEvent;
{ Message handling procedure }
  procedure WMMyMsg(
   var Msg : TMyMsg); message WM_MYMSG;
{ Ordinary procedure receives parsed arguments
  and calls the event handler if set }
  procedure MyMsg(Sender : TObject; Flag : Boolean);
published:
  { Event handler shows up in Object Inspector }
  property OnMyEvent : TMyEvent read FOnMyEvent
    write FOnMyEvent;
 .
 .
 .
procedure TXControl.WMMyMsg(var Msg:TMyMsg);

var
  Boolean flg;
begin
  flg:=True;
  if Msg.Flag=0 then flg:=False;
  MyMsg(self,flg);
end;

procedure TXControl.MyMsg(Sender : TObject;
  Flag : Boolean);
begin
  if Assigned(FOnMyEvent) then FOnMyEvent(self,Flag);
end;


Example 5:

 .
 .
 .
published:
  property HighMark read FHighMark 
    write FHighMark default 100;
property LowMark read FLowMark 
    write FLowMark default 100;
 .
 .
 .
constructor TCompDDJ.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  HighMark:=100;      { default value }
  LowMark:=33;      { default value }
end;