воскресенье, 12 декабря 2010 г.

Дублирование компонентов в Run-Time

Сегодня я приведу функцию, которая дублирует комопененты в момент выполнения программы. Зачем это нужно? Так сразу предложить несколько вариантов, для чего это может понадобиться, я не смогу. Однако расскажу, как я это использую в своих приложениях.
У меня есть форма, которая создаётся при запуске приложения. Эта форма всегда скрыта и пользователь её никогда не увидит. На этой форме в Design-Time я создаю всякие панели инструментов. Т.е. в привычном мне WYSIWYG режиме, я создаю панельки (или тулбары), на которых размещаю кнопки, комбобоксы и прочие компоненты. Панелька (тулбар) в этой форме ни с чем не связана, она нужна лишь для определения внешнего вида (Чтобы дальше было понятнее, назовём эту панель например так: pnlMyToolBar.) Ну и плюс к этому, я пишу класс-обёртку, которая будет работать с копией такой панельки. (Назовём для примера обёртку так: TMyToolbarWrapper.)
Затем, в любой из своих форм/фрейм я могу сделать так:

FToolBarWrapper := TMyToolbarWrapper.Create(Self);
FToolBarWrapper.pnlToolBar.Align := alTop;
FToolBarWrapper.pnlToolBar.Parent := Self;
FToolBarWrapper.OnChange := OnToolbarChange;
и т.д.
При этом в конструкторе TMyToolbarWrapper.Create происходит дублирование панели pnlMyToolBar, ну примерно таким вызовом:
constructor TMyToolbarWrapper.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FpnlToolbar := TPanel(DuplicateComponents(pnlMyToolBar, Self, nil));
  ...
end;
По большому счёту, можно обойтись и без дублирования компонентов, а просто создавать их в Run-Time в конструкторе обёртки. В простых случаях я так и делаю. Однако для сложных панелей очень удобно размещать компоненты именно в Design-Time - запустил приложение, попользовался, посмотрел как это выглядит в разных местах, закрыл приложение. Подвигал компоненты, что-то добавил/удалил - снова запускаю, смотрю и т.д.
Ещё один плюс, в сторону дублирования кмпонентов в Run-Time - это масштабирование. Например, если в OS логическое разрешение установлено в 120 dpi вместо обычных 96 dpi, то при создании моей скрытой формы, все находящиеся на ней компоненты автоматически промасштабируются (чего не произойдёт при создании компонентов в Run-Time). (Про масштабирование компонентов в Delphi (делфи это делает не всегда корректно) я планирую ещё написать.)
Прочитав всё это, Вы, возможно, подумаете: "Зачем так сложно? Ведь в делфи есть фреймы, разместил компоненты на фрейме, и вставляй эту фрейму куда душе угодно!".
На это у меня тоже есть отвтет. У фрейм есть возможность встраивать их в Design-Time. Да, это удобно. Но у этого удобства есть и обратная сторона медали. Приведу такой пример.
Есть фрейма, назовём её frameToolBar. Встраиваем её в форму formSomeTask (у встроенной фреймы будет имя frameToolBar1). Если подвигать (случайно) компоненты на frameToolBar1 (или изменить размеры), то ресурс этой фреймы сохранится в dfm-файл формы formSomeTask. И если в будущем что-то изменить на фрейме frameToolBar, то при открытии формы formSomeTask могут возникнуть конфликты (ресурс frameToolBar1 не соответствует родительскому ресурсу frameToolBar), вплоть до отказа работы формы. Вы наверняка с таким сталкивались, если работали с фреймами.
"Хорошо, встраивать фреймы в Design-Time не есть хорошо, но нам никто не запрещает встраивать их в Run-Time! Зачем нам дублирование компонентов?" - скажете Вы. Да, это так, но сам факт того, что фреймы можно встраивать в Design-Time балует программистов, и если себя ещё можно как-то дисциплинировать, то заставить это делать других программистов почти не реально. Поэтому в нашей компании я нашёл такой выход - дублирование компонентов в Run-Time.
P.S.: Кстати, если фреймы встраивать в Run-Time, то масштабирование не сработает - это баг Delphi (в Delphi 7 и ранних версиях, поздние версии я не проверял... обязательно напишу про масштабирование).
Вот код функции:
unit DelphiNotesDuplicate;

interface

uses
  Classes;

// дублирование компонентов с явным заданием нового владельца и нового родителя
function DuplicateComponents(AComponent, NewOwner, NewParent: TComponent): TComponent; overload;
// дублирование компонентов, владелец и родитель останутся прежними
function DuplicateComponents(AComponent: TComponent): TComponent; overload;

procedure RegisterComponentClasses(AComponent: TComponent);

implementation

uses
  SysUtils, Controls;

const
  DupBufferSize = 4096;  // 4K, это число используется в Classes.pas (Delphi 7)

type
  TDuplicator = class(TObject)
  private
    FRefNames: TStringList;
    FResult: TComponent;
    procedure OnRead(Component: TComponent);
    procedure OnSetName(Reader: TReader; Component: TComponent; var Name: string);
    procedure OnReferenceName(Reader: TReader; var Name: string);
    procedure WriteComponents(Stream: TStream; Root: TComponent);
    procedure ReadComponents(Stream: TStream; Owner, Parent: TComponent);
  public
    destructor Destroy; override;
    function Duplicate(Component, Owner, Parent: TComponent): TComponent;
  end;

{ TDuplicator }

destructor TDuplicator.Destroy;
begin
  FreeAndNil(FRefNames);
  inherited Destroy;
end;

procedure TDuplicator.OnRead(Component: TComponent);
begin
  // сохраняем ссылку на только что считанный компонент
  // самым последним считывается компонент верхнего уровня
  FResult := Component;
end;

procedure TDuplicator.OnSetName(Reader: TReader; Component: TComponent; var Name: string);
var
  i: Integer;
  Tmp: string;
begin
  // добиваемся уникальности имени компонента
  i := 0;
  Tmp := Name;
  while Component.Owner.FindComponent(Name) <> nil do
  begin
    Inc(i);
    Name := Tmp + IntToStr(i);
  end;

  if Tmp <> Name then
  begin
    if not Assigned(FRefNames) then
    begin
      FRefNames := TStringList.Create;
      FRefNames.CaseSensitive := True;
      FRefNames.Duplicates := dupError;
      FRefNames.Sorted := True;
      FRefNames.NameValueSeparator := '=';
    end;
    FRefNames.Add(Tmp + '=' + Name);
  end;
end;

procedure TDuplicator.OnReferenceName(Reader: TReader; var Name: string);
var
  i: Integer;
begin
  if Assigned(FRefNames) then
  begin
    i := FRefNames.IndexOfName(Name);
    if i >= 0 then
      Name := FRefNames.ValueFromIndex[i];
  end;
end;

procedure TDuplicator.WriteComponents(Stream: TStream; Root: TComponent);
var
  Writer: TWriter;
begin
  Writer := TWriter.Create(Stream, DupBufferSize);
  try
    Writer.Root := Root.Owner;
    Writer.WriteSignature;
    Writer.WriteComponent(Root);
    Writer.WriteListEnd;
  finally
    Writer.Free;
  end;
end;

procedure TDuplicator.ReadComponents(Stream: TStream; Owner, Parent: TComponent);
var
  Reader: TReader;
begin
  Reader := TReader.Create(Stream, DupBufferSize);
  try
    Reader.OnSetName := OnSetName;
    Reader.OnReferenceName := OnReferenceName;
    Reader.ReadComponents(Owner, Parent, OnRead);
  finally
    Reader.Free;
  end;
end;

function TDuplicator.Duplicate(Component, Owner, Parent: TComponent): TComponent;
var
  Stream: TMemoryStream;
begin
  FResult := nil;

  // регистрация классов, необходима для случаев, когда новый владелец не знает о каком-то классе
  RegisterComponentClasses(Component);

  Stream := TMemoryStream.Create;
  try
    WriteComponents(Stream, Component);
    Stream.Position := 0;
    ReadComponents(Stream, Owner, Parent);
  finally
    Stream.Free;
  end;

  Result := FResult;
end;

{ /TDuplicator }

procedure RegisterComponentClasses(AComponent: TComponent);
var
  i: Integer;
begin
  RegisterClass(TPersistentClass(AComponent.ClassType));
  if AComponent is TWinControl then
    for i := 0 to TWinControl(AComponent).ControlCount - 1 do
      RegisterComponentClasses(TWinControl(AComponent).Controls[i]);
end;

function DuplicateComponents(AComponent, NewOwner, NewParent: TComponent): TComponent;
begin
  with TDuplicator.Create do
  try
    Result := Duplicate(AComponent, NewOwner, NewParent);
  finally
    Free;
  end;
end;

function DuplicateComponents(AComponent: TComponent): TComponent;
var
  NewOwner, NewParent: TComponent;
begin
  NewOwner := AComponent.Owner;
  if AComponent is TWinControl
    then NewParent := TWinControl(AComponent).Parent
    else NewParent := nil;
  Result := DuplicateComponents(AComponent, NewOwner, NewParent);
end;

end.
Пример использования, на уровне формы:
procedure TForm1.Button1Click(Sender: TObject);
begin
  DuplicateComponents(Self, Self, nil);  // дублируем форму
end;

0 коммент.:

Отправить комментарий

.

.