/ lib / tcltk / tk8.6 / ttk / sizegrip.tcl
sizegrip.tcl
  1  #
  2  # Sizegrip widget bindings.
  3  #
  4  # Dragging a sizegrip widget resizes the containing toplevel.
  5  #
  6  # NOTE: the sizegrip widget must be in the lower right hand corner.
  7  #
  8  
  9  switch -- [tk windowingsystem] {
 10      x11 -
 11      win32 {
 12  	option add *TSizegrip.cursor [ttk::cursor seresize] widgetDefault
 13      }
 14      aqua {
 15      	# Aqua sizegrips use default Arrow cursor.
 16      }
 17  }
 18  
 19  namespace eval ttk::sizegrip {
 20      variable State
 21      array set State {
 22  	pressed 	0
 23  	pressX 		0
 24  	pressY 		0
 25  	width 		0
 26  	height 		0
 27  	widthInc	1
 28  	heightInc	1
 29          resizeX         1
 30          resizeY         1
 31  	toplevel 	{}
 32      }
 33  }
 34  
 35  bind TSizegrip <Button-1> 		{ ttk::sizegrip::Press	%W %X %Y }
 36  bind TSizegrip <B1-Motion> 		{ ttk::sizegrip::Drag 	%W %X %Y }
 37  bind TSizegrip <ButtonRelease-1> 	{ ttk::sizegrip::Release %W %X %Y }
 38  
 39  proc ttk::sizegrip::Press {W X Y} {
 40      variable State
 41  
 42      if {[$W instate disabled]} { return }
 43  
 44      set top [winfo toplevel $W]
 45  
 46      # If the toplevel is not resizable then bail
 47      foreach {State(resizeX) State(resizeY)} [wm resizable $top] break
 48      if {!$State(resizeX) && !$State(resizeY)} {
 49          return
 50      }
 51  
 52      # Sanity-checks:
 53      #	If a negative X or Y position was specified for [wm geometry],
 54      #   just bail out -- there's no way to handle this cleanly.
 55      #
 56      if {[scan [wm geometry $top] "%dx%d+%d+%d" width height x y] != 4} {
 57  	return;
 58      }
 59  
 60      # Account for gridded geometry:
 61      #
 62      set grid [wm grid $top]
 63      if {[llength $grid]} {
 64  	set State(widthInc) [lindex $grid 2]
 65  	set State(heightInc) [lindex $grid 3]
 66      } else {
 67  	set State(widthInc) [set State(heightInc) 1]
 68      }
 69  
 70      set State(toplevel) $top
 71      set State(pressX) $X
 72      set State(pressY) $Y
 73      set State(width)  $width
 74      set State(height) $height
 75      set State(x)      $x
 76      set State(y)      $y
 77      set State(pressed) 1
 78  }
 79  
 80  proc ttk::sizegrip::Drag {W X Y} {
 81      variable State
 82      if {!$State(pressed)} { return }
 83      set w $State(width)
 84      set h $State(height)
 85      if {$State(resizeX)} {
 86          set w [expr {$w + ($X - $State(pressX))/$State(widthInc)}]
 87      }
 88      if {$State(resizeY)} {
 89          set h [expr {$h + ($Y - $State(pressY))/$State(heightInc)}]
 90      }
 91      if {$w <= 0} { set w 1 }
 92      if {$h <= 0} { set h 1 }
 93      set x $State(x) ; set y $State(y)
 94      wm geometry $State(toplevel) ${w}x${h}+${x}+${y}
 95  }
 96  
 97  proc ttk::sizegrip::Release {W X Y} {
 98      variable State
 99      set State(pressed) 0
100  }
101  
102  #*EOF*