summaryrefslogtreecommitdiffstats
path: root/library/demos/fontchoose.tcl
blob: 8b34377e894d093fdd08a3f08027ee417cad4de8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
# fontchoose.tcl --
#
# Show off the stock font selector dialog

if {![info exists widgetDemo]} {
    error "This script should be run from the \"widget\" demo."
}

package require Tk

set w .fontchoose
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