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
|
#! /usr/bin/env tclsh
#==============================================================================
# Demonstrates the use of the Scrollutil package in connection with the
# iwidgets::scrolledframe widget.
#
# Copyright (c) 2019-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================
package require Tk
if {[catch {package require iwidgets} result1] != 0 &&
[catch {package require Iwidgets} result2] != 0} {
error "$result1; $result2"
}
set dir [file dirname [info script]]
source [file join $dir scrolledwidgetPatch.itk] ;# adds ttk::scrollbar widgets
package require scrollutil_tile
source [file join $dir styleUtil.tcl]
wm title . "European Capitals Quiz"
set bg [ttk::style lookup TFrame -background]
set currentTheme [styleutil::getCurrentTheme]
if {$currentTheme eq "aqua" &&
[package vcompare $tk_patchLevel "8.6.10"] < 0} {
set bg #ececec ;# workaround for a tile bug
}
#
# Create a scrolledframe
#
set f [ttk::frame .f]
set sf [iwidgets::scrolledframe $f.sf -borderwidth 1 -relief sunken \
-scrollmargin 0]
set canvas [$sf component canvas]
$canvas configure -background $bg
#
# Create mouse wheel event bindings for the binding tag "all" and
# register the scrolledframe for scrolling by these bindings
#
scrollutil::createWheelEventBindings all
scrollutil::enableScrollingByWheel $sf
#
# Get the content frame and populate it
#
set cf [$sf childsite]
$cf configure -background $bg
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
#
# 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
incr row
}
#
# Create a ttk::button widget outside the scrolledframe
#
set b [ttk::button $f.b -text "Close" -command exit]
pack $b -side bottom -pady {0 7p}
pack $sf -side top -expand yes -fill both -padx 7p -pady 7p
pack $f -expand yes -fill both
#
# Set the scrolledframe'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 vsb [$sf component vertsb]
set width [expr {[winfo reqwidth $cf] + [winfo reqwidth $vsb] + 2}]
set rowHeight [expr {[winfo reqheight $cf] / $row}]
set height [expr {10*$rowHeight + [winfo pixels . $topPadY] + 2}]
$sf configure -width $width -height $height
set canvas [$sf component canvas]
$canvas configure -yscrollincrement $rowHeight
after 100 [list $sf configure -hscrollmode dynamic]
}
|