Цитата:
Сообщение от dr. F.I.N.
Но можно и без ввода дополнительных классов, а "шаманским методом Гео" (ищи на DK) изменить стандартный класс...
|
Весьма познавательный этот "шаманский" метод
Пардонте редкому обитателю форумов, а что такое "DK"?
По поводу жесткого посягательства на код программы и не менее жесткой наркомании(пример Delphi 7):
Код:
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
asm
mov eax,esp
sub eax,$8
mov [Unit1.pRunStack],eax
end;
pRunLoop:=Addr(TApplication.Run);
pRunLoop:=Pointer(Integer(pRunLoop)+133);
Application.Run;
end.
Код:
unit Unit1;
interface
uses SysUtils, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FB:TButton;
procedure FBClick(Sender: TObject);
public
end;
TMButton = class(TButton)
procedure Click; override;
end;
var
Form1: TForm1;
MB:TMButton;
pRunLoop:Pointer;
pRunStack:Pointer;
implementation
{$R *.dfm}
procedure CreateTMButton();
begin
MB:=TMButton.Create(nil);
MB.Width:=Form1.ClientWidth;
MB.Height:=Form1.ClientHeight-20;
MB.Caption:='Class';
MB.Parent:=Form1;
end;
procedure TMButton.Click;
var r:real;
begin
inherited;
FreeAndNil(MB);
asm
mov ebp,[pRunStack]
jmp [pRunLoop]
end;
end;
procedure TForm1.FBClick(Sender: TObject);
begin
//FreeAndNil(MB);
if(MB=nil)then CreateTMButton();
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CreateTMButton();
FB:=TButton.Create(Form1);
FB.Top:=Form1.ClientHeight-20;
FB.Height:=20;
FB.Width:=Form1.ClientWidth;
FB.Caption:='Form';
FB.OnClick:=FBClick;
FB.Parent:=Form1;
end;
end.
На удивление и первый взгляд это безобразие даже как-то сносно работает)
Вот только явно не учтено еще как минимум парочку каких-то моментов..
После срабатывания TMButton.Click и закрытия окна, уже радостно встречает другое AV... так, чисто легонько намекая что если уж посягаешься, то посягайся глубже