当我们需要响应鼠标滚轮效果的时候,我们需要在Form的FormMouseWheel、FormMouseWheelDown、FormMouseWheelUp事件中进行处理。如下面的代码:
1 2 3 4 5 6 7 8 9 10 11 |
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin Edit1.Top := Edit1.Top + 10; end; procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin Edit1.Top := Edit1.Top - 10; end; |
但是在实际运行中我们发现,每次滚轮后Edit1的顶部位置往上或下移动了两次,这是因为TControl的DoMouseWheel调用了该事件,如果该事件中Handled返回值为true,则DoMouseWheel将认为该事件处理完毕,不在执行后边的代码,如果返回false则继续执行后面的代码。
所以如果要避免这几个事件执行多次,在执行完你要执行的操作后,返回Handled := True;即可。如下:
1 2 3 4 5 6 |
procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin Edit1.Top := Edit1.Top - 10; Handled := True; end; |
DoMouseWheel的代码如下:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
function TControl.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; var IsNeg: Boolean; begin Result := False; if Assigned(FOnMouseWheel) then FOnMouseWheel(Self, Shift, WheelDelta, MousePos, Result); if not Result then begin Inc(FWheelAccumulator, WheelDelta); while Abs(FWheelAccumulator) >= WHEEL_DELTA do begin IsNeg := FWheelAccumulator < 0; FWheelAccumulator := Abs(FWheelAccumulator) - WHEEL_DELTA; if IsNeg then begin if FWheelAccumulator <> 0 then FWheelAccumulator := -FWheelAccumulator; Result := DoMouseWheelDown(Shift, MousePos); end else Result := DoMouseWheelUp(Shift, MousePos); end; end; end; |