AParams.cbWndExtra := SizeOf(TObject);

function WindowProc(AHWnd: HWND; AMsg: UINT; AWParam: WPARAM; ALParam: LPARAM): LRESULT; stdcall;
var
  LCreateStruct: PCreateStruct absolute ALParam;
  LPrevVal: LONG_PTR;
  LError: Cardinal;
  LObj: TObject;
  LMsg: TMessage;
begin
  LMsg.Result := DefWindowProc(AHWnd, AMsg, AWParam, ALParam);
  if AMsg = WM_NCCREATE then begin
    LObj := LCreateStruct^.lpCreateParams;
    SetLastError(0);
    LPrevVal := SetWindowLongPtr(AHWnd, 0, LONG_PTR(LObj));
    if LPrevVal <> 0 then
      raise Exception.Create('Object already assigned');
    LError := GetLastError;
    if LError <> 0 then
      RaiseLastOSError(LError);
  end else
    LObj := TObject(GetWindowLongPtr(AHWnd, 0));
  if LObj <> nil then begin
    LMsg.Msg := AMsg;
    LMsg.WParam := AWParam;
    LMsg.LParam := ALParam;
    LObj.Dispatch(LMsg);
  end;
  Result := LMsg.Result;
end;