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

Posted 2023-02-16

技术标签:

【中文标题】在 Delphi IDE 中，我可以更改默认控件属性吗【英文标题】：In Delphi IDE, can I change default control properties 【发布时间】：2020-04-21 08:30:44 【问题描述】：

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

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

类似于样式表/模板。

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

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

【问题讨论】：

默认值由各个控件类本身指定。除了创建新类之外，没有其他选项可以设置不同的默认值。我过去曾为此使用过组件模板。您可以更改表单上的组件属性，选择它，然后从“组件”菜单中选择“创建组件模板”。当然，这只适用于使用该模板添加新组件，它不会更改该类型的所有现有组件。 【参考方案1】：

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

首先要设置一个实现IDesignNotification 接口的对象。安装后，您将收到（其中包括）一个回调通知，当组件被插入到 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;

当一个组件被插入到表单中时你会收到这个回调并被传递给活动（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.

【讨论】：

以上是关于在 Delphi IDE 中，我可以更改默认控件属性吗的主要内容，如果未能解决你的问题，请参考以下文章

关于delphi7的TcxCheckComboBox控件的问题

Delphi-IDE：如何改变类完成的工作方式？

如何将方法挂钩到 Delphi 7 IDE 中的 Edit 事件？

delphi函数里面不可以出现控件吗

delphi的adoconnection控件自动连接问题

问一下，delphi怎么打开frame