summaryrefslogtreecommitdiffstats
path: root/library/ttk/sizegrip.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/ttk/sizegrip.tcl')
-rw-r--r--library/ttk/sizegrip.tcl102
1 files changed, 102 insertions, 0 deletions
diff --git a/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl
new file mode 100644
index 0000000..153e310
--- /dev/null
+++ b/library/ttk/sizegrip.tcl
@@ -0,0 +1,102 @@
+#
+# Sizegrip widget bindings.
+#
+# Dragging a sizegrip widget resizes the containing toplevel.
+#
+# NOTE: the sizegrip widget must be in the lower right hand corner.
+#
+
+switch -- [tk windowingsystem] {
+ x11 -
+ win32 {
+ option add *TSizegrip.cursor [ttk::cursor seresize]
+ }
+ aqua {
+ # Aqua sizegrips use default Arrow cursor.
+ }
+}
+
+namespace eval ttk::sizegrip {
+ variable State
+ array set State {
+ pressed 0
+ pressX 0
+ pressY 0
+ width 0
+ height 0
+ widthInc 1
+ heightInc 1
+ resizeX 1
+ resizeY 1
+ toplevel {}
+ }
+}
+
+bind TSizegrip <ButtonPress-1> { ttk::sizegrip::Press %W %X %Y }
+bind TSizegrip <B1-Motion> { ttk::sizegrip::Drag %W %X %Y }
+bind TSizegrip <ButtonRelease-1> { ttk::sizegrip::Release %W %X %Y }
+
+proc ttk::sizegrip::Press {W X Y} {
+ variable State
+
+ if {[$W instate disabled]} { return }
+
+ set top [winfo toplevel $W]
+
+ # If the toplevel is not resizable then bail
+ foreach {State(resizeX) State(resizeY)} [wm resizable $top] break
+ if {!$State(resizeX) && !$State(resizeY)} {
+ return
+ }
+
+ # Sanity-checks:
+ # If a negative X or Y position was specified for [wm geometry],
+ # just bail out -- there's no way to handle this cleanly.
+ #
+ if {[scan [wm geometry $top] "%dx%d+%d+%d" width height x y] != 4} {
+ return;
+ }
+
+ # Account for gridded geometry:
+ #
+ set grid [wm grid $top]
+ if {[llength $grid]} {
+ set State(widthInc) [lindex $grid 2]
+ set State(heightInc) [lindex $grid 3]
+ } else {
+ set State(widthInc) [set State(heightInc) 1]
+ }
+
+ set State(toplevel) $top
+ set State(pressX) $X
+ set State(pressY) $Y
+ set State(width) $width
+ set State(height) $height
+ set State(x) $x
+ set State(y) $y
+ set State(pressed) 1
+}
+
+proc ttk::sizegrip::Drag {W X Y} {
+ variable State
+ if {!$State(pressed)} { return }
+ set w $State(width)
+ set h $State(height)
+ if {$State(resizeX)} {
+ set w [expr {$w + ($X - $State(pressX))/$State(widthInc)}]
+ }
+ if {$State(resizeY)} {
+ set h [expr {$h + ($Y - $State(pressY))/$State(heightInc)}]
+ }
+ if {$w <= 0} { set w 1 }
+ if {$h <= 0} { set h 1 }
+ set x $State(x) ; set y $State(y)
+ wm geometry $State(toplevel) ${w}x${h}+${x}+${y}
+}
+
+proc ttk::sizegrip::Release {W X Y} {
+ variable State
+ set State(pressed) 0
+}
+
+#*EOF*