Changing component class at run-time on demand
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;
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;
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.