unit ajWheel;

{                                   -=< Add Mouse Wheel Support >=-
{
{ Copyright SoftSpot Software 2002 - All Rights Reserved
{
{ Author        : Andrew J Jameson
{
{ Web site      : www.softspotsoftware.com
{ e-mail        : contact@softspotsoftware.com
{
{ Creation Date : 10 January 2002
{
{ Version       : 1.00
{
{ Description   : Adds wheel support to all TWinControls contained on a given form.  Intercepts the
                  control's WindowProc and converts MouseWheel movement into cursor up/down key
                  presses.                                                                         }

interface

uses
  Windows, Controls, Classes, Messages;

type
  TNewWindowProc  = class(TObject)                          // WindowProc object definition.
  private
    fOldWindowProc  : TWndMethod;                           // Original control WindowProc.
    fWinControl     : TWinControl;                          // Control reference.
  protected
    procedure   NewWindowProc (var Message : TMessage);     // The new WindowProc.
    procedure   Restore;
  public
    constructor Create        (WinControl : TWinControl);   // Create the WindowProc object.
  end;

type
  TajAddWheelSupport  = class(TObject)                      // The WheelSupport thingy.
  private
    fList : TList;                                          // Maintain a list of WindowProc objects.
  public
    constructor Create  (AOwner : TWinControl);
    destructor  Destroy;                        override;
  end;

implementation

{--------------------------------------------------------------------------------------------------}

constructor TNewWindowProc.Create(WinControl : TWinControl);
begin
  fWinControl           := WinControl;                      // Keep a copy of the WinControl reference.
  fOldWindowProc        := WinControl.WindowProc;           // Get the old WindowProc.
  WinControl.WindowProc := NewWindowProc;                   // Give it the new WindowProc.
end; {constructor}

{--------------------------------------------------------------------------------------------------}

procedure TNewWindowProc.Restore;
begin
  fWinControl.WindowProc  := fOldWindowProc;                // Give it back its old WindowProc.
end; {Restore}

{--------------------------------------------------------------------------------------------------}

procedure TNewWindowProc.NewWindowProc(var Message : TMessage);
begin
  if (Message.Msg = WM_MOUSEWHEEL) then begin               // If a mousewheel message then
    if (TWMMouseWheel(Message).WheelDelta > 0) then         // convert it to cursor key up or down.
      SendMessage(fWinControl.Handle, WM_KEYDOWN, VK_UP, 0)
    else
      SendMessage(fWinControl.Handle, WM_KEYDOWN, VK_DOWN, 0);
  end else
    fOldWindowProc(Message);                                // otherwise, pass the message on to where it was going.
end; {NewWindowProc}

{--------------------------------------------------------------------------------------------------}

constructor TajAddWheelSupport.Create(AOwner : TWinControl);
var
  lp1 : integer;
begin
  with AOwner do begin                                      // Scan the owner looking for controls.
    fList := TList.Create;                                  // Create the WindowProc list and
    for lp1 := 0 to pred(ComponentCount) do begin           // add all TWinControls that are found
      if (Components[lp1] is TWinControl) then              // onto the list.
        fList.Add(TNewWindowProc.Create(TWinControl(Components[lp1])));
    end; {for}
  end; {with}
end; {constructor}

{--------------------------------------------------------------------------------------------------}

destructor TajAddWheelSupport.Destroy;
begin
  while (fList.Count > 0) do begin                          // Free up all the stored WindowProc objects.
    TNewWindowProc(fList.Items[pred(fList.Count)]).Restore;
    TNewWindowProc(fList.Items[pred(fList.Count)]).Free;
    fList.Delete(pred(fList.Count));
  end; {while}
  fList.Free;
  inherited;
end; {destructor}

{--------------------------------------------------------------------------------------------------}
{ajWheel}
end.