Не, на уровне формы не подоходит, я же компонент делаю, на каждой форме такое лепить не фонтан. Насоветовали глянуть в сторону хуков мышки. Начал лазить по исходникам делфи, нашел у компонента Ribbon как раз то что ищу, у него закладки скролятся и сделано через хук. Предварительный вариант такой:
| Код |
TMyPageControl = class(TPageControl)
protected
function DoMouseWheelDown(AShift: TShiftState; AMousePos: TPoint): Boolean; override;
function DoMouseWheelUp(AShift: TShiftState; AMousePos: TPoint): Boolean; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
. . .
implementation
{$R *.dfm}
var
FHookHandle: THandle;
{ TMyPageControl }
function PageControlMouseWheelHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
LCtrl: TWinControl;
LStruct: PMouseHookStructEx;
LKeyState: TKeyboardState;
begin
if Code < 0 then begin
Result := CallNextHookEx(FHookHandle, Code, wParam, lParam);
Exit;
end;
if wParam = WM_MOUSEWHEEL then begin
LStruct := PMouseHookStructEx(lParam);
LCtrl := FindControl(WindowFromPoint(LStruct.MouseHookStruct.pt));
if LCtrl is TMyPageControl then begin
GetKeyboardState(LKeyState);
TMyPageControl(LCtrl).DoMouseWheel(Vcl.Forms.KeyboardStateToShiftState(LKeyState),
ShortInt(LStruct.mouseData shr 16), Point(0, 0));
Result := 1;
end else
Result := CallNextHookEx(FHookHandle, Code, wParam, lParam);
end else
Result := CallNextHookEx(FHookHandle, Code, wParam, lParam);
end;
constructor TMyPageControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if not (csDesigning in ComponentState) then begin
if FHookHandle <> 0 then
UnhookWindowsHookEx(FHookHandle);
FHookHandle := SetWindowsHookEx(WH_MOUSE, PageControlMouseWheelHook,
0, GetCurrentThreadId);
end;
end;
destructor TMyPageControl.Destroy;
begin
if FHookHandle <> 0 then
UnhookWindowsHookEx(FHookHandle);
inherited Destroy;
end;
function TMyPageControl.DoMouseWheelDown(AShift: TShiftState;
AMousePos: TPoint): Boolean;
begin
SelectNextPage(True);
Result := True;
end;
function TMyPageControl.DoMouseWheelUp(AShift: TShiftState;
AMousePos: TPoint): Boolean;
begin
SelectNextPage(False);
Result := True;
end;
|
|
)