Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 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-ами.



Страницы: 1 вся ветка

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

Наверх





Память: 0.44 MB
Время: 0.005 c
14-57873
jenbond
2002-03-11 15:08
2002.04.18
Разработка собственного формата БД


6-57829
Брыкун Дмитрий
2002-02-06 14:50
2002.04.18
Как написать письмо?


14-57861
Mystic
2002-03-08 15:39
2002.04.18
Дети


1-57760
Oleon
2002-04-05 16:23
2002.04.18
Ворос с печатью бланков строгой отчетности.


4-57914
Romul
2002-02-14 16:36
2002.04.18
Как получить handle s элементов другой программы?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский