mingw/lib/tk8.5/ttk/sizegrip.tcl

   1 #
   2 # $Id: sizegrip.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $
   3 #
   4 # Ttk widget set -- sizegrip widget bindings.
   5 #
   6 # Dragging a sizegrip widget resizes the containing toplevel.
   7 #
   8 # NOTE: the sizegrip widget must be in the lower right hand corner.
   9 #
  10
  11 option add *TSizegrip.cursor $::ttk::Cursors(seresize)
  12
  13 namespace eval ttk::sizegrip {
  14     variable State
  15     array set State {
  16         pressed         0
  17         pressX          0
  18         pressY          0
  19         width           0
  20         height          0
  21         widthInc        1
  22         heightInc       1
  23         toplevel        {}
  24     }
  25 }
  26
  27 bind TSizegrip <ButtonPress-1>          { ttk::sizegrip::Press  %W %X %Y }
  28 bind TSizegrip <B1-Motion>              { ttk::sizegrip::Drag   %W %X %Y }
  29 bind TSizegrip <ButtonRelease-1>        { ttk::sizegrip::Release %W %X %Y }
  30
  31 proc ttk::sizegrip::Press {W X Y} {
  32     variable State
  33
  34     set top [winfo toplevel $W]
  35
  36     # Sanity-checks:
  37     #   If a negative X or Y position was specified for [wm geometry],
  38     #   just bail out -- there's no way to handle this cleanly.
  39     #
  40     if {[scan [wm geometry $top] "%dx%d+%d+%d" width height _x _y] != 4} {
  41         return;
  42     }
  43
  44     # Account for gridded geometry:
  45     #
  46     set grid [wm grid $top]
  47     if {[llength $grid]} {
  48         set State(widthInc) [lindex $grid 2]
  49         set State(heightInc) [lindex $grid 3]
  50     } else {
  51         set State(widthInc) [set State(heightInc) 1]
  52     }
  53
  54     set State(toplevel) $top
  55     set State(pressX) $X
  56     set State(pressY) $Y
  57     set State(width)  $width
  58     set State(height) $height
  59     set State(pressed) 1
  60 }
  61
  62 proc ttk::sizegrip::Drag {W X Y} {
  63     variable State
  64     if {!$State(pressed)} { return }
  65     set w [expr {$State(width)  + ($X - $State(pressX))/$State(widthInc)}]
  66     set h [expr {$State(height) + ($Y - $State(pressY))/$State(heightInc)}]
  67     if {$w <= 0} { set w 1 }
  68     if {$h <= 0} { set h 1 }
  69     wm geometry $State(toplevel) ${w}x${h}
  70 }
  71
  72 proc ttk::sizegrip::Release {W X Y} {
  73     variable State
  74     set State(pressed) 0
  75 }
  76
  77 #*EOF*