根据需要在运行时更改组件类 [英] Changing component class at run-time on demand

问题描述

我的问题类似于这里的想法：替换delphi中的组件类。

但是我需要根据需要更改具体的组件类。

这是一些伪演示代码：

<$单位Unit1; p $ p> unit Unit1;

TForm1 = class（TForm）
ImageList1：TImageList;
ImageList2：TImageList;
private
ImageList3：TImageList;
结束

procedure TForm1.FormCreate（Sender：TObject）;
begin
ImageList3：= TImageList.Create（Self）;
// TImageList的所有实例像往常一样运行
end;

procedure TForm1.Button1Click（Sender：TObject）;
begin
Unit2.MakeSuperImageList（ImageList2）;
Unit2.MakeSuperImageList（ImageList3）;
//从现在开始只有ImageList2和ImageList3是TSuperImageList
// ImageList1不变
end;


---

 单元2; 
 
 type 
 TSuperImageList = class（Controls.TImageList）
 protected 
 procedure DoDraw（Index：Integer; Canvas：TCanvas; X，Y：Integer; 
样式：Cardinal; Enabled：Boolean = True）;覆盖
结束
 
程序TSuperImageList.DoDraw（Index：Integer; Canvas：TCanvas; X，Y：Integer; 
样式：Cardinal; Enabled：Boolean = True）; 
 var 
图标：TIcon; 
 begin 
图标：= TIcon.Create; 
 try 
 Self.GetIcon（Index，Icon）; 
 Canvas.Draw（X，Y，Icon）; 
 finally 
 Icon.Free; 
结束
结束
 
程序MakeSuperImageList（ImageList：TImageList）; 
 begin 
 // TImageList  - > TSuperImageList 
 end; 
  

---

注意：要清楚，我想更改一些实例，但不要所有，所以插入程序类将不会。

解决方案

这更容易想到（感谢 Hallvard的博客 - Hack＃14：在运行时更改对象的类别 ）：

  procedure PatchInstanceClass（Instance：TObject; NewClass：TClass）; 
 type 
 PClass = ^ TClass; 
 begin 
如果Assigned（Instance）和Assigned（NewClass）
和NewClass.InheritsFrom（Instance.ClassType）
和（NewClass.InstanceSize = Instance.InstanceSize）then 
 begin 
 PClass（Instance）^：= NewClass; 
结束
结束
 
 type 
 TMyButton = class（TButton）
 public 
 procedure点击;覆盖
结束
 
程序TMyButton.Click; 
 begin 
 ShowMessage（'Click！'）; 
结束
 
 procedure TForm1.FormCreate（Sender：TObject）; 
 begin 
 PatchInstanceClass（Button1，TMyButton）; 
结束
  

My Question is similar to the idea here: Replacing a component class in delphi.
But I need to change a specific component(s) class on demand.
Here is some pseudo demo code:

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;

---

Note: Just to be clear, I want to change some instances, but not all, so interposer class will not do.

解决方案

This is easier as thought (thanks to Hallvard's Blog - Hack#14: Changing the class of an object at run-time):

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;

这篇关于根据需要在运行时更改组件类的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！