whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1547)

Database (90)
Files (137)
Forms (107)
Graphic (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

45 Visitors Online


 
...replace controls at run-time?
Autor: Motzi
Homepage: http://www.delphi-area.de
[ Print tip ]  

Tip Rating (2):  
     


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.


 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners