Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.142.197.198] |
|
Сообщ.
#1
,
|
|
|
AllocateWnd — улучшенная версия
Периодически в программах, плотно работающих с WinAPI, а также построенных по асинхронной схеме, требуется повесить обработку Windows сообщений на метод класса. VCL предлагает для этого AllocateWnd, однако моя версия имеет несколько преимуществ: Может быть, кому-то пригодится. Upd. * Возможность присваивать как методы, так и обычные функции * Освобождение ресурсов в случае ошибок * Переделан порядок вызова в DefWndProc (убрано дублирование) * Типы приведены к WinAPI-шным, совместимо с x64 (но не проверялось) Реализация: {$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} Использование: // объявление и создание ( 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); Комментарии и предложения приветствуются. |
Сообщ.
#2
,
|
|
|
Цитата Fr0sT @ Не требует Classes, зависимости - только Windows Проще реализована Не требует вызова финализации DeallocateWnd - достаточно обычного закрытия хэндла. Занятая память освобождается автоматически. + Безопасна при использовании в многопоточных приложениях в отличие от AllocateHWND. |
Сообщ.
#3
,
|
|
|
Обновление
+ Возможность присваивать как методы, так и обычные функции + Освобождение ресурсов в случае ошибок + Переделан порядок вызова в DefWndProc (убрано дублирование) |