Заменить элемент управления во время выполнения

Delphi , Компоненты и Классы , RTTI

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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 = nil) or
             (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.

Статья Заменить элемент управления во время выполнения раздела Компоненты и Классы RTTI может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: RTTI ::