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.
|
