Skip to content

Commit 5f1743a

Browse files
author
csaba
committed
* Added scrollutil to tklib.
1 parent a300063 commit 5f1743a

28 files changed

+6779
-0
lines changed

‎examples/scrollutil/ScrollableFrmContent.tcl‎

Lines changed: 490 additions & 0 deletions
Large diffs are not rendered by default.

‎examples/scrollutil/ScrollableFrmDemo1.tcl‎

Lines changed: 131 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,131 @@
1+
#!/usr/bin/env wish
2+
3+
#==============================================================================
4+
# Demonstrates the use of the Scrollutil package in connection with the BWidget
5+
# ScrollableFrame widget.
6+
#
7+
# Copyright (c) 2019 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
8+
#==============================================================================
9+
10+
package require Tk 8.5
11+
package require BWidget
12+
Widget::theme yes
13+
package require scrollutil_tile
14+
15+
wm title . "European Capitals Quiz"
16+
17+
#
18+
# Create a ScrollableFrame within a scrollarea
19+
#
20+
set f [ttk::frame .f]
21+
set sa [scrollutil::scrollarea $f.sa]
22+
set sf [ScrollableFrame $sa.sf]
23+
$sa setwidget $sf
24+
25+
#
26+
# Work around a tile bug which is not handled in
27+
# the BWidget procedure ScrollableFrame::create
28+
#
29+
if {$ttk::currentTheme eq "aqua"} {
30+
$sf:cmd configure -background #ececec
31+
}
32+
33+
#
34+
# Create mouse wheel event bindings for the binding tag "all" and
35+
# register the ScrollableFrame for scrolling by these bindings
36+
#
37+
scrollutil::createWheelEventBindings all
38+
scrollutil::enableScrollingByWheel $sf
39+
40+
#
41+
# Get the content frame and populate it
42+
#
43+
44+
set cf [$sf getframe]
45+
46+
set countryList {
47+
Albania Andorra Austria Belarus Belgium "Bosnia and Herzegovina" Bulgaria
48+
Croatia Cyprus "Czech Republic" Denmark Estonia Finland France Germany
49+
Greece Hungary Iceland Ireland Italy Kosovo Latvia Liechtenstein Lithuania
50+
Luxembourg Macedonia Malta Moldova Monaco Montenegro Netherlands Norway
51+
Poland Portugal Romania Russia "San Marino" Serbia Slovakia Slovenia
52+
Spain Sweden Switzerland Ukraine "United Kingdom" "Vatican City"
53+
}
54+
set capitalList {
55+
Tirana "Andorra la Vella" Vienna Minsk Brussels Sarajevo Sofia
56+
Zagreb Nicosia Prague Copenhagen Tallinn Helsinki Paris Berlin
57+
Athens Budapest Reykjavik Dublin Rome Pristina Riga Vaduz Vilnius
58+
Luxembourg Skopje Valletta Chisinau Monaco Podgorica Amsterdam Oslo
59+
Warsaw Lisbon Bucharest Moscow "San Marino" Belgrade Bratislava Ljubljana
60+
Madrid Stockholm Bern Kiev London "Vatican City"
61+
}
62+
63+
foreach country $countryList capital $capitalList {
64+
set capitalArr($country) $capital
65+
}
66+
67+
set capitalList [lsort $capitalList]
68+
69+
ttk::style map TCombobox -fieldbackground {readonly white}
70+
set btnStyle [expr {$::ttk::currentTheme eq "aqua" ? "TButton" : "Toolbutton"}]
71+
72+
set row 0
73+
foreach country $countryList {
74+
set w [ttk::label $cf.l$row -text $country]
75+
grid $w -row $row -column 0 -sticky w -padx {5 0} -pady {4 0}
76+
77+
set w [ttk::combobox $cf.cb$row -state readonly -width 14 \
78+
-values $capitalList]
79+
bind $w <<ComboboxSelected>> [list checkCapital %W $country]
80+
grid $w -row $row -column 1 -sticky w -padx {5 0} -pady {4 0}
81+
82+
#
83+
# Adapt the handling of the mouse wheel events for the ttk::combobox widget
84+
#
85+
scrollutil::adaptWheelEventHandling $w
86+
87+
set b [ttk::button $cf.b$row -style $btnStyle -text "Resolve" \
88+
-command [list setCapital $w $country]]
89+
grid $b -row $row -column 2 -sticky w -padx 5 -pady {4 0}
90+
91+
incr row
92+
}
93+
94+
#
95+
# Set the ScrollableFrame's width, height, and yscrollincrement
96+
#
97+
update idletasks
98+
set rowHeight [expr {[winfo reqheight $cf] / $row}]
99+
$sf configure -width [winfo reqwidth $cf] \
100+
-height [expr {10*$rowHeight + 5}] -yscrollincrement $rowHeight
101+
102+
#
103+
# Create a ttk::button widget outside the scrollarea
104+
#
105+
set b [ttk::button $f.b -text "Close" -command exit]
106+
107+
pack $b -side bottom -pady {0 10}
108+
pack $sa -side top -expand yes -fill both -padx 10 -pady 10
109+
pack $f -expand yes -fill both
110+
111+
#------------------------------------------------------------------------------
112+
113+
proc checkCapital {w country} {
114+
$w selection clear
115+
global capitalArr
116+
if {[$w get] eq $capitalArr($country)} {
117+
$w configure -foreground ""
118+
} else {
119+
bell
120+
$w configure -foreground red
121+
}
122+
}
123+
124+
#------------------------------------------------------------------------------
125+
126+
proc setCapital {w country} {
127+
$w selection clear
128+
$w configure -foreground ""
129+
global capitalArr
130+
$w set $capitalArr($country)
131+
}

‎examples/scrollutil/ScrollableFrmDemo2.tcl‎

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
#!/usr/bin/env wish
2+
3+
#==============================================================================
4+
# Demonstrates the use of the Scrollutil package in connection with the BWidget
5+
# ScrollableFrame widget.
6+
#
7+
# Copyright (c) 2019 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
8+
#==============================================================================
9+
10+
package require Tk 8.5.9 ;# for ttk::spinbox
11+
package require BWidget
12+
Widget::theme yes
13+
package require mentry_tile 3.2 ;# for mouse wheel support
14+
package require tablelist_tile 6.5 ;# for -(x|y)mousewheelwindow
15+
;# and scrollutil::scrollarea
16+
package require scrollutil_tile
17+
18+
wm title . "Scrollutil Demo"
19+
20+
#
21+
# Create a ScrollableFrame within a scrollarea
22+
#
23+
set tf [ttk::frame .tf]
24+
set sa [scrollutil::scrollarea $tf.sa]
25+
set sf [ScrollableFrame $sa.sf]
26+
$sa setwidget $sf
27+
28+
#
29+
# Work around a tile bug which is not handled in
30+
# the BWidget procedure ScrollableFrame::create
31+
#
32+
if {$ttk::currentTheme eq "aqua"} {
33+
$sf:cmd configure -background #ececec
34+
}
35+
36+
#
37+
# Get the content frame and populate it
38+
#
39+
set cf [$sf getframe]
40+
source ScrollableFrmContent.tcl
41+
42+
#
43+
# Additional stuff related to the mouse wheel events:
44+
#
45+
46+
#
47+
# Create mouse wheel event bindings for the binding tag "all" and
48+
# register the ScrollableFrame for scrolling by these bindings
49+
#
50+
scrollutil::createWheelEventBindings all
51+
scrollutil::enableScrollingByWheel $sf
52+
53+
#
54+
# Adapt the handling of the mouse wheel events for the text, listbox,
55+
# ttk::combobox, ttk::spinbox, tablelist, and ttk::treeview widgets, as
56+
# well as for the entry components of the mentry widget of type "Date"
57+
#
58+
set entryList [$me entries]
59+
scrollutil::adaptWheelEventHandling $txt $lb $cb $sb $tbl $tv {*}$entryList
60+
61+
#
62+
# For the entry components of the mentry widget
63+
# set the "focus check window" to the mentry
64+
#
65+
scrollutil::setFocusCheckWindow {*}$entryList $me

0 commit comments

Comments
 (0)