Changing component class at run-time on demand

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.

Buffoon

Did you consider using an interposer class? – Zip

@David: That would change all instances on the form at the time the form is created. What he wants to do is change some instances, but not all, later on, on demand. – Amu

@DavidHeffernan, I'll edit the Q so it will be more clear. – Buffoon

@Buffoon I still think an interposer is the right solution. You just have to switch behaviour in a discriminating way. See my latest update. – Zip

Isn't having something that inherits from ImageList good enough, as long as the methods you need to extend (replace) are all virtual? – Kautz

Well, if you want to replace an instance with another instance at runtime, and if it implements TPersistent.Assign, then all you need to do is construct with a "copy constructor" that uses assign to get all the state of the original object, and then replace the original object with the new object. Any code which references a virtual method like TOldThing.DoSomething should work properly, thanks to virtual methods. In other words, simply polymorphism. – Kautz

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;

Yuletide

+1. Looks like exactly what I was hoping for! brilliant solution by Hallvard. Thanks :) – Buffoon

So as long as the VMTs match it's Okay? How would you be sure of that. I'm going to call this a Hot Class Injection. :-) – Kautz

I would add a check if NewClass inherits from the class it is going to replace. Of course NewClass should not have any fields it's methods are accessing because there is no memory allocated for. – Yuletide

Let me just say that at some point in the future your decision to hack your VMT will come back to bite you. It might be very cunning and tricksy but usually the best solutions are the simple and transparent ones. – Zip

This solution is not using some implementation details (like some specific memory layout) that might vary from version to version but details that are pretty much set in stone. If you don't like that, add a compiler directive that reports a warning if version is higher than XE2 (because until then it works for sure) – Yuletide

There is only one thing that I'm not sure of: "...And since the object instance has already been allocated with a fixed size, we should not add any instance fields to the derived class". What do you make of that? – Buffoon

@DavidHeffernan, I would usually agree with you on that (+1), but surely, you must admit that this hack is a real MF! (Whether I actually use it or not) :) – Buffoon

@Buffoon It's cunning and tricksy as I already said, but I want to warn future visitors of the dangers. – Zip

@StefanGlienke I think the problem's are more that you may inadvertently add data members to the new class and that might work fine for a while but then fail in a very hard to reproduce way. Or indeed there are lots of other ways in which this sort of hack could catch you out. If there were no other good solutions then it might have merits but that's not the case. – Zip

I added some checks to PatchInstanceClass to prevent patching incompatible classes and classes that might have fields that no memory is allocated for. – Yuletide

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;

Zip

@Buffoon Too bad for you, but perhaps relevant to others all the same. – Zip

if I have had XE2 I wouldn't have needed this in the first place... sigh. Looks cool though. Can't test it but I'm sure it works. +1 – Buffoon

Also, you've got to be careful with TVirtualMethodInterceptor. It's still got some stability issues, and if you don't take care to un-proxify everything in the right order, it'll lead to crashes. – Amu

@Mason No need to un-proxify in this case. – Zip

@David, regarding your last edit, It was the first thing that I thought of. consider the fact that I have zillion units. a lot of them create a TImageList at run-time. I think that modifying every unit that might use TSuperImageList is too mechanic. I want to have a centralized non-intervening method. Besides, this is a lot more interesting and fun ;) – Buffoon

@Buffoon If you don't want to use sub-classing and you want to switch at runtime then you'll have to hack the VMT. That wouldn't be my choice, but each to their own. – Zip

Very funky. Kobik being on D5 is his choice. +1 for Kewl Hackage. – Kautz

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.

Amu

(There's a much more hacky way to do this, involving altering the object's VMT pointer. I'm not going to explain that one, because if you don't know why it works and how doing it wrong can corrupt memory, you shouldn't even be thinking about doing it anyway.) – Amu

"There's a much more hacky way..." give it to me baby! :D – Buffoon

@Kobik: No, I'm serious. This isn't something that should be given away. If you want to know, research the low-level details of how the Delphi object model works. You'll eventually figure it out, the same way I did, and learn why doing it that way is a very bad idea, the same way I did. :P – Amu

@Kobik: No, that will change the behavior for all instances of the class, which is what you said you don't want to do. – Amu

Thats why I wrote "something like". You are correct, I don't need to change all instances. – Buffoon

@Mason Your code will create a new object of the correct type. However, it will also delete the original image list. All other components that refer to that image list will lose their image list. You would also need to fix up any references. The code in the answer isn't going to get the job done I fear. I've removed my up-vote (for now at least). – Zip

@DavidHeffernan, actually this will not delete the original image list, since Assign will copy the images. but the big problem is that it will remove All other components that refer to that image list, and that is a major issue for me. – Buffoon

@Buffoon ImageList.Free looks pretty final to me. The destroys the original image list object. Copying the images is not the point. Your menus, toolbars etc. will have their image list removed. That's a killer for you. What you have failed to say is why you have to do this at runtime. – Zip

@David: Yeah, that's why I said it might not do everything he wants, but that's the basic idea. Getting it right would probably require changing the notification links – Amu

@Mason, you're right, unfortunately they are stored in the private TCustomImageList.FClients field. – Kirkland

@TLama: And no protected property or other way to get at them? Argh! With extended RTTI you can break through over-encapsulation like that, but that's not available in D5. :( – Amu