Оригинал Поиск Дополнительно Вход
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Конференция "WinAPI" » Заюзать метод класса как WindowProc
 
  • SpellCaster (26.03.08 13:47) [0]
    Возникла такая надобность: создать окошко для приёма сообщений для каждого экземпляра класса. По определённым причинам пользоваться AllocateWnd не хочется. Решил воплотить такую схему:
    1) При создании объекта создается окно с WindowProc, указывающим на
    function InnerWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall;


    2) После этого в пользовательскую инфу окна заносится Self
    3) При поступлении мессаги в InnerWndProc из польз. инфы окна извлекается Self и вызывается Self.WndProc

    ИМХО, вполне неплохое и удобное решение. Проблема в том, что окно создаваться не желает, причём как-то хаотически. Код создания окна:

    constructor TMyClass.Create;
    var WndClass: TWndClass;
       ClName: string;
    begin
     inherited;

     FillChar(WndClass,SizeOf(WndClass),0);
     ClName:=ClassName;
     if not GetClassInfo(HInstance,PChar(ClName),WndClass) then
     begin
       WndClass.hInstance := HInstance;
       WndClass.lpfnWndProc := @InnerWndProc;
       WndClass.lpszClassName := PChar(ClName);
       if windows.RegisterClass(WndClass)=0 then Error(SysErrorMessage(GetLastError));
     end;
     fHwnd:=CreateWindowEx(WS_EX_TOOLWINDOW,WndClass.lpszClassName,'',WS_POPUP,
                           0,0,0,0,0,0,HInstance,nil);
     if fHwnd=0 then Error(SysErrorMessage(GetLastError));
     SetWindowLong(fHwnd,GWL_USERDATA,Integer(Self));
    end;



    Вот такая процедура работает

    function InnerWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall;
    var m: TMessage;
       res: Integer;
    begin
     m.Msg:=msg; m.WParam:=wParam; m.LParam:=lParam;
     res:=GetWindowLong(wnd,GWL_USERDATA);
     if res=0 then
     begin
       res:=GetLastError;
       MessageBox(0,pchar(SysErrorMessage(res)),'',mb_ok);
     end
     else TMyClass(pointer(res)).WndProc(m);
    end;



    но стоит закомментить строки с MessageBox - CreateWindowEx возвращает 0, причем код ошибки - тоже 0!
    Вот такая конструкция тоже работает
    function InnerWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall;
    var m: TMessage;
       res: Integer;
    begin
     m.Msg:=msg; m.WParam:=wParam; m.LParam:=lParam;
    end;


    но толку с нее, очевидно, нету.

    Что тут за грабли могут быть?
  • SpellCaster (26.03.08 13:52) [1]
    А, и самое странное в том, что если я это делаю в главном модуле, то все прекрасно действует

    function InnerWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall;
    var m: TMessage;
       res: Integer;
    begin
     m.Msg:=msg; m.WParam:=wParam; m.LParam:=lParam;
     res:=GetWindowLong(wnd,GWL_USERDATA);
     if res=0 then
       form1.Memo1.Lines.Add((SysErrorMessage(GetLastError)))
     else
       tform1(pointer(res)).Somemethod(0);
    end;

    procedure wnd;
    var WndClass: TWndClass;
       ClassRegistered: Boolean;
       ClName: string;
       w: TWndMethod;
       fHwnd: HWND;
    begin
     FillChar(WndClass,SizeOf(WndClass),0);
     ClName:='qwe';
     ClassRegistered := GetClassInfo(HInstance,PChar(ClName),WndClass);
     if not ClassRegistered then
     begin
       WndClass.hInstance := HInstance;
       WndClass.lpfnWndProc := @InnerWndProc;
       WndClass.lpszClassName := PChar(ClName);
       if windows.RegisterClass(WndClass)=0 then
         raise exception.Create(SysErrorMessage(GetLastError));
     end;
     fHwnd:=CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName,'', WS_MINIMIZE,
                           0, 0, 0, 0, 0, 0, HInstance, nil);
     if fHwnd=0 then
       raise exception.Create(SysErrorMessage(GetLastError));
     SetWindowLong(fHwnd,GWL_USERDATA,Integer(form1));
     sendmessage(fhwnd,WM_MOVE,0,0);
    end;

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    wnd;
    end;

  • Игорь Шевченко © (26.03.08 14:13) [2]
    Уж сколько раз твердили миру:

     MyWnd := CreateWindow ('myclass', 'mycaption',
                                        WS_OVERLAPPEDWINDOW,
                                        Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                                        Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
                                        HWND_DESKTOP, 0,
                                        HInstance, Self);

    в оконной процедуре:

    function MyWndProc (Window: HWND; Message, WParam: Cardinal;
     LParam: Cardinal): Longint; stdcall;
    var
     MainClass : TMainWindow;
    ...
    begin
     MainClass := TMainWindow(GetWindowLong (Window, GWL_USERDATA));
     case Message of
     WM_CREATE:
       begin
         MainClass := TMainWindow(PCreateStruct(LParam)^.lpCreateParams);
         SetWindowLong (Window, GWL_USERDATA, Integer(MainClass));
         Result := 0;
      end;
    ...........
    end;
  • Reindeer Moss Eater © (26.03.08 14:19) [3]
    AllocateHWnd
  • guav © (26.03.08 14:47) [4]
    Вот почему разрабочики Delphi не пошли по такому пути, а создают код оконного метода динамически ?
  • Игорь Шевченко © (26.03.08 15:35) [5]

    > Вот почему разрабочики Delphi не пошли по такому пути, а
    > создают код оконного метода динамически ?


    А им uses Classes незазорно втыкать
  • DVM © (26.03.08 16:20) [6]
    function TSCMPBaseClient.AllocWnd: HWND;
    var
     wc: TWndClassEx;
     WndClassName: string;
    begin
     result := 0;
     FObjectInstance := VirtualAlloc(nil, 12, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE);
     asm
       mov  EAX, Self
       mov  ECX, [EAX].TSCMPBaseClient.FObjectInstance
       mov  word  ptr [ECX+0], $6858
       mov  dword ptr [ECX+2], EAX
       mov  word  ptr [ECX+6], $E950
       mov  EAX, OFFSET(TSCMPBaseClient.WndProc)
       sub  EAX, ECX
       sub  EAX, 12
       mov  dword ptr [ECX+8], EAX
     end;
     Str(DWord(Self), WndClassName);
     WndClassName := ClassName + ':' + WndClassName;
     ZeroMemory(@wc, SizeOf(wc));
     wc.cbSize := SizeOf(Wc);
     wc.style := CS_HREDRAW or CS_VREDRAW;
     wc.hInstance := hInstance;
     wc.lpfnWndProc := FObjectInstance;
     wc.lpszClassName := pchar(WndClassName);
     wc.cbClsExtra := 0;
     wc.cbWndExtra := 0;
     if Windows.RegisterClassEx(wc) = 0 then exit;
     result := CreateWindowEx(WS_EX_TOOLWINDOW, pchar(WndClassName), 'clientwnd', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);
    end;
  • DVM © (26.03.08 16:21) [7]
    procedure TSCMPBaseClient.DeAllocWnd;
    begin
     if FWindowHandle <> 0 then DestroyWindow(FWindowHandle);
     VirtualFree(FObjectInstance, 0, MEM_RELEASE);
    end;

    function WndProc(Wnd: THandle; Msg: Cardinal; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  • DVM © (26.03.08 16:22) [8]
    WndProc - метод класса TSCMPBaseClient в моем случае
  • guav © (26.03.08 16:38) [9]
    > [5] Игорь Шевченко ©   (26.03.08 15:35)

    Я не про то, где это реализовано, я про саму реализацию.
    Чем реализация вроде [6] оказалась лучше реализации вроде [2] ?
    Я только вижу добавленую проблему пре переходе на другую архитектру процессора.
  • DVM © (26.03.08 16:50) [10]

    > Я только вижу добавленую проблему пре переходе на другую
    > архитектру процессора.

    А какая еще может быть другая архитектура у связки Windows + Delphi, кроме x86-32 и x86-64 ?
  • SpellCaster (26.03.08 17:03) [11]
    > [2] Игорь Шевченко ©   (26.03.08 14:13)

    Спасибо, не додумался до такого! Сейчас попробую

    > [3] Reindeer Moss Eater ©   (26.03.08 14:19)

    Это как раз то, от чего я хочу уйти

    > [6] DVM ©   (26.03.08 16:20)

    У тебя, насколько я понимаю, некий аналог AllocateWnd - то же выделение объекта и тот же хак с подменой адресов. Благодарю, однако хочется без читов :)

    ----

    Блин, я балбес :( совсем забыл WinAPI, там ведь надо дефолтную процедуру вызывать, если мессага не обработана. Конечно, мне приходила WM_NCCREATE, а я на нее ничего не возвращал (т.е. 0 по дефолту), вот окно и удалялось
  • guav © (26.03.08 17:17) [12]
    > [10] DVM ©   (26.03.08 16:50)

    Мало ли, может реализуют копиляцию 64разрядных бинарников для x86-64.

    Меня больше интересует какие недостатки у более прямого пути, без asm кода.
  • SpellCaster (26.03.08 17:37) [13]
    > [12] guav ©   (26.03.08 17:17)

    Ну кроме того, что в принципе любой может затереть эти данные - я недостатков не вижу, кроме того, и VCL-ный способ тоже ведь юзает польз. инфу в окне

    Итак, вся трабла действительно была в отсутствии дефолтной оконной процедуры! Вот работающий кусок кода:

    function InnerWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall;
    var m: TMessage;
       res: Integer;
    begin
     if msg = WM_MYMSG then
     begin
       Result:=0;
       m.Msg:=msg; m.WParam:=wParam; m.LParam:=lParam;
       res:=GetWindowLong(wnd,GWL_USERDATA);
       if res<>0 then
       TMyClass(Pointer(res)).WndProc(m);
     end
     else
       Result:=DefWindowProc(wnd,msg,wparam,lparam);
    end;

    constructor TMyClass.Create;
    var WndClass: TWndClass;
       ClName: string;
    begin
     inherited;

     // создаём окно, куда будут приходить все мессаги
     FillChar(WndClass,SizeOf(WndClass),0);
     ClName:=ClassName;
     if not GetClassInfo(HInstance,PChar(ClName),WndClass) then
     begin
       windows.UnregisterClass(PChar(ClName),HInstance);
       WndClass.hInstance := HInstance;
       WndClass.lpfnWndProc := @InnerWndProc;
       WndClass.lpszClassName := PChar(ClName);
       if windows.RegisterClass(WndClass)=0 then Error(SysErrorMessage(GetLastError));
     end;
     fHwnd:=CreateWindow(PChar(ClName),'',WS_OVERLAPPEDWINDOW,
                         CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,
                         HWND_DESKTOP, 0, HInstance, nil);
     if fHwnd=0 then Error(SysErrorMessage(GetLastError));
     SetWindowLong(fHwnd,GWL_USERDATA,Integer(Self));
     SendMessage(fhwnd,WM_MYMSG,123,123); // проверка!
    end;



    Единственная странность, что при использовании CreateWindowEx c абсолютно теми же параметрами я получал ошибку "Не могу найти указанный файл". Но разбираться не хочется, раз CreateWindow отлично пашет.
  • SpellCaster (26.03.08 18:01) [14]
    И еще одно решение - промежуточная функция внутри класса. Сделано через статический метод класса, поэтому только для БДС2006 и выше.

    class TMyClass
    ...
      class function WndProcSt(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall; static;
    ...
    end

    constructor TMyClass.Create(TimOut, sckt: Integer; pAddr: PSockAddrIn);
    type Twndproc = function (wnd: hWnd; msg, wParam, lParam: Longint): Longint of object; stdcall;

    var WndClass: TWndClass;
       ClName: string;
       w: Twndproc;
    begin
       ...
       WndClass.hInstance := HInstance;
       w:=wndprocst;
       WndClass.lpfnWndProc := @w;
       ...
    end;

    class function TMyClass.WndProcSt(wnd: hWnd; msg, wParam, lParam: Integer): Longint;
    var m: TMessage;
       res: Integer;
    begin
     if msg = WM_MYMSG then
     begin
       Result:=0;        
       m.Msg:=msg; m.WParam:=wParam; m.LParam:=lParam;
       res:=GetWindowLong(wnd,GWL_USERDATA);
       if res<>0 then //Result:=
       TMyClass(Pointer(res)).WndProc(m);
     end
     else
       Result:=DefWindowProc(wnd,msg,wparam,lparam);
    end;



    Удобно, что процедура внутри класса. Неудобно, что все равно приходится передавать указатель на экземпляр объекта - т.к. из статического метода можно обращаться только к статическим же полям и методам.
  • Игорь Шевченко © (26.03.08 20:08) [15]

    > fHwnd:=CreateWindow(PChar(ClName),'',WS_OVERLAPPEDWINDOW,
    >
    >                      CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,
    > CW_USEDEFAULT,
    >                      HWND_DESKTOP, 0, HInstance, nil);
    >  if fHwnd=0 then Error(SysErrorMessage(GetLastError));
    >  SetWindowLong(fHwnd,GWL_USERDATA,Integer(Self));


    В обработке WM_CREATE надо ставить данные в GWL_USERDATA
  • DVM © (26.03.08 21:08) [16]

    > SpellCaster

    При создании нескольких экземпляров класса проблем нету никаких?
  • han_malign © (27.03.08 11:40) [17]

    > Вот почему разрабочики Delphi не пошли по такому пути, а создают код оконного метода динамически ?

    - потому, что кому-то GWL_USERDATA может понадобиться для других целей...
  • SpellCaster (27.03.08 11:41) [18]
    > [15] Игорь Шевченко ©   (26.03.08 20:08)

    А почему именно так, скажи пожалуйста. Почему нельзя ставить после создания окна?
    > [16] DVM ©   (26.03.08 21:08)

    Сейчас сделал 100 штук, вроде работают
  • SpellCaster (27.03.08 11:43) [19]
    > потому, что кому-то GWL_USERDATA может понадобиться для
    > других целей...

    Так в том-то и фишка, что они и так туда пихают указатель! Только теперь уже на некий фейковый объект.
  • Игорь Шевченко © (27.03.08 11:48) [20]

    > А почему именно так, скажи пожалуйста. Почему нельзя ставить
    > после создания окна?


    потому что от момента вызова CreateWindow(Ex) до момента возврата из нее, в оконную процедуру приходит масса сообщений. И вполне вероятно, что некоторые потребуется обработать, уже имея указатель на класс, связанный с окном.
  • han_malign © (27.03.08 12:17) [21]

    > Так в том-то и фишка, что они и так туда пихают указатель!  Только теперь уже на некий фейковый объект.

    Да ну? А кусок кода слабо привести где они GWL_USERDATA используют? В D7 и BDS2006 я что-то не нашел...
  • SpellCaster (27.03.08 12:48) [22]
    > [21] han_malign ©   (27.03.08 12:17)

    RTFM...
    function AllocateHWnd(Method: TWndMethod): HWND;
    var
     TempClass: TWndClass;
     ClassRegistered: Boolean;
    begin
     UtilWindowClass.hInstance := HInstance;
    {$IFDEF PIC}
     UtilWindowClass.lpfnWndProc := @DefWindowProc;
    {$ENDIF}
     ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
       TempClass);
     if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
     begin
       if ClassRegistered then
         Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
       Windows.RegisterClass(UtilWindowClass);
     end;
     Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
       '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
     if Assigned(Method) then
       SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
    end;

  • SpellCaster (27.03.08 12:52) [23]
    > [20] Игорь Шевченко ©   (27.03.08 11:48)

    В общем случае - согласен, разумно. Однако в моём случае нужное сообщение только одно, и до определенного момента оно просто не приходит.
  • SpellCaster (27.03.08 12:53) [24]
    > [22] SpellCaster   (27.03.08 12:48)

    А, ну да, они там GWL_WNDPROC подменяют, прошу прощения.
  • han_malign © (27.03.08 13:20) [25]

    > Уж сколько раз твердили миру:
    >
    >  MyWnd := CreateWindow ('myclass', 'mycaption',
    >                                     WS_OVERLAPPEDWINDOW,
    >                                     Integer(CW_USEDEFAULT),
    >                                     Integer(CW_USEDEFAULT),
    >                                     Integer(CW_USEDEFAULT),
    >                                     Integer(CW_USEDEFAULT),
    >                                     HWND_DESKTOP, 0,
    >                                     HInstance, Self);

    - вообще, почитав MSDN, тут лучше перестраховаться и передавать указатель на структуру
    packed record
       size: word;
       _self: TObject;
       ....
    end;
    - потому как не исключено, что это дело нацеливалось на копирование пользовательских данных... скорее всего, конечно, для валидации, но если в очередном сервис-паке Висты все нагнется - я сильно не удивлюсь.
  • Игорь Шевченко © (27.03.08 15:11) [26]
    han_malign ©   (27.03.08 13:20) [25]

    Не, оно не копируется. Внутре указатель передается.
  • SpellCaster (19.11.08 13:35) [27]
    Набрел на еще один способ: случайно узнал о таких полезных функциях, как Get/SetProp. Теперь можно присваивать так:
       SetProp(wnd,PropName,LParam(Self));


    и извлекать
     obj := TMyObject(Pointer(GetProp(wnd,PropName)));
     if obj = nil
       then Result := False
       else Result := obj.DialogProc(wnd, msg, wParam, lParam);

  • Leonid Troyanovsky © (19.11.08 19:20) [28]

    > guav ©   (26.03.08 17:17) [12]

    > Меня больше интересует какие недостатки у более прямого
    > пути, без asm кода.

    Не понял, что есть "прямой", но GetWindowLong - медленней.
    Как, впрочем, и GetProp.

    --
    Regards, LVT.
  • Leonid Troyanovsky © (19.11.08 19:29) [29]

    > SpellCaster   (26.03.08 17:03) [11]

    > У тебя, насколько я понимаю, некий аналог AllocateWnd -
    > то же выделение объекта и тот же хак с подменой адресов.
    >  Благодарю, однако хочется без читов :)

    Сам ты хак и чит.
    AllocateWnd выделяет память честно - for execute.
    И не подмена, а выделение функции ок. проц. для каждого экз. класса.

    Вот, те кто реализовывал ок. проц. на стеке - тот пострадал.
    Может даже MFC or SWL, не упомню уж.

    --
    Regards, LVT.
  • Leonid Troyanovsky © (19.11.08 19:36) [30]

    > Leonid Troyanovsky ©   (19.11.08 19:29) [29]

    > AllocateWnd выделяет память честно - for execute.

    В смысле MakeObjectInstance, или как его, sorry.

    --
    Regards, LVT.
  • GrayFace © (23.11.08 04:08) [31]
    Leonid Troyanovsky ©   (19.11.08 19:29) [29]
    Вот, те кто реализовывал ок. проц. на стеке - тот пострадал.
    Например я :) Я еще недоумевал, зачем они делают так сложно, когда можно хранить процедуру в самом объекте :)
 
Конференция "WinAPI" » Заюзать метод класса как WindowProc
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Есть новые Нет новых   [134435   +33][b:0][p:0.005]