dmk ©   (23.03.17 00:14) [17]

Существует масса игровых фреймворков, где контролы создаются и рисуются также, как ты написал. Возможно, некоторые из них с исходным кодом. Всегда проще использовать чужой опыт.

Так я и пришел на сайт за опытом ;) На международных вообще какой то дегресс.

> Спасибо! Все работает. И даже 3 окна.

У тебя ж окно своё, родное, можно без OldProc и UserData:
{$APPTYPE CONSOLE}
{$R *.res}
uses
 System.SysUtils, Generics.collections, Classes, Windows, Messages;

type
 TWindow64 = class
 protected
   FHandle: HWND;
   FParent: HWND;
   FStyle:   dword;
   FStyleEx: dword;
   class var FWndClassEx: TWndClassEx;
   class var FClassRegistered: Boolean;
 private
   procedure Process(Msg: NativeInt; WParam: WParam; LParam: LParam);
   class function WndProc(Wnd:HWND; Msg:NativeInt; WParam:WParam; LParam:LParam): LResult; static; stdcall;
 public
   class var Wnds: TList<TWindow64>;
   property  Handle: HWND read FHandle;
   constructor Create(aParent:HWND);
   destructor  Destroy; override;
   class destructor Dtor;
 end;

class function TWindow64.WndProc(Wnd: HWND; Msg: NativeInt; WParam: WParam; LParam: LParam): LResult;
var
Obj:TWindow64;
begin
 Writeln(Format('Wnd:%x Msg:%u lw:%u lp:%u', [wnd, msg, wParam, lParam]));  //for debug

 if (Wnds<>nil) then
   for Obj in Wnds do
     if (Obj.FHandle = Wnd) then
       case Msg of
         WM_MOUSEFIRST..WM_MOUSELAST:
           Obj.Process(Msg, WParam, LParam);
         WM_CLOSE:
           begin
             Obj.Free;
             if (Wnds = nil) then
               PostQuitMessage(0);
           end;
       end;

 Result := DefWindowProc(Wnd, Msg ,wParam, lParam);
end;

constructor TWindow64.Create(aParent:HWND);
begin
 inherited Create;

 if not FClassRegistered then
 begin
  //Заполняем класс
   FWndClassEx.cbSize := SizeOf(FWndClassEx);
   FWndClassEx.style :=  WS_EX_CONTROLPARENT;
   FWndClassEx.lpfnWndProc := @WndProc;
   FWndClassEx.cbClsExtra := 0;
   FWndClassEx.cbWndExtra := 0;
   FWndClassEx.hInstance := HInstance;
   FWndClassEx.hIcon := 0;
   FWndClassEx.hCursor := 0;
   FWndClassEx.hbrBackground := GetStockObject(DKGRAY_BRUSH);
   FWndClassEx.lpszMenuName := nil;
   FWndClassEx.lpszClassName := PChar('TWindow64');
   FWndClassEx.hIconSm := 0;
   //Регистрируем класс
   if (RegisterClassEx(FWndClassEx) <> 0)
    then FClassRegistered := True
    else raise Exception.Create(Format('TWindow64: Класс не зарегестрирован. Ошибка: %d',[GetLastError()]));
 end;
 //Стиль окна
 FStyleEx := WS_EX_COMPOSITED;
 FStyle :=  WS_TILEDWINDOW;
 //Создаем окно
 FHandle := Windows.CreateWindowEx(FStyleEx, FWndClassEx.lpszClassName,FWndClassEx.lpszClassName, FStyle, 0, 0, 800, 600, 0, 0, HInstance, nil);

 if (FHandle <> 0) then
   begin
     FParent := AParent;
     if (Wnds = nil) then Wnds := TList<TWindow64>.Create;
     Wnds.Add(Self);
   end
 else raise Exception.Create(Format('TWindow64: Окно не создано. Ошибка: %d', [GetLastError()]));
end;

destructor TWindow64.Destroy;
begin
if ( Wnds <> nil ) then
  begin
    Wnds.Remove(Self);
    if ( Wnds.Count = 0 )
      then FreeAndNil(Wnds);
  end;

inherited Destroy;
end;

class destructor TWindow64.Dtor;
begin
if ( FClassRegistered )
  then FClassRegistered := not UnregisterClass(FWndClassEx.lpszClassName, FWndClassEx.hInstance);
end;

procedure TWindow64.Process(Msg: NativeInt; WParam: WParam; LParam: LParam);
begin
// to do ...
end;

//--------------------------------------------------------------------------------------------------
var
 Msg: tagMsg;
 Obj:TWindow64;
 i:Integer;
begin
 try
   for i:= 1 to 3 do
     TWindow64.Create(0);

   if (Obj.Wnds<>nil) then begin
     for Obj in Obj.Wnds do
       with Obj do begin
         SetWindowText(Handle, Format('Заголовок %d',[i+1]));
         SetWindowPos(Handle, 0, i*100+100, i*100+100, 800, 600, SWP_SHOWWINDOW);
         Inc(i);
       end;

     while GetMessage(Msg, 0, 0, 0) do
       if (Msg.message <> WM_QUIT)
         then DispatchMessage(Msg)             // =>  TWindow64.WndProc
         else Break;
   end;

 except
   on E: Exception do begin
     Writeln(E.ClassName, ': ', E.Message);
     Readln;
   end;
 end;
end.

P.S.
http://www.firststeps.ru/mfc/winapi/r.php?51 , 52, 53, 54..
https://msdn.microsoft.com/ru-ru/library/dd460756.aspx
(http://andybor.blogspot.com/2008/06/gui.html)

NoUser ©   (23.03.17 21:30) [22]

Огромное Спасибо!
На самом деле придется ретрансляцию сообщений делать через AllocWnd. По другому не получится. WM_MOUSEMOVE в невидимое окно не поступает. Печалька.