procedure WMPaint(var Msg : TWMPaint);  message wm_paint;

function WndProc(wnd: HWND; msg: integer; wParam: wParam; lParam: lParam): lResult; stdCall;
begin
 result:=0;
 case msg of
   wm_Destroy:
     begin
       PostQuitMessage(0);
       Exit
     end;
 else Result:=DefWindowProc(wnd,msg,wparam,lparam)
 end;//case
end;

 tFormClass = class of tFrm;

 tApp = class
 private
   MainForm: tFrm;
 public
   constructor Create;
   destructor Destroy; override;
   procedure CreateForm(FormClass: tFormClass; var FormName);
   procedure Run;
 end;

 tMainForm = class(tFrm)
   procedure FormCreate;
 private
   procedure Load;
   procedure Draw;
 protected
   procedure WMPaint(var Msg : TWMPaint);  message wm_paint;
 end;

procedure tApp.CreateForm(FormClass: tFormClass; var FormName);
var
 Form: tFrm;
begin
 Form:=tFrm(FormClass.NewInstance);
 tFrm(FormName):=Form;

 try
   Form.Create;
 except
   tFrm(FormName) := nil;
   raise;
 end;

 if MainForm = nil then begin
   MainForm := TFrm(Form);
 end;
end;

procedure tApp.Run;
var
 Msg: tMsg;
begin
 if not MainForm.CreateWnd then exit;
 while GetMessage(Msg, 0, 0, 0) do
   begin
     TranslateMessage(Msg);
     DispatchMessage(Msg);
   end
end;

function tFrm.CreateWnd: boolean;
var
 wc: tWndClassEx;
begin
 result:=true;
 zeromemory(@wc,sizeof(wc));
 with wc do begin
   cbSize:=sizeof(wc);
   style:=cs_hredraw or cs_vredraw;
   wc.cbClsExtra:=0;
   wc.cbWndExtra:=0;
   lpfnWndProc:=@WndProc;
   wc.hInstance:=HInstance;
   wc.hIcon:=LoadIcon(0,idi_application);
   hCursor:=LoadCursor(0, idc_Arrow);
   wc.hbrBackground:=COLOR_BTNFACE+1;
   wc.lpszMenuName:=nil;
   lpszClassName:=cName;
 end;
 if RegisterClassEx(wc)=0 then
   result:=false
 else
   handle:=CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW, cName, capt, WS_POPUP, left, top, width, height, 0, 0, HInstance, nil);
 if handle=0 then begin
   result:=false;
   exit
 end;
 show
end;

procedure TApplication.CreateHandle;
var
 TempClass: TWndClass;
 SysMenu: HMenu;
begin
 if not FHandleCreated
{$IFDEF MSWINDOWS}
   and not IsConsole then
{$ENDIF}
{$IFDEF LINUX}
   then
{$ENDIF}
 begin
{$IFDEF LINUX}
   FObjectInstance := WinUtils.MakeObjectInstance(WndProc);
{$ENDIF}
{$IFDEF MSWINDOWS}
   FObjectInstance := Classes.MakeObjectInstance(WndProc);
{$ENDIF}
   WindowClass.lpfnWndProc := @DefWindowProc;
   if not GetClassInfo(HInstance, WindowClass.lpszClassName, TempClass) then
   begin
     WindowClass.hInstance := HInstance;
     if Windows.RegisterClass(WindowClass) = 0 then
       raise EOutOfResources.Create(SWindowClass);
   end;
   FHandle := CreateWindow(WindowClass.lpszClassName, PChar(FTitle),
     WS_POPUP or WS_CAPTION or WS_CLIPSIBLINGS or WS_SYSMENU
     or WS_MINIMIZEBOX,
     GetSystemMetrics(SM_CXSCREEN) div 2,
     GetSystemMetrics(SM_CYSCREEN) div 2,
     0, 0, 0, 0, HInstance, nil);
   FTitle := '';
   FHandleCreated := True;
   SetWindowLong(FHandle, GWL_WNDPROC, Longint(FObjectInstance));
   if NewStyleControls then
   begin
     SendMessage(FHandle, WM_SETICON, 1, GetIconHandle);
     SetClassLong(FHandle, GCL_HICON, GetIconHandle);
   end;
   SysMenu := GetSystemMenu(FHandle, False);
   DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND);
   DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND);
   if NewStyleControls then DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
 end;
end;

function MakeObjectInstance(Method: TWndMethod): Pointer;

const
 InstanceCount = 313;

{ Object instance management }

type
 PObjectInstance = ^TObjectInstance;
 TObjectInstance = packed record
   Code: Byte;
   Offset: Integer;
   case Integer of
     0: (Next: PObjectInstance);
     1: (Method: TWndMethod);
 end;

type
 PInstanceBlock = ^TInstanceBlock;
 TInstanceBlock = packed record
   Next: PInstanceBlock;
   Code: array[1..2] of Byte;
   WndProcPtr: Pointer;
   Instances: array[0..InstanceCount] of TObjectInstance;
 end;

var
 InstBlockList: PInstanceBlock;
 InstFreeList: PObjectInstance;

{ Standard window procedure }
{ In    ECX = Address of method pointer }
{ Out   EAX = Result }

function StdWndProc(Window: HWND; Message, WParam: Longint;
 LParam: Longint): Longint; stdcall; assembler;
asm
       XOR     EAX,EAX
       PUSH    EAX
       PUSH    LParam
       PUSH    WParam
       PUSH    Message
       MOV     EDX,ESP
       MOV     EAX,[ECX].Longint[4]
       CALL    [ECX].Pointer
       ADD     ESP,12
       POP     EAX
end;

{ Allocate an object instance }

function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
 Result := Longint(Dest) - (Longint(Src) + 5);
end;

function MakeObjectInstance(Method: TWndMethod): Pointer;
const
 BlockCode: array[1..2] of Byte = (
   $59,       { POP ECX }
   $E9);      { JMP StdWndProc }
 PageSize = 4096;
var
 Block: PInstanceBlock;
 Instance: PObjectInstance;
begin
 if InstFreeList = nil then
 begin
   Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
   Block^.Next := InstBlockList;
   Move(BlockCode, Block^.Code, SizeOf(BlockCode));
   Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc));
   Instance := @Block^.Instances;
   repeat
     Instance^.Code := $E8;  { CALL NEAR PTR Offset }
     Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
     Instance^.Next := InstFreeList;
     InstFreeList := Instance;
     Inc(Longint(Instance), SizeOf(TObjectInstance));
   until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);
   InstBlockList := Block;
 end;
 Result := InstFreeList;
 Instance := InstFreeList;
 InstFreeList := Instance^.Next;
 Instance^.Method := Method;
end;

{ Free an object instance }

procedure FreeObjectInstance(ObjectInstance: Pointer);
begin
 if ObjectInstance <> nil then
 begin
   PObjectInstance(ObjectInstance)^.Next := InstFreeList;
   InstFreeList := ObjectInstance;
 end;
end;

TFrm = class(..)
..
 hWnd: THandle;
 FDefWndProc: Pointer;
..
 procedure DefaultHandler(var Message); override; //!!!!
..
 procedure WndProc(var Message: TMessage);
..
 function CreateWnd: boolean;
 function DestroyWnd: boolean;
..
end;

function TFrm.CreateWnd: boolean;
begin
..
 hWnd:=CreateWindowEx(..);
 ..
 SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(WndProc)));
..
end;

function TFrm.DestroyWnd: boolean;
var
 Instance: Pointer;
begin
..
 Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
 DestroyWindow(Wnd);
 if Instance <> @DefWindowProc then FreeObjectInstance(Instance);
..
end;

procedure TFrm.WndProc(var Message: TMessage);
begin
 with Message do
   case Msg of
...
   else
      Dispatch(Msg);
   end
end;

procedure TFrm.DefaultHandler(var Message);
begin
 with TMessage(Message) do begin
..
   Result := CallWindowProc(@WndProc, FHandle, Msg, WParam, LParam);
..
 end;
end;