diff options
Diffstat (limited to 'library/demos')
| -rw-r--r-- | library/demos/fontchoose.tcl | 71 | ||||
| -rw-r--r-- | library/demos/widget | 3 |
2 files changed, 73 insertions, 1 deletions
diff --git a/library/demos/fontchoose.tcl b/library/demos/fontchoose.tcl new file mode 100644 index 0000000..3410d12 --- /dev/null +++ b/library/demos/fontchoose.tcl @@ -0,0 +1,71 @@ +# fontchoose.tcl -- +# +# Show off the stock font selector dialog +# +# RCS: @(#) $Id: fontchoose.tcl,v 1.1 2008/12/12 02:02:35 patthoyts Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk + +set w .fontchoice +catch {destroy $w} +toplevel $w +wm title $w "Font Selection Dialog" +wm iconname $w "fontchooser" +positionWindow $w + +catch {font create FontchooseDemoFont {*}[font actual TkDefaultFont]} + +# The font chooser needs to be configured and then shown. +proc SelectFont {parent} { + tk fontchooser configure -font FontchooseDemoFont \ + -command ApplyFont -parent $parent + tk fontchooser show +} + +proc ApplyFont {font} { + font configure FontchooseDemoFont {*}[font actual $font] +} + +# When the visibility of the fontchooser changes, the following event is fired +# to the parent widget. +# +bind $w <<TkFontchooserVisibility>> { + if {[tk fontchooser configure -visible]} { + %W.f.font state disabled + } else { + %W.f.font state !disabled + } +} + + +set f [ttk::frame $w.f -relief sunken -padding 2] + +text $f.msg -font FontchooseDemoFont -width 40 -height 6 -borderwidth 0 \ + -yscrollcommand [list $f.vs set] +ttk::scrollbar $f.vs -command [list $f.msg yview] + +$f.msg insert end "Press the buttons below to choose a new font for the\ + text shown in this window.\n" {} + +ttk::button $f.font -text "Set font ..." -command [list SelectFont $w] + +grid $f.msg $f.vs -sticky news +grid $f.font - -sticky e +grid columnconfigure $f 0 -weight 1 +grid rowconfigure $f 0 -weight 1 +bind $w <Visibility> { + bind %W <Visibility> {} + grid propagate %W.f 0 +} + +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] + +grid $f -sticky news +grid $btns -sticky ew +grid columnconfigure $w 0 -weight 1 +grid rowconfigure $w 0 -weight 1 diff --git a/library/demos/widget b/library/demos/widget index e9e2d51..5c4f722 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -10,7 +10,7 @@ exec wish "$0" "$@" # separate ".tcl" files is this directory, which are sourced by this script as # needed. # -# RCS: @(#) $Id: widget,v 1.52 2008/12/11 18:13:08 jenglish Exp $ +# RCS: @(#) $Id: widget,v 1.53 2008/12/12 02:02:35 patthoyts Exp $ package require Tcl 8.5 package require Tk 8.5 @@ -386,6 +386,7 @@ addFormattedText { @@demo msgbox Message boxes @@demo filebox File selection dialog @@demo clrpick Color picker + @@demo fontchoose Font selection dialog @@subtitle Animation @@new |