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

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.

Это пример замены встроенного контрола VCL на другой пользовательский контроль в реальном времени в Delphi.

Код определяет новый пользовательский контроль под названием TExtPanel, который наследуется от TCustomControl. Он переопределяет сообщение WMSize для обновления его заголовка с текущим шириной и высотой.

Основная часть кода - процедура ReplaceParentClass, которая заменяет родительский класс существующего контрола VCL. Это позволяет изменить поведение контрола в реальном времени, заменой его родительского класса.

В этом конкретном примере код заменяет родительский класс всех контролов TPanel на пользовательский класс TExtPanel. Это означает, что каждый раз, когда создается или изменяется контроль TPanel, он будет поведеть как если бы это был экземпляр класса TExtPanel.

Процедура ReplaceParentClass работает, ищет все экземпляры оригинального класса контрола (TPanel) и заменяет его указатель на родителя на новый пользовательский контроль (TExtPanel). Она использует функцию API VirtualProtect для временного изменения прав доступа к области памяти, содержащей виртуальную таблицу контрола, что позволяет изменить указатель на родителя.

Код также включает два вызова процедуры ReplaceParentClass: один в секции инициализации для замены всех существующих контролов TPanel на TExtPanel, а другой в секции финализации для восстановления оригинального поведения контролов. Это обеспечивает, что любые изменения, сделанные пользовательским контролем, будут отменены при выходе из программы.

Шаг за шагом, код работает следующим образом:

1. Определяется класс TExtPanel, который наследуется от TCustomControl.
2. Сообщение WMSize переопределяется для обновления заголовка контрола с текущей шириной и высотой.
3. Процедура ReplaceParentClass вызывается в секции инициализации для замены всех существующих контролов TPanel на TExtPanel.
4. Процедура ReplaceParentClass ищет все экземпляры класса TPanel и заменяет его указатель на родителя на TExtPanel.
5. Поведение пользовательского контрола вступает в силу, и любые новые контролы TPanel, созданные будут поведеть как если бы они были экземплярами класса TExtPanel.
6. В секции финализации оригинальное поведение контролов восстанавливается вызовом процедуры ReplaceParentClass для восстановления родительского класса всех контролов TExtPanel обратно в TPanel.

Код демонстрирует, как заменить встроенный контроль VCL на другой пользовательский контроль в реальном времени в Delphi, позволяя изменять поведение контролов динамически.

В статье рассматривается пример замены элемента управления в Delphi во время выполнения программы.

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

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

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