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

Question

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

MyI*_*ICQ 2 delphi

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

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

类似于样式表/模板。

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

欢迎其他想法。如果这以某种方式解决了任务，我会这样做。

Answer 1

Mar*_*ynA 10

执行此操作的一种方法 - 避免必须定义和安装您自己的自定义组件 - 是编写一个包，将其安装在 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;

Run Code Online (Sandbox Code Playgroud)

当一个组件被插入到窗体上时，您会收到此回调，并且将一个接口传递给活动 (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;

Run Code Online (Sandbox Code Playgroud)

显然这用于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

Run Code Online (Sandbox Code Playgroud)

以下两个例程可用于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;

Run Code Online (Sandbox Code Playgroud)

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

它只处理组件的属性及其“顶级”对象（如 TFont）
它仅限于处理有限的属性类型子集

另外，请注意丑陋的if Obj is TStrings ...hack，这是为了解决LinesTMemo.Lines.Text的部分不是直接设置的有效属性这一事实。在 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.

Run Code Online (Sandbox Code Playgroud)

归档时间：	5 年，10 月前
查看次数：	203 次
最近记录：	5 年，10 月前