mingw/lib/tk8.5/demos/toolbar.tcl

   1 # toolbar.tcl --
   2 #
   3 # This demonstration script creates a toolbar that can be torn off.
   4 #
   5 # RCS: @(#) $Id: toolbar.tcl,v 1.3 2007/12/13 15:27:07 dgp Exp $
   6
   7 if {![info exists widgetDemo]} {
   8     error "This script should be run from the \"widget\" demo."
   9 }
  10
  11 package require Tk
  12 package require Ttk
  13
  14 set w .toolbar
  15 destroy $w
  16 toplevel $w
  17 wm title $w "Toolbar Demonstration"
  18 wm iconname $w "toolbar"
  19 positionWindow $w
  20
  21 if {[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 {
  32 ttk::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
  39 set t [frame $w.toolbar]                ;# Must be a frame!
  40 ttk::separator $w.sep
  41 ttk::frame $t.tearoff -cursor fleur
  42 if {[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 }
  48 ttk::frame $t.contents
  49 grid $t.tearoff $t.contents -sticky nsew
  50 grid columnconfigure $t $t.contents -weight 1
  51 grid columnconfigure $t.contents 1000 -weight 1
  52
  53 if {[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
  75 ttk::button $t.button -text "Button" -style Toolbutton -command [list \
  76         $w.txt insert end "Button Pressed\n"]
  77 ttk::checkbutton $t.check -text "Check" -variable check -style Toolbutton \
  78         -command [concat [list $w.txt insert end] {"check is $check\n"}]
  79 ttk::menubutton $t.menu -text "Menu" -menu $t.menu.m
  80 ttk::combobox $t.combo -value [lsort [font families]] -state readonly
  81 menu $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]
  86 bind $t.combo <<ComboboxSelected>> [list changeFont $w.txt $t.combo]
  87 proc changeFont {txt combo} {
  88     $txt configure -font [list [$combo get] 10]
  89 }
  90
  91 ## Some content for the rest of the toplevel
  92 text $w.txt -width 40 -height 10
  93 interp alias {} doInsert {} $w.txt insert end   ;# Make bindings easy to write
  94
  95 ## Arrange contents
  96 grid $t.button $t.check $t.menu $t.combo -in $t.contents -padx 2 -sticky ns
  97 grid $t -sticky ew
  98 grid $w.sep -sticky ew
  99 grid $w.msg -sticky ew
 100 grid $w.txt -sticky nsew
 101 grid rowconfigure $w $w.txt -weight 1
 102 grid columnconfigure $w $w.txt -weight 1
 103
 104 ## See Code / Dismiss buttons
 105 set btns [addSeeDismiss $w.buttons $w]
 106 grid $btns -sticky ew