altium - delphi script tutorial
Changing component class at run-time on demand (2)
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.
Executive summary: Use an interposer class with runtime switching of behaviour.
Although @kobik is using Delphi 5 and cannot do what I describe below, this answers fleshes out the supported way to change the VMT of an instance using
TVirtualMethodInterceptor. Mason's comments inspired me to write this.
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.AsInteger; Canvas := Args.AsType<TCanvas>; X := Args.AsInteger; Y := Args.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;
I've only compiled this in my head so it will no doubt need debugging. Something tells me that capturing
ImageList might not work, in which case you would need to write
Instance as TImageList.
Unless you use a VMT modifying based solution, you will have to create new instances (as per Mason's suggestion). And this means that you will also have to modify all references to the image list instances at the same time that you create the new instances. In my view that rules out any proposed solution based on instantiating replacement objects.
So, my conclusion is that to implement your proposed solution in full generality, you need runtime VMT modification. And if you don't have modern Delphi that provides such facilities in a supported way, you will need to hack the VMT.
Now, modifying the VMT, even with virtual method interceptors, is rather distasteful, in my view. I think you are probably going about this the wrong way. I suggest that you use an interposer class (or some other sub-classing technique) and switch behaviour at runtime with a property of the sub-class.
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;
There's no automatic way to do that, but you could try something like this:
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;
Depending on how
Assign is implemented, it may not quite work as expected, but you can override
AssignTo on TSuperImageList to get the desired behavior.