Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
Undocumented: How to change class inheritance during runtime Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
07-Sep-03
Category
Algorithm
Language
Delphi 5.x
Views
145
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC