以下代码摘自controls.pas:
procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
....
implimentation
....
procedure TWinControl.CMMouseWheel(var Message: TCMMouseWheel);
begin
with Message do
begin
Result := 0;
if DoMouseWheel(ShiftState, WheelDelta, SmallPointToPoint(Pos)) then
Message.Result := 1
else if Parent <> nil then
with TMessage(Message) do
Result := Parent.Perform(CM_MOUSEWHEEL, WParam, LParam);
end;
end;
procedure TWinControl.WMMouseWheel(var Message: TWMMouseWheel);
begin
TCMMouseWheel(Message).ShiftState := KeysToShiftState(Message.Keys);
MouseWheelHandler(TMessage(Message));
if Message.Result = 0 then inherited;
end;
procedure TWinControl.MouseWheelHandler(var Message: TMessage);
var
Form: TCustomForm;
begin
Form := GetParentForm(Self);
if (Form <> nil) and (Form <> Self) then Form.MouseWheelHandler(TMessage(Message))
else with TMessage(Message) do
Result := Perform(CM_MOUSEWHEEL, WParam, LParam);
end;
function TWinControl.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;
function TWinControl.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
Result := False;
if Assigned(FOnMouseWheelDown) then
FOnMouseWheelDown(Self, Shift, MousePos, Result);
end;
function TWinControl.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
Result := False;
if Assigned(FOnMouseWheelUp) then
FOnMouseWheelUp(Self, Shift, MousePos, Result);
end;
TWinControl(delphi 4)中相应事件为:
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
