[Sguil-cvs] sguil/client/lib guilib.tcl,1.19,1.20

[Bamm V. <ba...@us...>]

Update of /cvsroot/sguil/sguil/client/lib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31948/lib

Modified Files:
	guilib.tcl 
Log Message:
Added proc WheelEvent to fix mouse wheel for windows.


Index: guilib.tcl
===================================================================
RCS file: /cvsroot/sguil/sguil/client/lib/guilib.tcl,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** guilib.tcl	16 Nov 2005 22:27:12 -0000	1.19
--- guilib.tcl	17 Feb 2006 16:20:39 -0000	1.20
***************
*** 527,528 ****
--- 527,560 ----
      }
  }
+ 
+ # Pub Domain Wheel Scroll Code
+ proc WheelEvent { x y delta } {
+ 
+     # Find out what's the widget we're on
+     set act 0
+     set widget [winfo containing $x $y]
+ 
+     if {$widget != ""} {
+         # Make sure we've got a vertical scrollbar for this widget
+         if {[catch "$widget cget -yscrollcommand" cmd]} return
+ 
+         if {$cmd != ""} {
+             # Find out the scrollbar widget we're using
+             set scroller [lindex $cmd 0]
+ 
+             # Make sure we act
+             set act 1
+         }
+     }
+ 
+     if {$act == 1} {
+         # Now we know we have to process the wheel mouse event
+         set xy [$widget yview]
+         set factor [expr [lindex $xy 1]-[lindex $xy 0]]
+ 
+         # Make sure we activate the scrollbar's command
+         set cmd "[$scroller cget -command] scroll [expr -int($delta/(120*$factor))] units"
+         eval $cmd
+     }
+ 
+ }