Delphi World - Заменить элемент управления во время выполнения
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Заменить элемент управления во время выполнения

Оформил: 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.
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования