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