我的问题类似于这里的想法:
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;