Заменить элемент управления во время выполнения
Оформил: 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 .
Если Вас заинтересовала или понравилась информация по разработке на Delph - "Заменить элемент управления во время выполнения", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:
Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи , в сообщение обязательно указывайте название или ссылку на статью!