"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tk8.6/demos/toolbar.tcl" (17 Mar 2020, 3272 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

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