私はTScrollBox
内部を持っておりTFrame
、マウスのホイールを使用すると、ScrollBoxのスクロールが上下しません。
使ってみました
TScrollBox(Sender).Perform(WM_VSCROLL,1,0);
にありますFrameMouseWheelDown
が、トリガーされません。
何か案は?
私はTScrollBox
内部を持っておりTFrame
、マウスのホイールを使用すると、ScrollBoxのスクロールが上下しません。
使ってみました
TScrollBox(Sender).Perform(WM_VSCROLL,1,0);
にありますFrameMouseWheelDown
が、トリガーされません。
何か案は?
私のスクロールボックスは次のようになります。
type
TMyScrollBox = class(TScrollBox)
protected
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
procedure WndProc(var Message: TMessage); override;
end;
function TMyScrollBox.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if not Result then begin
if Shift*[ssShift..ssCtrl]=[] then begin
VertScrollBar.Position := VertScrollBar.Position - WheelDelta;
Result := True;
end;
end;
end;
procedure TMyScrollBox.WndProc(var Message: TMessage);
begin
if Message.Msg=WM_MOUSEHWHEEL then begin
(* For some reason using a message handler for WM_MOUSEHWHEEL doesn't work. The messages
don't always arrive. It seems to occur when both scroll bars are active. Strangely,
if we handle the message here, then the messages all get through. Go figure! *)
if TWMMouseWheel(Message).Keys=0 then begin
HorzScrollBar.Position := HorzScrollBar.Position + TWMMouseWheel(Message).WheelDelta;
Message.Result := 0;
end else begin
Message.Result := 1;
end;
end else begin
inherited;
end;
end;
OnMouseWheel
イベントハンドラーを使用できます。
ScrollBar1.OnMouseWheel := ScrollBoxMouseWheel;
...
procedure TFrame1.ScrollBoxMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
Handled := True;
if WheelDelta < 0 then
TScrollBox(Sender).VertScrollBar.Position := TScrollBox(Sender).VertScrollBar.Position + TScrollBox(Sender).VertScrollBar.Increment
else
TScrollBox(Sender).VertScrollBar.Position := TScrollBox(Sender).VertScrollBar.Position - TScrollBox(Sender).VertScrollBar.Increment;
end;