toolbar.tcl 3.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192
  1. # toolbar.tcl --
  2. #
  3. # This demonstration script creates a toolbar that can be torn off.
  4. if {![info exists widgetDemo]} {
  5. error "This script should be run from the \"widget\" demo."
  6. }
  7. package require Tk
  8. set w .toolbar
  9. destroy $w
  10. toplevel $w
  11. wm title $w "Toolbar Demonstration"
  12. wm iconname $w "toolbar"
  13. positionWindow $w
  14. ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\
  15. a toolbar that is styled correctly and which can be torn off. The\
  16. buttons are configured to be \u201Ctoolbar style\u201D buttons by\
  17. telling them that they are to use the Toolbutton style. At the left\
  18. end of the toolbar is a simple marker that the cursor changes to a\
  19. movement icon over; drag that away from the toolbar to tear off the\
  20. whole toolbar into a separate toplevel widget. When the dragged-off\
  21. toolbar is no longer needed, just close it like any normal toplevel\
  22. and it will reattach to the window it was torn off from."
  23. ## Set up the toolbar hull
  24. set t [frame $w.toolbar] ;# Must be a frame!
  25. ttk::separator $w.sep
  26. ttk::frame $t.tearoff -cursor fleur
  27. ttk::separator $t.tearoff.to -orient vertical
  28. ttk::separator $t.tearoff.to2 -orient vertical
  29. pack $t.tearoff.to -fill y -expand 1 -padx 4 -side left
  30. pack $t.tearoff.to2 -fill y -expand 1 -side left
  31. ttk::frame $t.contents
  32. grid $t.tearoff $t.contents -sticky nsew
  33. grid columnconfigure $t $t.contents -weight 1
  34. grid columnconfigure $t.contents 1000 -weight 1
  35. ## Bindings so that the toolbar can be torn off and reattached
  36. bind $t.tearoff <B1-Motion> [list tearoff $t %X %Y]
  37. bind $t.tearoff.to <B1-Motion> [list tearoff $t %X %Y]
  38. bind $t.tearoff.to2 <B1-Motion> [list tearoff $t %X %Y]
  39. proc tearoff {w x y} {
  40. if {[string match $w* [winfo containing $x $y]]} {
  41. return
  42. }
  43. grid remove $w
  44. grid remove $w.tearoff
  45. wm manage $w
  46. wm protocol $w WM_DELETE_WINDOW [list untearoff $w]
  47. }
  48. proc untearoff {w} {
  49. wm forget $w
  50. grid $w.tearoff
  51. grid $w
  52. }
  53. ## Toolbar contents
  54. ttk::button $t.button -text "Button" -style Toolbutton -command [list \
  55. $w.txt insert end "Button Pressed\n"]
  56. ttk::checkbutton $t.check -text "Check" -variable check -style Toolbutton \
  57. -command [concat [list $w.txt insert end] {"check is $check\n"}]
  58. ttk::menubutton $t.menu -text "Menu" -menu $t.menu.m
  59. ttk::combobox $t.combo -value [lsort [font families]] -state readonly
  60. menu $t.menu.m
  61. $t.menu.m add command -label "Just" -command [list $w.txt insert end Just\n]
  62. $t.menu.m add command -label "An" -command [list $w.txt insert end An\n]
  63. $t.menu.m add command -label "Example" \
  64. -command [list $w.txt insert end Example\n]
  65. bind $t.combo <<ComboboxSelected>> [list changeFont $w.txt $t.combo]
  66. proc changeFont {txt combo} {
  67. $txt configure -font [list [$combo get] 10]
  68. }
  69. ## Some content for the rest of the toplevel
  70. text $w.txt -width 40 -height 10
  71. interp alias {} doInsert {} $w.txt insert end ;# Make bindings easy to write
  72. ## Arrange contents
  73. grid $t.button $t.check $t.menu $t.combo -in $t.contents -padx 2 -pady 4 -sticky ns
  74. grid $t -sticky ew
  75. grid $w.sep -sticky ew
  76. grid $w.msg -sticky ew
  77. grid $w.txt -sticky nsew
  78. grid rowconfigure $w $w.txt -weight 1
  79. grid columnconfigure $w $w.txt -weight 1
  80. ## See Code / Dismiss buttons
  81. set btns [addSeeDismiss $w.buttons $w]
  82. grid $btns -sticky ew