sizegrip.tcl 2.3 KB

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