На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: jack128, Rouse_, Krid
  
    > Аналог AllocateWnd , Создание скрытого окна для обработки сообщений с обработчиком-методом класса
      AllocateWnd — улучшенная версия

      Периодически в программах, плотно работающих с WinAPI, а также построенных по асинхронной схеме, требуется повесить обработку Windows сообщений на метод класса. VCL предлагает для этого AllocateWnd, однако моя версия имеет несколько преимуществ:
      • Не требует Classes, зависимости - только Windows
      • Проще реализована
      • Не требует вызова финализации DeallocateWnd - достаточно обычного закрытия хэндла. Занятая память освобождается автоматически.

      Может быть, кому-то пригодится.

      Upd.
      * Возможность присваивать как методы, так и обычные функции
      * Освобождение ресурсов в случае ошибок
      * Переделан порядок вызова в DefWndProc (убрано дублирование)
      * Типы приведены к WinAPI-шным, совместимо с x64 (но не проверялось)

      Реализация:
      ExpandedWrap disabled
        {$IFDEF MSWINDOWS}
        type
          // AllocWnd types
          TWndProcMethod = function(wnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT of object;
          TWndProc       = function(wnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
          {$ENDIF}
         
        ...
         
          {$IFDEF MSWINDOWS}
          // message window
          function AllocateMsgWnd(Handler: TWndProcMethod): HWND; overload;
          function AllocateMsgWnd(Handler: TWndProc): HWND; overload;
          procedure DeallocateMsgWnd(Wnd: HWND); inline;
          {$ENDIF}
         
        ...
         
        {$IFDEF MSWINDOWS}
         
        // ********* AllocWnd *********** \\
         
        // Служит для создания окна, предназначенного для отправки/получения сообщений.
        // ! Хэндл окна должен быть закрыт посредством DestroyWindow/DeallocateMsgWnd !
        // Метод-обработчик сообщений можно и не указывать, в этом случае сообщения
        // будут приходить в message loop потока-владельца
         
        type
          TWndProcType = (wpMethod, wpProc);
          TWndProcInst = record
            case ProcType: TWndProcType of
              wpMethod: (WndProcMethod: TWndProcMethod);
              wpProc  : (WndProc      : TWndProc);
          end;
          PWndProcInst = ^TWndProcInst;
         
        const WndProcProp = 'WndProcProp';
         
        // Новая оконная процедура, извлекающая указатель на метод-обработчик из свойства окна
        function DefWndProc(wnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
        var pInst: PWndProcInst;
        begin
          pInst := PWndProcInst(GetProp(wnd, PChar(WndProcProp)));
         
          // вызываем обработчик: метод класса/сохранённая процедура либо дефолтная функция
          if pInst = nil
            then Result := DefWindowProc(wnd, msg, wParam, lParam)
            else case pInst.ProcType of
                   wpMethod: Result := pInst.WndProcMethod(wnd, msg, wParam, lParam);
                   wpProc  : Result := pInst.WndProc(wnd, msg, wParam, lParam);
                   else      Result := 0; // make compiler happy
                 end;
         
          // если окно уничтожается - удалить свойство и освободить память, выделенную под запись
          if msg = WM_DESTROY then
          begin
            RemoveProp(wnd, PChar(WndProcProp));
            if pInst <> nil then FreeMem(pInst);
          end;
         
        end;
         
        // Создание окна-обработчика сообщений
        function InnerAllocateMsgWnd(pInst: PWndProcInst): HWND;
        var err: Integer;
        begin
          Result := CreateWindowEx(0, 'Button', nil,0,0,0,0,0, HWND_MESSAGE, 0, HInstance, nil);
          if Result = 0 then Exit;
          // сохранить указатель на метод класса - обработчик сообщений
          if (not SetProp(Result, PChar(WndProcProp), THandle(pInst))) or
          // заменить оконную процедуру
             (SetWindowLongPtr(Result, GWL_WNDPROC, LONG_PTR(@DefWndProc)) = 0) then
          begin
            err := GetLastError;
            DestroyWindow(Result);
            Result := 0;
            SetLastError(err);
          end;
        end;
         
        function AllocateMsgWnd(Handler: TWndProcMethod): HWND;
        var pInst: PWndProcInst;
        begin
          if not Assigned(Handler) then
            pInst := nil
          else
          begin
            pInst := AllocMem(SizeOf(TWndProcInst));
            pInst.ProcType := wpMethod;
            pInst.WndProcMethod := Handler;
          end;
         
          Result := InnerAllocateMsgWnd(pInst);
          if (Result = 0) and (pInst <> nil) then FreeMem(pInst);
        end;
         
        function AllocateMsgWnd(Handler: TWndProc): HWND;
        var pInst: PWndProcInst;
        begin
          if not Assigned(Handler) then
            pInst := nil else
          begin
            pInst := AllocMem(SizeOf(TWndProcInst));
            pInst.ProcType := wpProc;
            pInst.WndProc := Handler;
          end;
          Result := InnerAllocateMsgWnd(pInst);
          if (Result = 0) and (pInst <> nil) then FreeMem(pInst);
        end;
         
        // просто обертка для тех, кому привычнее
        procedure DeallocateMsgWnd(Wnd: HWND);
        begin
          DestroyWindow(Wnd);
        end;
         
        {$ENDIF}


      Использование:

      ExpandedWrap disabled
        // объявление и создание ( 1 - обработчик - метод класса, 2 - обработчик - обычная функция )
         
        1)
        TSomeClass = class
          FHwnd: THandle;
          function WndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint;
        end;
        2) —
         
        ...
        1) SomeObject : TSomeClass;
        2)
         Hw: HWND;
         function SomeWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint;
         begin
           ...
           Result := 0;
         end;
         
        ...
        1)
        SomeObject.FHwnd := AllocateMsgWnd(SomeObject.WndProc);
        if SomeObject.FHwnd = 0 then Log(SysErrorMessage(GetLastError));
        2)
        Hw := AllocateMsgWnd(SomeWndProc);
        if Hw = 0 then Log(SysErrorMessage(GetLastError));
         
        ...
         
        // Посылка сообщений
        1) SendMessage(SomeObject.FHwnd, WM_TIMER, 0, 0);
        2) SendMessage(Hw, WM_TIMER, 0, 0);
         
        ...
         
        // Удаление окна
        1) DestroyWindow(SomeObject.FHwnd);
        2) DestroyWindow(Hw);


      Комментарии и предложения приветствуются.
      Сообщение отредактировано: Krid -
        Цитата Fr0sT @
        Не требует Classes, зависимости - только Windows
        Проще реализована
        Не требует вызова финализации DeallocateWnd - достаточно обычного закрытия хэндла. Занятая память освобождается автоматически.


        + Безопасна при использовании в многопоточных приложениях в отличие от AllocateHWND.
          Обновление

          + Возможность присваивать как методы, так и обычные функции
          + Освобождение ресурсов в случае ошибок
          + Переделан порядок вызова в DefWndProc (убрано дублирование)
          0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
          0 пользователей:


          Рейтинг@Mail.ru
          [ Script execution time: 0,0231 ]   [ 17 queries used ]   [ Generated: 28.03.24, 20:58 GMT ]