In Delphi IDE, can I change default control properties

Question

In Delphi (old version 7, but probably applies to newer as well), each control you add such as button/memo/text... , will have default properties. Memo will contain a single line with it's name, they will have different colors etc.

Can I change this so that controls have certain defaults ? Example, I may want my memo fields to always be courier new 8 pt.

Similar to style sheets / templates.

I know that I can subclass to my own type, but I would prefer other solution.

Other ideas welcome. I do that CnPack if this solves the task somehow.

Answer 1

One way to do this - which avoids having to define & install your own custom components - is to write a package which you install in the IDE that does the work for you, based on the interfaces in the ToolsApi.Pas which comes with Delphi. Once you've done that, all you need to (for simple default component properties at least) is to set up some kind of file-based database of components and default properties to let you make additions or changes without having to recompile the package: personally I would probably use a TClientDataSet, but an .Ini file would do.

The place to start is to set up an object which implements the IDesignNotification interface. Once this is installed, you will receive (amongst others), a callback notification when a component is inserted in a form in the IDE. The full code of a package unit to do this is below, but one of the two main methods of interest is this:

procedure TDesignNotification.ItemInserted(const ADesigner: IDesigner;
  AItem: TPersistent);
var
  S : String;
begin
  if AItem is TComponent then begin
    S := 'Component name: ' + TComponent(AItem).Name;
    F.AComp := TComponent(AItem);
    PostMessage(F.Handle, WM_CompInserted, 0, 0);
  end
  else
    S := 'Item';
  F.Log('ItemInserted', S);
end;

You receive this callback when a component is inserted on the form and are passed an interface to the active (IDE) ADesigner and the AItem being inserted. For the purposes of this answer, which is essentially a proof-of-concept demo, we'll ignore the ADesigner and concentrate on the component(if any) which we are sent as the AItem.

In TDesignNotification.ItemInserted, we need to avoid the tempation to dabble with the inserted component's properties here, because any change we try to force on the AItem (cast to a component) will be ignored. Instead we post a custom message, WM_CompInserted, to the TDesignNotifierForm which the package also installs (and which can remain hidden, if desired). By the time the form processes the message, the component should have been inserted in the form and initialized to the component's usual defaults.

The message-handler might look like this:

procedure TDesignNotifierForm.WMCompInserted(var Msg: TMsg);
var
  S : String;
begin
  if AComp <> Nil then
    S := AComp.Name
  else
    S := 'Name not known';
  Log('WMCompInserted', S);

  if AComp is TMemo then begin
    TMemo(AComp).Lines.Text := 'set by plug-in';
  end;
  AComp := Nil;
end;

Obviously this uses if AComp is TMemo ... to set the text of the inserted memo. In a real word implementation, there would be a database of default properties of components of interest, and it would need to deal with the fact that many properties (like TMemo.Lines.Strings and TMemo.Font.Name) are nested more than one level below the component itself. Although this would complicate an actual implementation, once identified, the property values could be set fairly easily using traditional RTTI using the routines in the TypInfo unit. For example, given these default properties for TMemo

[TMemo]
Lines.Strings=Memo default text
Font.Name=Courier New
Font.Size=16

the following two routines could be used in WMCompInserted to set their values

procedure SplitStr(const Input, Delim : String; var Head, Tail : String);
var
  P : Integer;
begin
  P := Pos(Delim, Input);
  if P = 0 then begin
    Head := Input;
    Tail := '';
  end
  else begin
    Head := Copy(Input, 1, P - 1);
    Tail := Copy(Input, P + Length(Delim), MaxInt);
  end;
end;

procedure SetComponentProperty(AComponent : TComponent; AString : String);
var
  Value,
  Head,
  Tail,
  ObjName,
  PropName : String;
  Obj : TObject;
  AType : TTypeKind;
begin
  //  needs to Use TypInfo
  SplitStr(AString, '=', PropName, Value);
  if PropName = '' then else;

  SplitStr(PropName, '.', Head, Tail);
  if Pos('.', Tail) = 0 then begin
    SetStrProp(AComponent, Tail, Value);
  end
  else begin
    SplitStr(Tail, '.', ObjName, PropName);
    Obj := GetObjectProp(AComponent, ObjName);
    if Obj is TStrings then begin
      //  Work around problem setting TStrings, e.g. TMemo.Lines.Text
      TStrings(Obj).Text := Value;
    end
    else begin
      AType := PropType(Obj, PropName);
      case AType of
        //  WARNING - incomplete list
        tkString,
        tkLString : SetStrProp(Obj, PropName, Value);
        tkInteger : SetOrdProp(Obj, PropName, StrToInt(Value));
        tkFloat : SetFloatProp(Obj, PropName, StrToFloat(Value));
      end; { case }
    end;
  end;
end;

Note that this is a fairly simplistic implementation in that

• It only handles properties of the component and its "top-level" objects (like TFont)

• It is limited to handling a limited subset of property types

Also, note the ugly if Obj is TStrings ... hack, which was to work around the fact that the Lines part of TMemo.Lines.Text is not a valid property for setting directly. In the RTL code, setting of a TStrings' contents when streaming in a component is actually handled by TReader.DefineProperty calling TStrings.ReadData, but dealing with it that way here is beyond the scope of this answer.

Package unit code

unit DesignNotifierFormu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, TypInfo, ToolsApi, DesignIntf, IniFiles;

const
  WM_CompInserted = WM_User + 1;

type
  TDesignNotifierForm = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure SetComponentProperties(Component : TComponent; CompName: String);
  public
    AComp : TComponent;
    Ini : TMemIniFile;
    SL : TStringList;
    procedure Log(const Title, Msg : String);
    procedure WMCompInserted(var Msg : TMsg); message WM_CompInserted;
  end;

  TDesignNotification = class(TInterfacedObject, IDesignNotification)
    F : TDesignNotifierForm;
    procedure ItemDeleted(const ADesigner: IDesigner; AItem: TPersistent);
    procedure ItemInserted(const ADesigner: IDesigner; AItem: TPersistent);
    procedure ItemsModified(const ADesigner: IDesigner);
    procedure SelectionChanged(const ADesigner: IDesigner;
      const ASelection: IDesignerSelections);
    procedure DesignerOpened(const ADesigner: IDesigner; AResurrecting: Boolean);
    procedure DesignerClosed(const ADesigner: IDesigner; AGoingDormant: Boolean);
    constructor Create;
    destructor Destroy; override;
  end;

[...]

constructor TDesignNotification.Create;
begin
  inherited Create;
  F := TDesignNotifierForm.Create(Nil);
  F.Show;
  F.Log('Event', 'Notifier created');
end;

procedure TDesignNotification.DesignerClosed(const ADesigner: IDesigner;
  AGoingDormant: Boolean);
begin
end;

procedure TDesignNotification.DesignerOpened(const ADesigner: IDesigner;
  AResurrecting: Boolean);
var
  C : TComponent;
  Msg : String;
begin
  EXIT;  //  following for experimenting only
  C := ADesigner.Root;
  if C <> Nil then begin
    Msg := C.ClassName;
    //  At this point, you can call ShowMessage or whatever you like
    ShowMessage(Msg);
  end
  else
    Msg := 'no root';
  F.Log('Designer Opened', Msg);
end;

destructor TDesignNotification.Destroy;
begin
  F.Close;
  F.Free;
  inherited;
end;

procedure TDesignNotification.ItemDeleted(const ADesigner: IDesigner;
  AItem: TPersistent);
begin
end;

procedure TDesignNotification.ItemInserted(const ADesigner: IDesigner;
  AItem: TPersistent);
var
  S : String;
begin
  if AItem is TComponent then begin
    S := 'Component name: ' + TComponent(AItem).Name;
    F.AComp := TComponent(AItem);
    PostMessage(F.Handle, WM_CompInserted, 0, 0);
  end
  else
    S := 'Item';
  F.Log('ItemInserted', S);
end;

procedure TDesignNotification.ItemsModified(const ADesigner: IDesigner);
begin
end;

procedure TDesignNotification.SelectionChanged(const ADesigner: IDesigner;
  const ASelection: IDesignerSelections);
begin
end;

procedure SetUp;
begin
  DesignNotification := TDesignNotification.Create;
  RegisterDesignNotification(DesignNotification);
end;

procedure TDesignNotifierForm.FormCreate(Sender: TObject);
begin
  Ini := TMemIniFile.Create('d:\aaad7\ota\componentdefaults\defaults.ini');
  SL := TStringList.Create;
end;

procedure TDesignNotifierForm.FormDestroy(Sender: TObject);
begin
  SL.Free;
  Ini.Free;
end;


procedure SplitStr(const Input, Delim : String; var Head, Tail : String);
var
  P : Integer;
begin
  P := Pos(Delim, Input);
  if P = 0 then begin
    Head := Input;
    Tail := '';
  end
  else begin
    Head := Copy(Input, 1, P - 1);
    Tail := Copy(Input, P + Length(Delim), MaxInt);
  end;
end;

procedure SetComponentProperty(AComponent : TComponent; AString : String);
var
  Value,
  Head,
  Tail,
  ObjName,
  PropName : String;
  Obj : TObject;
  AType : TTypeKind;
begin
  //  needs to Use TypInfo
  SplitStr(AString, '=', PropName, Value);
  if PropName = '' then else;

  SplitStr(PropName, '.', Head, Tail);
  if Pos('.', Tail) = 0 then begin
    SetStrProp(AComponent, Tail, Value);
  end
  else begin
    SplitStr(Tail, '.', ObjName, PropName);
    Obj := GetObjectProp(AComponent, ObjName);
    if Obj is TStrings then begin
      //  Work around problem setting e.g. TMemo.Lines.Text
      TStrings(Obj).Text := Value;
    end
    else begin
      AType := PropType(Obj, PropName);
      case AType of
        //  WARNING - incomplete list
        tkString,
        tkLString : SetStrProp(Obj, PropName, Value);
        tkInteger : SetOrdProp(Obj, PropName, StrToInt(Value));
        tkFloat : SetFloatProp(Obj, PropName, StrToFloat(Value));
      end; { case }
    end;
  end;
end;

procedure TDesignNotifierForm.SetComponentProperties(Component : TComponent; CompName : String);
var
  i : Integer;
  S : String;
begin
  if Ini.SectionExists(CompName) then begin
    Ini.ReadSectionValues(CompName, SL);
    for i := 0 to SL.Count - 1 do begin
      S := CompName + '.' + SL[i];
      SetComponentProperty(Component, S);
    end;
  end;
end;

procedure TDesignNotifierForm.WMCompInserted(var Msg: TMsg);
var
  S : String;
begin
  if AComp <> Nil then
    S := AComp.ClassName
  else
    S := 'Name not known';
  Log('WMCompInserted', S);

  SetComponentProperties(AComp, AComp.Name);

  AComp := Nil; // We're done with AComp
end;

procedure TDesignNotifierForm.Log(const Title, Msg: String);
begin
  if csDestroying in ComponentState then
    exit;
  Memo1.Lines.Add(Title + ': ' + Msg);
end;

initialization
  SetUp;
finalization
  if DesignNotification <> Nil then begin
    UnRegisterDesignNotification(DesignNotification);
  end;
end.