[CollideE]

Нашел в сети библиотеку WinLight, реализующую необходимый функционал. Выпилил ненужные мне функции и классы, вроде все работает

Код:

program Project1;

uses
  Windows,
  Messages,
  SysUtils;

type
  TWindowParams = record
    Caption     : PChar;
    Style       : DWord;
    ExStyle     : DWord;
    X           : Integer;
    Y           : Integer;
    Width       : Integer;
    Height      : Integer;
    WndParent   : THandle;
    WndMenu     : THandle;
    Param       : Pointer;
    WindowClass : TWndClass;
  end;

type
  TxForm = class(TObject)
    private
  fWndCallback: Pointer;
  fWndHandle  : THandle;
  FWndParams  : TWindowParams;
  function WindowCallback(hWnd: HWnd; Msg, WParam, LParam:Longint):Longint; stdcall;
    protected
  procedure   CreateWindowParams(var WindowParams: TWindowParams); virtual;
    public
  constructor Create;
  destructor  Destroy; override;
  property    WndHandle: THandle read FWndHandle;
  property    WndCallback: Pointer read FWndCallback;
  end;


{ TxForm }

constructor TxForm.Create;
begin
inherited Create;
  FWndCallback := VirtualAlloc(nil,12,MEM_RESERVE or MEM_COMMIT,PAGE_EXECUTE_READWRITE);
  asm
    mov  EAX, Self
    mov  ECX, [EAX].TxForm.FWndCallback
    mov  word  ptr [ECX+0], $6858
    mov  dword ptr [ECX+2], EAX
    mov  word  ptr [ECX+6], $E950
    mov  EAX, OFFSET(TxForm.WindowCallback)
    sub  EAX, ECX
    sub  EAX, 12
    mov  dword ptr [ECX+8], EAX
  end;
  CreateWindowParams(FWndParams);
  RegisterClass(FWndParams.WindowClass);
  with FWndParams do
    CreateWindowEx(ExStyle, WindowClass.lpszClassName, Caption,
      Style, X, Y, Width, Height,
      WndParent, WndMenu, hInstance, Param
    );
end;

procedure TxForm.CreateWindowParams(var WindowParams: TWindowParams);
var
  WndClassName : string;
begin
  Str(DWord(Self), WndClassName);
  WndClassName := ClassName+'_'+WndClassName;
  with FWndParams.WindowClass do
  begin
    style         := CS_DBLCLKS;
    lpfnWndProc   := WndCallback;
    cbClsExtra    := 0;
    cbWndExtra    := 0;
    lpszClassName := PChar(WndClassName);
    hInstance     := hInstance;
    hIcon         := LoadIcon(0, IDI_APPLICATION);
    hCursor       := LoadCursor(0, IDC_ARROW);
    hbrBackground := COLOR_BTNFACE + 1;
    lpszMenuName  := '';
  end;

  with FWndParams do
  begin
    WndParent := 0;
    Caption := 'xForm';
    Style   := WS_OVERLAPPEDWINDOW or WS_VISIBLE;
    ExStyle := 0;
    X       := Integer(CW_USEDEFAULT);
    Y       := Integer(CW_USEDEFAULT);
    Width   := Integer(CW_USEDEFAULT);
    Height  := Integer(CW_USEDEFAULT);
    WndMenu := 0;
    Param   := nil;
  end;
end;

destructor TxForm.Destroy;
begin
   UnregisterClass(FWndParams.WindowClass.lpszClassName, hInstance);
    if IsWindow(FWndHandle) then DestroyWindow(FWndHandle);
    VirtualFree(FWndCallback, 0, MEM_RELEASE);
  inherited;
end;

function TxForm.WindowCallback(hWnd: HWnd; Msg, WParam,
  LParam: Integer): Longint;
var
  WindowMsg : TMessage;
begin
  if FWndHandle = 0 then FWndHandle := hWnd;
  case Msg of
  WM_CLOSE: PostQuitMessage(0);
  end;
  Result := DefWindowProc(hWnd, Msg, WParam,LParam);
end;

{$R *.res}

var xw : TxForm;
    msg : TMsg;
begin
xw := TxForm.Create;
while (getmessage(msg, 0, 0, 0)) do
 begin
 TranslateMessage(msg);
 DispatchMessage(Msg);
 end;
end.

Ссылка на оригинал