Вообщем задача такая: ограничить движение курсора при нажатии левой кнопкой мыши на определенном диапазоне границами этого диапазона. Все, что я смог сделать- это написать код для правой кнопки мыши. В примере диапазоны, в которых должен "запираться" курсор выделены зеленым цветом. Все уперлось в хук. Нужно чтобы при нажатии левой кнопки движение курсора ограничивалось границами соответствующего диапазона и при отпускании левой кнопки ограничение снималось.
Вообщем задача такая: ограничить движение курсора при нажатии левой кнопкой мыши на определенном диапазоне границами этого диапазона. Все, что я смог сделать- это написать код для правой кнопки мыши. В примере диапазоны, в которых должен "запираться" курсор выделены зеленым цветом. Все уперлось в хук. Нужно чтобы при нажатии левой кнопки движение курсора ограничивалось границами соответствующего диапазона и при отпускании левой кнопки ограничение снималось.krosav4ig
function LowLevelMouseProc(Code: Integer; wParam: DWORD; lParam: DWORD): Longint; stdcall; begin if (Code = HC_ACTION) then begin if (wParam = WM_LBUTTONDOWN) then begin SendMessage(GlobalData.Wnd, MWM_LBUTTONDOWN, 0, 0); if Filters.BlockLeftButton = True then Result := - 1 else Result := CallNextHookEx(GlobalData^.WndHook, Code, wParam, lParam); end else if (wParam = WM_LBUTTONUP) then begin SendMessage(GlobalData.Wnd, MWM_LBUTTONUP, 0, 0); if Filters.BlockLeftButton = True then Result := - 1 else Result := CallNextHookEx(GlobalData^.WndHook, Code, wParam, lParam); end else Result := CallNextHookEx(GlobalData^.WndHook, Code, wParam, lParam); end; end;
function StartMouseHook(State: Boolean; Wnd: HWND): Boolean; export; stdcall; begin Result := False; if State = True then begin GlobalData^.WndHook := SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseProc, hInstance, 0); GlobalData^.Wnd := Wnd; if GlobalData^.WndHook <> 0 then Result := True; end else begin UnhookWindowsHookEx(GlobalData^.WndHook); Result := False; end; end;
function StopMouseHook(): Boolean; export; stdcall; begin UnhookWindowsHookEx(GlobalData^.WndHook); if GlobalData^.WndHook = 0 then Result := False else Result := True; end;
function UpdateMouseHook(HookFilters: TMouseHookFilters): Boolean; export; stdcall; begin Filters := HookFilters; end;
if StartMouseHook(true, Handle) = true then HookEnable := true;
[/vba]
и обработчик нажатия [vba]
Код
procedure TForm1.WndProc(var Msg: TMessage) { отслеживаем нажатия левой кл. мыши } ; begin inherited; if (Msg.Msg = MWM_LBUTTONDOWN{MWM_LBUTTONUP}) then begin ShowMessage('DOWN'{'UP'}) end; end;
[/vba]
можно ли это как-нить прикрутить к VBA?
Нашел у себя в закромах библиотеку хука, написанную на delphi
[vba]
Код
library LowLevelMouseHook;
uses Windows, Messages;
const WH_MOUSE_LL = 14; MMFName: PChar = 'MMF';
type PGlobalDLLData = ^TGlobalDLLData; TGlobalDLLData = packed record WndHook: HWND; Wnd: HWND; end;
type TMouseHookFilters = record BlockMouseMove: boolean; BlockLeftButton: boolean; BlockRightButton: boolean; BlockMiddleButton: boolean; BlockWheel: boolean; end;
function LowLevelMouseProc(Code: Integer; wParam: DWORD; lParam: DWORD): Longint; stdcall; begin if (Code = HC_ACTION) then begin if (wParam = WM_LBUTTONDOWN) then begin SendMessage(GlobalData.Wnd, MWM_LBUTTONDOWN, 0, 0); if Filters.BlockLeftButton = True then Result := - 1 else Result := CallNextHookEx(GlobalData^.WndHook, Code, wParam, lParam); end else if (wParam = WM_LBUTTONUP) then begin SendMessage(GlobalData.Wnd, MWM_LBUTTONUP, 0, 0); if Filters.BlockLeftButton = True then Result := - 1 else Result := CallNextHookEx(GlobalData^.WndHook, Code, wParam, lParam); end else Result := CallNextHookEx(GlobalData^.WndHook, Code, wParam, lParam); end; end;
function StartMouseHook(State: Boolean; Wnd: HWND): Boolean; export; stdcall; begin Result := False; if State = True then begin GlobalData^.WndHook := SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseProc, hInstance, 0); GlobalData^.Wnd := Wnd; if GlobalData^.WndHook <> 0 then Result := True; end else begin UnhookWindowsHookEx(GlobalData^.WndHook); Result := False; end; end;
function StopMouseHook(): Boolean; export; stdcall; begin UnhookWindowsHookEx(GlobalData^.WndHook); if GlobalData^.WndHook = 0 then Result := False else Result := True; end;
function UpdateMouseHook(HookFilters: TMouseHookFilters): Boolean; export; stdcall; begin Filters := HookFilters; end;
if StartMouseHook(true, Handle) = true then HookEnable := true;
[/vba]
и обработчик нажатия [vba]
Код
procedure TForm1.WndProc(var Msg: TMessage) { отслеживаем нажатия левой кл. мыши } ; begin inherited; if (Msg.Msg = MWM_LBUTTONDOWN{MWM_LBUTTONUP}) then begin ShowMessage('DOWN'{'UP'}) end; end;