TScrollBar прокрутка колёсиком

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  i: integer;
begin
  Handled := PtInRect(Image1.ClientRect, Image1.ScreenToClient(MousePos));
  if Handled then
    for i := 1 to Mouse.WheelScrollLines do
    try
      if WheelDelta > 0 then
        ScrollBar1.Perform(WM_HSCROLL, SB_LINERIGHT, 0)
      else
        ScrollBar1.Perform(WM_HSCROLL, SB_LINELEFT, 0);
    finally
      ScrollBar1.Perform(WM_HSCROLL, SB_ENDSCROLL, 0);
    end;
end;

type
  TScrollBar = class({Vcl.}StdCtrls.TScrollBar) // перед классом формы
  protected
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
  end;
 
  TForm1 = class(TForm) // дальше без изменений...
 
// 
 
// и реализация:
implementation
 
{$R *.dfm}
 
{ TScrollBar }
function TScrollBar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
var
  NewScrollPos: Integer;
begin
  NewScrollPos := Position - WheelDelta;
  Scroll(scPosition, NewScrollPos);
  Position := NewScrollPos;
  Result := true;
end;

TScrollBar = class(StdCtrls.TScrollBar)

TScrollBar = class(TScrollBar)

type
  TScrollBar = class(Vcl.StdCtrls.TScrollBar)
    procedure SetActive(Value : Boolean);
  public
    FActive: Boolean;
    constructor Create(AOwner: TComponent); override;
    property Active : Boolean read FActive write SetActive;
  protected
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
  end;
 
// ... 
 
{ TScrollBar }
constructor TScrollBar.Create(AOwner: TComponent);
begin
  inherited;
  Active := False;
end;
 
function TScrollBar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
var
  NewScrollPos: Integer;
begin
  if Active then
  begin
    NewScrollPos := Position - WheelDelta;
    Scroll(scPosition, NewScrollPos);
    Position := NewScrollPos;
    Result := true;
  end;
end;
 
procedure TScrollBar.SetActive(Value: Boolean);
begin
  FActive := Value;
  if Value then SetFocus;
end;

procedure TForm1.Image1MouseEnter(Sender: TObject);
begin
  ScrollBar1.Active := True;
end;
 
procedure TForm1.Image1MouseLeave(Sender: TObject);
begin
  ScrollBar1.Active := False
end;

MakeWParam(0,WheelDelta)

  for p := 0 to 100000 do begin
    Form1.Caption:=inttostr(p);
  end;