Author: Erwin Molendijk
Can the inheritance of a class be changed during runtime?
Yes, it can be! Here is how...
Answer:
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.
1 unit main;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, extCtrls;
8
9 type
10 TClassReplaceDemo = class(TForm)
11 Button1: TButton;
12 procedure Button1Click(Sender: TObject);
13 private
14 { Private declarations }
15 FPanel: TPanel;
16 public
17 { Public declarations }
18 end;
19
20 TMyPanel = class(TCustomControl)
21 protected
22 procedure WMSize(var message: TWMSize); message WM_Size;
23 end;
24
25 var
26 ClassReplaceDemo: TClassReplaceDemo;
27
28 implementation
29
30 {$R *.DFM}
31
32 procedure ReplaceParentClass(DelphiClass, OldParent, NewParent: TClass);
33 var
34 AClassPointer: ^Byte;
35 pVCl, pNew: ^Pointer;
36 Protect: DWord;
37
38 begin
39 // check if parameters are legal
40 if Assigned(NewParent) and Assigned(DelphiClass) then
41 begin
42 // Find the correct parent
43 while (DelphiClass.ClassParent <> OldParent) do
44 begin
45 with DelphiClass do
46 begin
47 // Is the class parent ok?
48 if (ClassParent = nil) or (ClassParent = NewParent) then
49 raise Exception.Create('Illegal class parent');
50 // move one up in
51 DelphiClass := ClassParent;
52 end;
53 end;
54
55 // Get the classpointer of the delphi class
56 AClassPointer := Pointer(DelphiClass);
57 Inc(AClassPointer, vmtParent);
58 pVCL := Pointer(AClassPointer);
59
60 // get the classpointer of the new class
61 AClassPointer := Pointer(NewParent);
62 Inc(AClassPointer, vmtSelfPtr);
63 pNew := Pointer(AClassPointer);
64
65 // insert the new class
66 VirtualProtect(pVCL, SizeOf(Pointer), PAGE_READWRITE, @Protect);
67 try
68 pVCL^ := pNEW;
69 finally
70 VirtualProtect(pVCL, SizeOf(Pointer), Protect, @Protect);
71 end;
72 end;
73 end;
74
75 { TMyPanel }
76
77 procedure TMyPanel.WMSize(var message: TWMSize);
78 begin
79 Caption := Format('Width: %d Height: %d', [Width, Height]);
80 end;
81
82 { TForm1 }
83
84 procedure TClassReplaceDemo.Button1Click(Sender: TObject);
85 begin
86 if FPanel = nil then
87 begin
88 // Create a 'normal' panel
89 FPanel := TPanel.Create(Self);
90
91 // put it on the form
92 FPanel.Parent := Self;
93
94 // define it's size
95 FPanel.BoundsRect := Rect(10, 50, 150, 100);
96
97 // You will now see the caption is automagicly set
98 end;
99 end;
100
101 initialization
102 // Replace the normal TPanel with our own TMyPanel
103 ReplaceParentClass(TPanel, TCustomControl, TMyPanel);
104 finalization
105 // cleanup the mess we made
106 ReplaceParentClass(TPanel, TMyPanel, TCustomControl);
107 end.
|
