Могу ли я изменить свойства элемента управления по умолчанию в Delphi IDE? - PullRequest
1 голос
/ 21 апреля 2020

В Delphi (старая версия 7, но, вероятно, относится и к более новой), каждый добавляемый вами элемент управления, такой как кнопка / памятка / текст ..., будет иметь свойства по умолчанию. Памятка будет содержать одну строку с названием, они будут иметь разные цвета и т. Д. c.

Можно ли изменить это так, чтобы элементы управления имели определенные значения по умолчанию? Например, я хочу, чтобы мои заметки всегда были новыми курьером.

Аналогично таблицам стилей / шаблонам.

Я знаю, что могу создавать подклассы для своего типа, но я бы предпочел другое решение.

Другие идеи приветствуются. Я делаю этот CnPack, если это как-то решает задачу.

1 Ответ

8 голосов
/ 21 апреля 2020

Один из способов сделать это - избегая необходимости определять и устанавливать свои собственные пользовательские компоненты - это написать пакет, который вы устанавливаете в 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.
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...