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

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