Маэстро - вы меня поражаете  Messages то зачем убирать? Там лежат только описания констант и в проект оттуда подгружаются только те, которые необходимы для использования. Кстати смею уверить - программирование на АПИ не включает в себя отключение данного модуля
ЗЗЫ: А вообще пример под апи можно было и переписать самому.
| Код |
program Project8;
uses
Windows,
Messages;
resourcestring
TXT_CAPTION = 'Демо низкоуровнего хука.';
var
MainWindow : TWndClassEx;
Msg : TMsg;
Left,
Top,
Width,
Height : Integer;
RootHandle,
hMemo,
hHook,
hFontNormal : THandle;
ClientRect : TRect;
const
WH_KEYBOARD_LL = 13;
ID_MEMO = 100;
// Центрирование формы
// =============================================================================
procedure CenterMainForm;
var
ScrWidth, ScrHeight: Cardinal;
begin
ScrWidth := GetSystemMetrics(SM_CXSCREEN);
ScrHeight := GetSystemMetrics(SM_CYSCREEN);
Left := (Integer(ScrWidth) - Width) div 2;
Top := (Integer(ScrHeight) - Height) div 2;
end;
// Обработчик низкоуровневого хука
// =============================================================================
function LowLevelKeyboardProc(nCode: Integer;
WParam: WPARAM; LParam: LPARAM): LRESULT stdcall;
type
PKbdDllHookStrukt = ^TKbdDllHookStrukt;
_KBDLLHOOKSTRUCT = record
vkCode: DWORD;
scanCode: DWORD;
flags: DWORD;
time: DWORD;
dwExtraInfo: PDWORD;
end;
TKbdDllHookStrukt = _KBDLLHOOKSTRUCT;
const
RPT_WPARAM_DATA = 'Keyboard message = ';
RPT_LPARAM_DATA = 'scan code = ';
var
StrResult, StrCurentText: String;
Len: Integer;
begin
StrResult := '';
if nCode = HC_ACTION then
Result := CallNextHookEx(hHook, nCode, WParam, LParam);
case WParam of
WM_KEYDOWN: StrResult := RPT_WPARAM_DATA + 'WM_KEYDOWN, ';
WM_KEYUP: StrResult := RPT_WPARAM_DATA + 'WM_KEYUP, ';
WM_SYSKEYDOWN: StrResult := RPT_WPARAM_DATA + 'WM_SYSKEYDOWN, ';
WM_SYSKEYUP: StrResult := RPT_WPARAM_DATA + 'WM_SYSKEYUP, ';
end;
Len := SendMessage(hMemo, WM_GETTEXTLENGTH, 0, 0) + 1;
SetLength(StrCurentText, Len);
SendMessage(hMemo, WM_GETTEXT, Len, Integer(@StrCurentText[1]));
StrCurentText[Len] := ' ';
StrResult := StrResult + RPT_LPARAM_DATA +
Chr(PKbdDllHookStrukt(LParam)^.vkCode);
StrCurentText := String(StrCurentText) + StrResult + #13#10;
SendMessage(hMemo, WM_SETTEXT, 0, Integer(@StrCurentText[1]));
Len := SendMessage(hMemo, WM_GETTEXTLENGTH, 0, 0) + 1;
SendMessage(hMemo, EM_SETSEL, Len, Len);
SendMessage(hMemo, EM_SCROLLCARET, 0, 0);
end;
// Главная оконная процедура
// =============================================================================
function WindowProc(Wnd: HWND; Msg: Integer;
WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
begin
case Msg of
WM_DESTROY:
begin
PostQuitMessage(0);
Result:=0;
end;
else
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
end;
end;
// Здесь программа стартует
// =============================================================================
begin
with MainWindow do
begin
cbSize := SizeOf(MainWindow);
style := CS_HREDRAW or CS_VREDRAW;
lpfnWndProc := @WindowProc;
cbClsExtra := 0;
cbWndExtra := 0;
hIcon := LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := COLOR_BTNFACE + 1;
lpszMenuName := nil;
lpszClassName := 'Demo';
end;
MainWindow.hInstance := HInstance;
if RegisterClassEx(MainWindow) = 0 then
begin
Exit;
end;
Width := 360;
Height := 200;
CenterMainForm;
RootHandle := CreateWindowEx(WS_EX_CONTROLPARENT, 'Demo',
PChar(TXT_CAPTION), WS_OVERLAPPED or WS_SYSMENU,
Left, Top, Width, Height, 0, 0, HInstance, nil);
GetClientRect(RootHandle, ClientRect);
ClientRect.Bottom := ClientRect.Bottom - ClientRect.Top;
ClientRect.Right := ClientRect.Right - ClientRect.Left;
hMemo := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', nil,
ES_MULTILINE or WS_VSCROLL or WS_CHILD or WS_VISIBLE,
0, 0, ClientRect.Right, ClientRect.Bottom, RootHandle,
ID_MEMO, HInstance, nil);
hFontNormal := CreateFont(-11, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, 'MS Sans Serif');
if hFontNormal <> 0 then
SendMessage(hMemo, WM_SETFONT, hFontNormal, 0);
ShowWindow(RootHandle, SW_SHOW);
hHook := SetWindowsHookEx(WH_KEYBOARD_LL, LowLevelKeyboardProc, hInstance, 0);
if hHook = 0 then PostQuitMessage(GetLastError);
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
UnhookWindowsHookEx(hHook);
end.
|
|
