{********************************************************************
TMSWHEEL component
for Delphi 2.0,3.0,4.0,5.0 C++Builder 1,3,4
version 1.5

written by 
     TMS Software
     copyright © 1997-2000
     Email : info@tmssoftware.com
     Web : http://www.tmssoftware.com

The source code is given as is. The author is not responsible
for any possible damage done due to the use of this code.
The component can be freely used in any application. The source
code remains property of the author and may not be distributed
freely as such.
********************************************************************}

unit mswheel;

{$IFDEF VER110}
 {$ObjExportAll On}
{$ENDIF}

{$IFDEF VER125}
 {$ObjExportAll On}
{$ENDIF}

{$IFDEF VER130}
 {$IFDEF BCB}
 {$ObjExportAll On}
 {$ENDIF}
{$ENDIF}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Forms, ShellAPI, windows, grids, stdctrls, controls;

type
  TMouseWheelEvent = procedure(zdelta,xpos,ypos,ScrollLines:integer) of object;
  TOnIntelliEvent = procedure(zdelta,xpos,ypos,ScrollLines:integer) of object;

  EMSWheelError = class(Exception);

  TMSWheel = class(TComponent)
  private
    wheelscrl:integer;
    wheelmsg:DWORD;
    { Private declarations }
    function ScrollLines:integer;
  protected
    { Protected declarations }
    OldWndProc: TFarProc;
    NewWndProc: Pointer;
    FOnWheelEvent:TMouseWheelEvent;
    FOnIntelliScroll:TOnIntelliEvent;
    FOnIntelliZoom:TOnIntelliEvent;
    FOnIntelliPan:TOnIntelliEvent;
    FOnIntelliDataZoom:TOnIntelliEvent;
    FOnIntelliAutoScroll:TOnIntelliEvent;
    FAuto:boolean;
    procedure HookWndProc(var Msg: TMessage);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    { Published declarations }
    property Auto: boolean read FAuto write FAuto;
    property OnWheelEvent: TMouseWheelEvent read FOnWheelEvent write FOnWheelEvent;
    property OnIntelliScroll:TOnIntelliEvent read FOnIntelliScroll write FOnIntelliScroll;
    property OnIntelliZoom:TOnIntelliEvent read FOnIntelliZoom write FOnIntelliZoom;
    property OnIntelliDataZoom:TOnIntelliEvent read FOnIntelliDataZoom write FOnIntelliDataZoom;
  end;


implementation

uses
 Registry;

const
  WM_MOUSEWHEEL  = $020A;
  SPI_GETWHEELSCROLLLINES = 104;

  MSH_MOUSEWHEEL = 'MSWHEEL_ROLLMSG';
  MOUSEZ_CLASSNAME  = 'MouseZ';           // wheel window class
  MOUSEZ_TITLE      = 'Magellan MSWHEEL'; // wheel window title
  MSH_WHEELSUPPORT  = 'MSH_WHEELSUPPORT_MSG'; // name of msg to send
                                              // to query for wheel support
  MSH_SCROLL_LINES = 'MSH_SCROLL_LINES_MSG';

  SPI_SETWHEELSCROLLLINES  = 105;

  MSH_WHEELMODULE_CLASS = MOUSEZ_CLASSNAME;
  MSH_WHEELMODULE_TITLE = MOUSEZ_TITLE;

function TMSWheel.ScrollLines:integer;
var
 mshwheel:thandle;
 scrollmsg:integer;
 i:integer;
 verinfo:tosversioninfo;

begin
 verinfo.dwOSVersionInfoSize:=sizeof(tosversioninfo);
 getversionex(verinfo);

 if (verinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) or

    ((verinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) AND
     (verinfo.dwMajorVersion < 4)) then
   begin
   ScrollLines:=0;
   mshwheel:=FindWindow(MSH_WHEELMODULE_CLASS,MSH_WHEELMODULE_TITLE);


   if (mshwheel>0) then
    begin
     scrollmsg:=RegisterWindowMessage(MSH_SCROLL_LINES);
     i:=SendMessage(mshwheel,scrollmsg,0,0);
     scrollLines:=i;
    end;
   end

  else {its win nt 4+}
   begin
    SystemParametersInfo(SPI_GETWHEELSCROLLLINES,0,@i,0);
    scrollLines:=i;
   end;

end;

constructor tmswheel.Create(AOwner:TComponent);
var
  I, Instances: Integer;
begin
  inherited Create(AOwner);
  if not (Owner is TForm) then
    raise EMSWheelError.Create('Control parent must be a form!');
  Instances := 0;
  for I := 0 to Owner.ComponentCount - 1 do
    if (Owner.Components[I] is tmswheel) then
      Inc(Instances);
  if (Instances > 1) then
    raise EMSWheelError.Create('Only one instance of TMSWheel allowed on form');

  { Hook parent }
  OldWndProc := TFarProc(GetWindowLong((Owner as TForm).Handle, GWL_WNDPROC));
  {$WARNINGS OFF}
  NewWndProc := MakeObjectInstance(HookWndProc);
  {$WARNINGS ON}
  SetWindowLong((Owner as TForm).Handle, GWL_WNDPROC, LongInt(NewWndProc));

  {do mousewheel registering here}
  wheelscrl:=self.scrolllines;
  wheelmsg:=RegisterWindowMessage(MSH_MOUSEWHEEL);
end;  { tmswheel.Create }

destructor tmswheel.Destroy;
begin
  { Unhook parent }
  if (Owner<>nil) and Assigned(OldWndProc) then
    SetWindowLong((Owner as TForm).Handle, GWL_WNDPROC, LongInt(OldWndProc));
  if Assigned(NewWndProc) then
  {$WARNINGS OFF}
    FreeObjectInstance(NewWndProc);
  {$WARNINGS ON}
  { Clean up }
  inherited Destroy;
end;  { tmswheel.Destroy }

procedure tmswheel.HookWndProc(var Msg: TMessage);
var
 i:integer;
 Control: TWinControl;
 Num: integer;

 function hi_int(i:integer):integer;
 begin
  i:=hiword(i);
  if i>32768 then i:=i-65536;
  hi_int:=i;
 end;

begin
  with Msg do
   begin
     if (msg=WM_MOUSEWHEEL) then {this is the NT case}
      begin
       if (assigned(OnWheelEvent)) then
         begin
           FOnWheelEvent(hi_int(wparam),loword(lparam),hiword(lparam),wheelscrl);

           if FAuto then
            begin
             Control := FindVCLWindow(Point(loword(lparam),hiword(lparam)));
             if (Control <> nil) then
             if (Control is TStringGrid) then
              begin
               i:=(control as TStringGrid).row;
               Num:=wparam div 120;
               i:=i+(-num*wheelscrl);
               if (i<(control as TStringGrid).fixedrows) then i:=(control as TStringGrid).fixedrows;
               if (i>(control as TStringGrid).rowcount-1) then i:=(control as TStringGrid).rowcount-1;
               (control as TStringGrid).row:=i;
              end;
            end
         end;


       if ((wparam and MK_CONTROL)>0) then
           if assigned(OnIntelliZoom) then
             FOnIntelliZoom(hi_int(wparam),loword(lparam),hiword(lparam),wheelscrl);

       if ((wparam and MK_SHIFT)>0) then
           if assigned(OnIntelliDataZoom) then
             FOnIntelliDataZoom(hi_int(wparam),loword(lparam),hiword(lparam),wheelscrl);

       if ((wparam and MK_SHIFT)=0) and ((wparam and MK_CONTROL)=0) then
        if assigned(OnIntelliScroll) then
          FOnIntelliScroll(hi_int(wparam),loword(lparam),hiword(lparam),wheelscrl);

      end;

     Result:=CallWindowProc(OldWndProc,(Owner as TForm).Handle, Msg, wParam, lParam);

     {forward wheel messages to focussed control}

     if (msg=wheelmsg) and (wheelmsg<>0) then
      begin
       if assigned((Owner as TForm).ActiveControl) then
        sendmessage((Owner as TForm).ActiveControl.handle,msg,WParam,lparam);

       {invoke handler here, but what about diff.actions ???}

       if (getkeystate(VK_CONTROL) and $8000=$8000) then
         begin
           if assigned(OnIntelliZoom) then
             FOnIntelliZoom(wparam,loword(lparam),hiword(lparam),wheelscrl);
         end
       else
       if (getkeystate(VK_SHIFT) and $8000=$8000) then
         begin
          if assigned(OnIntelliDataZoom) then
           FOnIntelliDataZoom(wparam,loword(lparam),hiword(lparam),wheelscrl);
         end
       else
        if assigned(OnIntelliScroll) then
          FOnIntelliScroll(wparam,loword(lparam),hiword(lparam),wheelscrl);

       if (assigned(OnWheelEvent)) then
        begin
          FOnWheelEvent(wparam,loword(lparam),hiword(lparam),wheelscrl);
          if FAuto then
           begin
            Control := FindVCLWindow(Point(loword(lparam),hiword(lparam)));
            if (Control <> nil) then
            begin
             Num:=wparam div 120;

             if (Control is TMemo) or (Control is TEdit) then
              begin
               SendMessage(Control.Handle,EM_LINESCROLL,0,-num*wheelscrl);
              end;
             if (Control is TCustomListBox) then
              begin
               i:=sendmessage(control.handle,lb_gettopindex,0,0);
               i:=i+(-num*wheelscrl);
               if (i<0) then i:=0;
               sendmessage(control.handle,lb_settopindex,i,0);
              end;
             if (Control is TStringGrid) then
              begin
               i:=(control as TStringGrid).row;
               i:=i+(-num*wheelscrl);
               if (i<(control as TStringGrid).fixedrows) then i:=(control as TStringGrid).fixedrows;
               if (i>(control as TStringGrid).rowcount-1) then i:=(control as TStringGrid).rowcount-1;
               (control as TStringGrid).row:=i;
              end;
            end;

           end;
        end;

      end;
   end;
end;  { tmswheel.HookWndProc }


end.
