Skip to content

Commit

Permalink
mousewheel for updown
Browse files Browse the repository at this point in the history
  • Loading branch information
Johann ELSASS committed Oct 18, 2020
1 parent b46b69f commit 78fd5cc
Showing 1 changed file with 16 additions and 0 deletions.
16 changes: 16 additions & 0 deletions bctrackbarupdown.pas
Original file line number Diff line number Diff line change
Expand Up @@ -85,6 +85,7 @@ TCustomBCTrackbarUpdown = class(TBCCustomControl)
procedure MouseDown(Button: TMouseButton; {%H-}Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
procedure UTF8KeyPress(var UTF8Key: {$IFDEF FPC}TUTF8Char{$ELSE}String{$ENDIF}); override;
procedure DoEnter; override;
procedure DoExit; override;
Expand Down Expand Up @@ -623,6 +624,21 @@ procedure TCustomBCTrackbarUpdown.MouseUp(Button: TMouseButton;
end;
end;

function TCustomBCTrackbarUpdown.DoMouseWheel(Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
if Assigned(OnMouseWheel) or Assigned(OnMouseWheelDown) or Assigned(OnMouseWheelUp) then
begin
result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
exit;
end;
FHandlingUserInput:= true;
Value := Value + Increment*WheelDelta div 120;
FHandlingUserInput := false;
Invalidate;
result := true;
end;

procedure TCustomBCTrackbarUpdown.UTF8KeyPress(var UTF8Key: {$IFDEF FPC}TUTF8Char{$ELSE}String{$ENDIF});
var tempText: string;
begin
Expand Down

0 comments on commit 78fd5cc

Please sign in to comment.