Changing component class at run-time on demand - delphi

Question

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.

Answer 1

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;

Answer 2

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[0].AsInteger;
Canvas := Args[1].AsType<TCanvas>;
X := Args[2].AsInteger;
Y := Args[3].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;

Answer 3

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 Assign or AssignTo on TSuperImageList to get the desired behavior.