How to use a scroll event in a TListBox #113

unit exlist;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TScrollNotification = procedure(Sender: TObject; const Msg: TWMScroll; 
    var dontScroll: Boolean) of object;

  TExListbox = class(TCustomListbox)
  private
    FOnVScroll, FOnHScroll: TScrollNotification;
  protected
    procedure WMVScroll(var msg: TWMScroll); message WM_VSCROLL;
    procedure WMHScroll(var msg: TWMScroll); message WM_HSCROLL;
  published
    property Align;
    property BorderStyle;
    property Color;
    property Columns;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property ExtendedSelect;
    property Font;
    property IntegralHeight;
    property ItemHeight;
    property Items;
    property MultiSelect;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property Style;
    property TabOrder;
    property TabStop;
    property TabWidth;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnVScroll: TScrollNotification
      read FOnVScroll write FOnVScroll;
    property OnHScroll: TScrollNotification
      read FOnHScroll write FOnHScroll;
  end;

procedure Register;

implementation

procedure TExListbox.WMVScroll(var msg: TWMScroll);
var
  dontScroll: Boolean;
begin
  if Assigned(FOnVScroll) then
  begin
    dontScroll := False;
    FOnVScroll(self, msg, dontScroll);
    if dontScroll then
      Exit;
  end;
  inherited;
end;

procedure TExListbox.WMHScroll(var msg: TWMScroll);
var
  dontScroll: Boolean;
begin
  if Assigned(FOnHScroll) then
  begin
    dontScroll := False;
    FOnHScroll(self, msg, dontScroll);
    if dontScroll then
      Exit;
  end;
  inherited;
end;

procedure Register;
begin
  RegisterComponents('PBGoodies', [TExListbox]);
end;

end.