Форум: "Потрепаться";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.04.18;
Скачать: [xml.tar.bz2];




Вниз

Занятно. 


MBo   (2002-03-11 13:41) [0]

SwissDelphiCenter
replace controls at run-time ?
Author: Motzi

TForm1 = class(TForm)
Panel1: TPanel;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
...
TExtPanel = class(TCustomControl)
protected
procedure WMSize(var Message: TWMSize); message WM_Size;
end;
...
procedure TExtPanel.WMSize;
begin
Caption:="Size:"+IntToStr(Width)+"*"+IntToStr(Height);
Color:=clGray;
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
//Search ClassParent Pointer
while (DelphiClass.ClassParent <> OldParent) do
begin
with DelphiClass do
begin
if (ClassParent = nil) or
(ClassParent = NewParent) then Exit;
// Set DelphiClass.ClassParent
DelphiClass := ClassParent;
end
end;
// 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);
// Set write permission, swap pointers
VirtualProtect(pVCL, SizeOf(Pointer), PAGE_READWRITE, @dwProtect);
pVCL^ := pNEW;
// activate old access right
VirtualProtect(pVCL, SizeOf(Pointer), dwProtect, @dwProtect);
end
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ReplaceParentClass(TPanel, TCustomControl, TExtPanel);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ReplaceParentClass(TPanel, TExtPanel, TCustomControl);
end;



Alx2   (2002-03-11 13:56) [1]

Нифига себе.



Алексей Петров   (2002-03-11 14:13) [2]

Известный трюк :)
Но его неосторожное применение черевато жестокими Access Violation-ами.




Форум: "Потрепаться";
Поиск по всему сайту: delphimaster.net;
Текущий архив: 2002.04.18;
Скачать: [xml.tar.bz2];




Наверх





Память: 0.72 MB
Время: 0.031 c
7-57905           Jorchick              2002-01-21 14:04  2002.04.18  
Эмуляция клика мышки


1-57697           Shrek                 2002-04-07 18:01  2002.04.18  
Как прочитать открытый txt - файл другой программы.


1-57768           NDelphist             2002-04-03 22:52  2002.04.18  
Interface и указатель


1-57763           Stexen                2002-04-04 22:11  2002.04.18  
TStream!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1


3-57599           Vlad_Leon             2002-03-27 09:13  2002.04.18  
Как узнать пароль?