Один из способов сделать это - избегая необходимости определять и устанавливать свои собственные пользовательские компоненты - это написать пакет, который вы устанавливаете в IDE, который выполняет всю работу за вас, на основе интерфейсов в ToolsApi.Pas, который поставляется с Delphi. После того, как вы это сделаете, все, что вам нужно (по крайней мере, для простых свойств компонентов по умолчанию), это настроить какую-то файловую базу данных компонентов и свойства по умолчанию, чтобы позволить вам добавлять или изменять без необходимости перекомпилировать пакет: лично я, вероятно, использовал бы 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) вложены более чем в один уровень ниже самого компонента. Хотя это усложнит фактическую реализацию, после ее определения значения свойств могут быть довольно легко установлены с использованием традиционных RTTI с использованием подпрограмм в модуле TypInfo. Например, учитывая эти свойства по умолчанию для 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;
Обратите внимание, что это довольно просто c реализация в этом
Он обрабатывает только свойства компонента и его объектов "верхнего уровня" (например, TFont)
Это ограничено обработкой ограниченного подмножества типов свойств
Также обратите внимание на уродливый взлом if Obj is TStrings ...
, который должен был обойти тот факт, что часть Lines
TMemo.Lines.Text. не является допустимым свойством для установки напрямую. В коде RTL установка содержимого TStrings при потоковой передаче в компоненте фактически обрабатывается TReader.DefineProperty, вызывающим TStrings.ReadData, но работа с ним таким образом выходит за рамки этого ответа.
Package код единицы
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.