...replace controls at run-time?

Author: Motzi
Homepage: http://www.delphi-area.de

Category: VCL

unit Unit1;

interface

uses
  
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
  
TForm1 = class(TForm)
    Panel1: TPanel;
  private
    
{ Private-Deklarationen }
  
public
    
{ Public-Deklarationen }
  
end;

  (* Neue Komponente mit eigenen Eigenschaften ersetzt erst
     zur Programmlaufzeit das Verhalten von TPanel        *)

  (* The new component replace at runtime TPanel *)

  
TExtPanel = class(TCustomControl)
  protected
    procedure 
WMSize(var Message: TWMSize); message WM_Size;
  end;

var
  
Form1: TForm1;

implementation

{$R *.DFM}


procedure TExtPanel.WMSize;
begin
  
Caption := 'Width: ' + IntToStr(Width) +
    ', Height: ' + IntToStr(Height);
end;


procedure ReplaceParentClass(DelphiClass,
  OldParent,
  NewParent: TClass);
var
  
aClassPointer: ^Byte;
  pVCL, pNew: ^Pointer;
  dwProtect: DWORD;
begin
  if 
Assigned(NewParent) then
    if 
Assigned(DelphiClass) then
    begin
      
// ClassParent-Zeiger suchen
      //Search ClassParent Pointer
      
while (DelphiClass.ClassParent <> OldParent) do
      begin
        with 
DelphiClass do
        begin
          if 
(ClassParent = nilor
            
(ClassParent = NewParent) then Exit;
          // DelphiClass.ClassParent zuweisen
          // Set DelphiClass.ClassParent
          
DelphiClass := ClassParent;
        end
      end
;
      // Parent-Zeiger der originalen VCL-Klasse suchen
      // Search Parent-Pointer of original VCL-Class
      
aClassPointer := Pointer(DelphiClass);
      Inc(aClassPointer, vmtParent);
      pVCL          := Pointer(aClassPointer);
      aClassPointer := Pointer(NewParent);
      Inc(aClassPointer, vmtSelfPtr);
      pNew := Pointer(aClassPointer);
      // Schreibberechtigung holen, Zeigerwerte tauschen
      // Set write permission, swap pointers
      
VirtualProtect(pVCL, SizeOf(Pointer), PAGE_READWRITE, @dwProtect);
      pVCL^ := pNEW;
      // alte Zugriffsrechte aktivieren
      // avtivate old access right
      
VirtualProtect(pVCL, SizeOf(Pointer), dwProtect, @dwProtect);
    end
  end
;



initialization
  
ReplaceParentClass(TPanel, TCustomControl, TExtPanel);

finalization
  
ReplaceParentClass(TPanel, TExtPanel, TCustomControl);
end.

 

printed from
www.swissdelphicenter.ch
developers knowledge base