我的问题类似于这里的想法:
Replacing a component class in 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;
注意:要清楚,我想更改一些实例,但不是全部,所以interposer class将不会.
解决方法
这更容易想到(感谢
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;
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。