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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
#! /usr/bin/env tclsh
#==============================================================================
# Demonstrates the use of the Scrollutil package in connection with the BWidget
# ScrollableFrame widget.
#
# Copyright (c) 2019-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================
package require Tk
package require BWidget
Widget::theme yes
package require scrollutil_tile
set dir [file dirname [info script]]
source [file join $dir styleUtil.tcl]
wm title . "European Capitals Quiz"
#
# Create a ScrollableFrame within a scrollarea
#
set f [ttk::frame .f]
set sa [scrollutil::scrollarea $f.sa]
set sf [ScrollableFrame $sa.sf]
$sa setwidget $sf
#
# Work around a tile bug which is not handled in
# the BWidget procedure ScrollableFrame::create
#
set currentTheme [styleutil::getCurrentTheme]
if {$currentTheme eq "aqua" &&
[package vcompare $tk_patchLevel "8.6.10"] < 0} {
$sf:cmd configure -background #ececec
}
#
# Create mouse wheel event bindings for the binding tag "all" and
# register the ScrollableFrame for scrolling by these bindings
#
scrollutil::createWheelEventBindings all
scrollutil::enableScrollingByWheel $sf
#
# Get the content frame and populate it
#
set cf [$sf getframe]
set countryList {
Albania Andorra Austria Belarus Belgium "Bosnia and Herzegovina" Bulgaria
Croatia Cyprus "Czech Republic" Denmark Estonia Finland France Germany
Greece Hungary Iceland Ireland Italy Kosovo Latvia Liechtenstein Lithuania
Luxembourg Macedonia Malta Moldova Monaco Montenegro Netherlands Norway
Poland Portugal Romania Russia "San Marino" Serbia Slovakia Slovenia
Spain Sweden Switzerland Ukraine "United Kingdom" "Vatican City"
}
set capitalList {
Tirana "Andorra la Vella" Vienna Minsk Brussels Sarajevo Sofia
Zagreb Nicosia Prague Copenhagen Tallinn Helsinki Paris Berlin
Athens Budapest Reykjavik Dublin Rome Pristina Riga Vaduz Vilnius
Luxembourg Skopje Valletta Chisinau Monaco Podgorica Amsterdam Oslo
Warsaw Lisbon Bucharest Moscow "San Marino" Belgrade Bratislava Ljubljana
Madrid Stockholm Bern Kiev London "Vatican City"
}
foreach country $countryList capital $capitalList {
set capitalArr($country) $capital
}
set capitalList [lsort $capitalList]
if {[lsearch -exact {aqua vista xpnative} $currentTheme] >= 0} {
set topPadY 1.5p
} else {
set topPadY 3p
}
set padY [list $topPadY 0]
set row 0
foreach country $countryList {
set w [ttk::label $cf.l$row -text $country]
grid $w -row $row -column 0 -sticky w -padx {3p 0} -pady $padY
set w [ttk::combobox $cf.cb$row -state readonly -width 14 \
-values $capitalList]
bind $w <<ComboboxSelected>> [list checkCapital %W $country]
grid $w -row $row -column 1 -sticky w -padx {3p 0} -pady $padY
#
# Make the keyboard navigation more user-friendly
#
bind $w <<TraverseIn>> [list $sf see %W]
#
# Adapt the handling of the mouse wheel events for the ttk::combobox widget
#
scrollutil::adaptWheelEventHandling $w
set b [styleutil::createToolbutton $cf.b$row -text "Resolve" \
-command [list setCapital $w $country]]
grid $b -row $row -column 2 -sticky w -padx 3p -pady $padY
#
# Make the keyboard navigation more user-friendly
#
bind $b <<TraverseIn>> [list $sf see %W]
incr row
}
#
# Create a ttk::button widget outside the scrollarea
#
set b [ttk::button $f.b -text "Close" -command exit]
pack $b -side bottom -pady {0 7p}
pack $sa -side top -expand yes -fill both -padx 7p -pady 7p
pack $f -expand yes -fill both
#
# Set the ScrollableFrame's width, height, and yscrollincrement
#
after 50 [list configSf $sf $cf $row $topPadY]
#------------------------------------------------------------------------------
proc checkCapital {w country} {
$w selection clear
global capitalArr
if {[$w get] eq $capitalArr($country)} {
$w configure -foreground ""
} else {
bell
$w configure -foreground red
}
}
#------------------------------------------------------------------------------
proc setCapital {w country} {
$w selection clear
$w configure -foreground ""
global capitalArr
$w set $capitalArr($country)
}
#------------------------------------------------------------------------------
proc configSf {sf cf row topPadY} {
set width [winfo reqwidth $cf]
set rowHeight [expr {[winfo reqheight $cf] / $row}]
set height [expr {10*$rowHeight + [winfo pixels . $topPadY]}]
$sf configure -width $width -height $height -yscrollincrement $rowHeight
}
|
