Mega Code Archive
Undocumented How to change class inheritance during runtime
<![CDATA[
Title: Undocumented: How to change class inheritance during runtime.
Question: Can the inheritance of a class be changed during runtime?
Yes, it can be! Here is how...
Answer:
{
Undocumented: how to replace class inheritance during runtime.
This demo replaces the standard TPanel with a TMyPanel class.
Part of this code is from the book "Delphi Win32 Losungen"
written by Andreas Kosch.
This code is just a demo to show what kind of fun stuff you
can do with the runtime type information (RTTI). Learn from it,
play with it, have fun with it, impress your friends, etc.
But: you must NEVER use this code in commercial or otherway
important programs!
A good designed class hierarchy does not need runtime changes
to the inheritance structure.
Have fun!
E.J.Molendijk (Delphi Factory Netherlands BV)
}
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, extCtrls;
type
TClassReplaceDemo = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FPanel : TPanel;
public
{ Public declarations }
end;
TMyPanel = class(TCustomControl)
protected
procedure WMSize(var Message :TWMSize); message WM_Size;
end;
var
ClassReplaceDemo: TClassReplaceDemo;
implementation
{$R *.DFM}
procedure ReplaceParentClass(DelphiClass, OldParent, NewParent : TClass);
var
AClassPointer : ^Byte;
pVCl, pNew : ^Pointer;
Protect : DWord;
begin
// check if parameters are legal
if Assigned(NewParent) and Assigned(DelphiClass) then
begin
// Find the correct parent
while (DelphiClass.ClassParent OldParent) do
begin
with DelphiClass do
begin
// Is the class parent ok?
if (ClassParent = nil) or (ClassParent = NewParent) then
raise Exception.Create('Illegal class parent');
// move one up in
DelphiClass := ClassParent;
end;
end;
// Get the classpointer of the delphi class
AClassPointer := Pointer(DelphiClass);
Inc(AClassPointer, vmtParent);
pVCL := Pointer(AClassPointer);
// get the classpointer of the new class
AClassPointer := Pointer(NewParent);
Inc(AClassPointer, vmtSelfPtr);
pNew := Pointer(AClassPointer);
// insert the new class
VirtualProtect(pVCL, SizeOf(Pointer), PAGE_READWRITE, @Protect);
try
pVCL^ := pNEW;
finally
VirtualProtect(pVCL, SizeOf(Pointer), Protect, @Protect);
end;
end;
end;
{ TMyPanel }
procedure TMyPanel.WMSize(var Message: TWMSize);
begin
Caption := Format('Width: %d Height: %d',[Width,Height]);
end;
{ TForm1 }
procedure TClassReplaceDemo.Button1Click(Sender: TObject);
begin
if FPanel = nil then
begin
// Create a 'normal' panel
FPanel := TPanel.Create(Self);
// put it on the form
FPanel.Parent := Self;
// define it's size
FPanel.BoundsRect := Rect(10,50,150,100);
// You will now see the caption is automagicly set
end;
end;
initialization
// Replace the normal TPanel with our own TMyPanel
ReplaceParentClass(TPanel, TCustomControl, TMyPanel);
finalization
// cleanup the mess we made
ReplaceParentClass(TPanel, TMyPanel, TCustomControl);
end.
]]>