diff options
Diffstat (limited to 'library/demos/toolbar.tcl')
| -rw-r--r-- | library/demos/toolbar.tcl | 95 |
1 files changed, 95 insertions, 0 deletions
diff --git a/library/demos/toolbar.tcl b/library/demos/toolbar.tcl new file mode 100644 index 0000000..0f25ce9 --- /dev/null +++ b/library/demos/toolbar.tcl @@ -0,0 +1,95 @@ +# toolbar.tcl -- +# +# This demonstration script creates a toolbar that can be torn off. +# +# RCS: @(#) $Id: toolbar.tcl,v 1.1 2007/10/22 14:21:10 dkf Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk +package require Ttk + +set w .toolbar +destroy $w +toplevel $w +wm title $w "Toolbar Demonstration" +wm iconname $w "toolbar" +positionWindow $w + +ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\ + a toolbar that is styled correctly and which can be torn off. The\ + buttons are configured to be \u201Ctoolbar style\u201D buttons by\ + telling them that they are to use the Toolbutton style. At the left\ + end of the toolbar is a simple marker that the cursor changes to a\ + movement icon over; drag that away from the toolbar to tear off the\ + whole toolbar into a separate toplevel widget. When the dragged-off\ + toolbar is no longer needed, just close it like any normal toplevel\ + and it will reattach to the window it was torn off from." + +## Set up the toolbar hull +set t [frame $w.toolbar] ;# Must be a frame! +ttk::separator $w.sep +ttk::frame $t.tearoff -cursor fleur +ttk::separator $t.tearoff.to -orient vertical +ttk::separator $t.tearoff.to2 -orient vertical +ttk::frame $t.contents +pack $t.tearoff.to -fill y -expand 1 -padx 2 -side left +pack $t.tearoff.to2 -fill y -expand 1 -side left +grid $t.tearoff $t.contents -sticky nsew +grid columnconfigure $t $t.contents -weight 1 +grid columnconfigure $t.contents 1000 -weight 1 + +## Bindings so that the toolbar can be torn off and reattached +bind $t.tearoff <B1-Motion> [list tearoff $t %X %Y] +bind $t.tearoff.to <B1-Motion> [list tearoff $t %X %Y] +bind $t.tearoff.to2 <B1-Motion> [list tearoff $t %X %Y] +proc tearoff {w x y} { + if {[string match $w* [winfo containing $x $y]]} { + return + } + grid remove $w + grid remove $w.tearoff + wm manage $w + wm protocol $w WM_DELETE_WINDOW [list untearoff $w] +} +proc untearoff {w} { + wm forget $w + grid $w.tearoff + grid $w +} + +## Toolbar contents +ttk::button $t.button -text "Button" -style Toolbutton -command [list \ + $w.txt insert end "Button Pressed\n"] +ttk::checkbutton $t.check -text "Check" -variable check -style Toolbutton \ + -command [concat [list $w.txt insert end] {"check is $check\n"}] +ttk::menubutton $t.menu -text "Menu" -menu $t.menu.m +ttk::combobox $t.combo -value [lsort [font families]] -state readonly +menu $t.menu.m +$t.menu.m add command -label "Just" -command [list $w.txt insert end Just\n] +$t.menu.m add command -label "An" -command [list $w.txt insert end An\n] +$t.menu.m add command -label "Example" \ + -command [list $w.txt insert end Example\n] +bind $t.combo <<ComboboxSelected>> [list changeFont $w.txt $t.combo] +proc changeFont {txt combo} { + $txt configure -font [list [$combo get] 10] +} + +## Some content for the rest of the toplevel +text $w.txt -width 40 -height 10 +interp alias {} doInsert {} $w.txt insert end ;# Make bindings easy to write + +## Arrange contents +grid $t.button $t.check $t.menu $t.combo -in $t.contents -padx 2 -sticky ns +grid $t -sticky ew +grid $w.sep -sticky ew +grid $w.msg -sticky ew +grid $w.txt -sticky nsew +grid rowconfigure $w $w.txt -weight 1 +grid columnconfigure $w $w.txt -weight 1 + +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] +grid $btns -sticky ew |