ScrollBoxEx.pas

unit ScrollBoxEx;

interface

uses
  Windows, Messages, SysUtils, Types, UITypes, Classes, Forms, Controls,
  StdCtrls, ExtCtrls, ComCtrls;

type
  TScrollBoxEx = class(TScrollBox)
  protected
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Align;
    property Anchors;
    property AutoScroll;
    property AutoSize;
    property BevelEdges;
    property BevelInner;
    property BevelOuter;
    property BevelKind;
    property BevelWidth;
    property BiDiMode;
    property BorderStyle;
    property Constraints;
    property DockSite;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Color;
    property Ctl3D;
    property Font;
    property Padding;
    property ParentBiDiMode;
    property ParentBackground;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Touch;
    property Visible;
    property StyleElements;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Rejbrand 2020', [TScrollBoxEx]);
end;

{ TScrollBoxEx }

procedure TScrollBoxEx.Click;
begin
  inherited;
  if CanFocus then
    SetFocus;
end;

constructor TScrollBoxEx.Create(AOwner: TComponent);
begin
  inherited;
  VertScrollBar.Smooth := True;
  VertScrollBar.Tracking := True;
  HorzScrollBar.Smooth := True;
  HorzScrollBar.Tracking := True;
end;

function IsScrollable(AControl: TWinControl): Boolean;
begin
  Result :=
    (AControl is TCustomComboBox)
      or
    (AControl is TTrackBar)
      or
    (
      (AControl is TListBox)
        or
      (AControl is TListView)
    )
      and
    (GetWindowLong(AControl.Handle, GWL_STYLE) and (WS_VSCROLL or WS_HSCROLL) <> 0);
end;

function TScrollBoxEx.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
begin
  var Ctl := Screen.ActiveControl;
  if IsScrollable(Ctl) and Ctl.MouseInClient then
    Result := False
  else
  begin
    VertScrollBar.Position := VertScrollBar.Position - WheelDelta;
    Result := True;
  end;
end;

end.