Изменение класса компонента во время выполнения по требованию - PullRequest
Новая
       42

Изменение класса компонента во время выполнения по требованию

15 голосов
/ 26 марта 2012

Мой вопрос похож на идею здесь: Замена класса компонента в delphi .
Но мне нужно изменить определенный класс компонента (ов) по требованию.
Вот некоторый псевдо-демонстрационный код: 

unit Unit1;

TForm1 = class(TForm)
  ImageList1: TImageList;
  ImageList2: TImageList;
private
  ImageList3: TImageList;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList3 := TImageList.Create(Self);
  // all instances of TImageList run as usual
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Unit2.MakeSuperImageList(ImageList2);
  Unit2.MakeSuperImageList(ImageList3);
  // from now on ONLY ImageList2 and ImageList3 are TSuperImageList
  // ImageList1 is unchanged
end;

unit Unit2;

type
  TSuperImageList = class(Controls.TImageList)
  protected
    procedure DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer;
      Style: Cardinal; Enabled: Boolean = True); override;
  end;

procedure TSuperImageList.DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer;
  Style: Cardinal; Enabled: Boolean = True);
var
  Icon: TIcon;
begin
  Icon := TIcon.Create;
  try
    Self.GetIcon(Index, Icon);
    Canvas.Draw(X, Y, Icon);
  finally
    Icon.Free;
  end;
end;

procedure MakeSuperImageList(ImageList: TImageList);
begin
  // TImageList -> TSuperImageList
end;

Примечание: Просто чтобы прояснить, я хочу изменить некоторые экземпляры, но не все , поэтому класс вставки не подойдет.

Ответы [ 3 ]

20 голосов
/ 27 марта 2012

Это проще, чем кажется (спасибо Блог Холлварда - Hack # 14: Изменение класса объекта во время выполнения ): 

procedure PatchInstanceClass(Instance: TObject; NewClass: TClass);
type
  PClass = ^TClass;
begin
  if Assigned(Instance) and Assigned(NewClass)
    and NewClass.InheritsFrom(Instance.ClassType)
    and (NewClass.InstanceSize = Instance.InstanceSize) then
  begin
    PClass(Instance)^ := NewClass;
  end;
end;

type
  TMyButton = class(TButton)
  public
    procedure Click; override;
  end;

procedure TMyButton.Click;
begin
  ShowMessage('Click!');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PatchInstanceClass(Button1, TMyButton);
end;
9 голосов
/ 26 марта 2012

Краткое содержание : использовать промежуточный класс с переключением поведения во время выполнения.

Хотя @kobik использует Delphi 5 и не может делать то, что я описываю ниже, этот ответ раскрываетсяподдерживаемый способ изменить VMT экземпляра, используя TVirtualMethodInterceptor.Комментарии Мейсона вдохновили меня на написание этого. 

procedure MakeSuperImageList(ImageList: TImageList);
var
  vmi: TVirtualMethodInterceptor;
begin
  vmi := TVirtualMethodInterceptor.Create(ImageList.ClassType);
  try
    vmi.OnBefore := procedure(Instance: TObject; Method: TRttiMethod;
      const Args: TArray<TValue>; out DoInvoke: Boolean; out Result: TValue)
    var
      Icon: TIcon;
      Canvas: TCanvas;
      Index: Integer;
      X, Y: Integer;
    begin
      if Method.Name<>'DoDraw' then
        exit;

      DoInvoke := False;//don't call TImageList.DoDraw
      Index := Args[0].AsInteger;
      Canvas := Args[1].AsType<TCanvas>;
      X := Args[2].AsInteger;
      Y := Args[3].AsInteger;

      Icon := TIcon.Create;
      try
        ImageList.GetIcon(Index, Icon);
        Canvas.Draw(X, Y, Icon);
      finally
        Icon.Free;
      end;
    end;

    vmi.Proxify(ImageList);
  finally
    vmi.Free;
  end;
end;

Я только скомпилировал это в своей голове, так что, несомненно, потребуется отладка.Что-то подсказывает мне, что захват ImageList может не работать, и в этом случае вам нужно будет написать Instance as TImageList.

Если вы не используете решение на основе модификации VMT, вам придется создавать новые экземпляры (согласно Мэйсонупредложение).А это значит, что вам также придется изменять все ссылки на экземпляры списка изображений одновременно с созданием новых экземпляров.На мой взгляд, это исключает любое предлагаемое решение, основанное на создании экземпляров замещающих объектов.

Итак, я пришел к выводу, что для реализации предложенного решения в полной общности вам потребуется модификация VMT во время выполнения.И если у вас нет современного Delphi, который предоставляет такие средства поддерживаемым способом, вам нужно будет взломать VMT.

Теперь, изменение VMT, даже с перехватчиками виртуальных методов, довольно неприятно, по моемуПосмотреть.Я думаю, вы, вероятно, ошибаетесь.Я предлагаю использовать промежуточный класс (или другой метод подклассов) и переключать поведение во время выполнения с помощью свойства подкласса. 

type
  TImageList = class(ImgList.TImageList)
  private
    FIsSuper: Boolean;
  protected
    procedure DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer;
      Style: Cardinal; Enabled: Boolean = True); override;
  public
    property IsSuper: Boolean read FIsSuper write FIsSuper;
  end;

TImageList.DoDraw(Index: Integer; Canvas: TCanvas; X, Y: Integer;
  Style: Cardinal; Enabled: Boolean = True);
var
  Icon: TIcon;
begin
  if IsSuper then
  begin
    Icon := TIcon.Create;
    try
      Self.GetIcon(Index, Icon);
      Canvas.Draw(X, Y, Icon);
    finally
      Icon.Free;
    end;
  end
  else
    inherited;
end;
....
procedure TForm1.Button1Click(Sender: TObject);
begin
  ImageList2.IsSuper := True;
  ImageList3.IsSuper := True;
end;
3 голосов
/ 26 марта 2012

Нет автоматического способа сделать это, но вы можете попробовать что-то вроде этого: 

procedure MakeSuperImageList(var ImageList: TImageList);
var
  new: TImageList;
begin
  if ImageList is TSuperImageList then
    Exit;
  new := TSuperImageList.Create(ImageList.Owner);
  new.Assign(ImageList);
  ImageList.Free;
  ImageList := new;
end;

В зависимости от того, как реализован Assign, он может работать не совсем так, как ожидалось, но вы можете переопределить Assign или AssignTo в TSuperImageList для получения желаемого поведения.

...