根据需要在运行时更改组件类 [英] 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屋!
查看全文