delphi - 在 Delphi IDE 中，我可以更改默认控件属性吗

Question

在 Delphi(旧版本 7，但可能也适用于新版本)中，您添加的每个控件(例如按钮/备忘录/文本...)都将具有默认属性。备忘录将包含一行名称，它们将有不同的颜色等。

我可以更改它以使控件具有某些默认值吗？例如，我可能希望我的备注字段始终为 courier new 8 pt。

类似于样式表/模板。

我知道我可以子类化为我自己的类型，但我更喜欢其他解决方案。

欢迎提出其他想法。如果这能以某种方式解决任务，我会做那个 CnPack。

Answer 1

执行此操作的一种方法 - 避免必须定义和安装您自己的自定义组件 -基于在Delphi自带的ToolsApi.Pas中的接口(interface)上。一旦你这样做了，您需要做的(至少对于简单的默认组件属性)是设置一些一种基于文件的组件数据库和默认属性，让您无需重新编译包即可进行添加或更改:我个人可能会使用 TClientDataSet，但 .Ini 文件也可以。

首先要设置一个实现IDesignNotification 接口(interface)的对象。安装后，您将收到(除其他外)回调通知一个组件被插入到 IDE 中的一个表单中。执行此操作的包单元的完整代码在下面，但是感兴趣的两个主要方法之一是:

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;

当一个组件被插入表单时，你会收到这个回调并将接口(interface)传递给事件的 (IDE) ADesigner 和 AItem插入。出于这个答案的目的，这本质上是一个概念验证演示，我们将忽略 ADesigner 并专注于我们所在的组件(如果有的话)作为 AItem 发送。

在 TDesignNotification.ItemInserted 中，我们需要避免尝试插入组件的诱惑此处的属性，因为我们试图对 AItem 施加任何更改(转换为组件)将被忽略。相反，我们将自定义消息 WM_CompInserted 发布到 TDesignNotifierForm该软件包还会安装(如果需要，可以保持隐藏状态)。到时候表单处理消息，组件应该已经插入到表单中并被初始化到组件的通常默认值。

消息处理程序可能如下所示:

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;

显然，这使用 if AComp is TMemo ... 来设置插入的备忘录的文本。在一个真实的实现，会有一个感兴趣的组件的默认属性的数据库，它需要处理许多属性的事实(如 TMemo.Lines.Strings 和 TMemo.Font.Name)嵌套在组件本身之下不止一层。虽然这将使实际实现复杂化，一旦确定，属性值可以使用 TypInfo 单元中的例程使用传统的 RTTI 相当容易地设置。例如，给定 TMemo 的这些默认属性

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

可以在 WMCompInserted 中使用以下两个例程来设置它们的值

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;

请注意，这是一个相当简单的实现

• 它只处理组件的属性及其“顶级”对象(如 TFont)

• 它仅限于处理有限的属性类型子集

另外，请注意丑陋的 if Obj is TStrings ... hack，这是为了解决 TMemo.Lines.Text 的 Lines 部分不是直接设置的有效属性。在 RTL 代码中，在组件中流式传输时设置 TStrings 的内容实际上是由调用 TStrings.ReadData 的 TReader.DefineProperty 处理的，但此处以这种方式处理它超出了本答案的范围。

包单元代码

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.