mingw/lib/tk8.5/ttk/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]
  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 <ButtonPress-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*