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
|
#! /usr/bin/env tclsh
#==============================================================================
# Demonstrates the use of the scrollutil::scrollarea widget and of the
# scrollutil::addMouseWheelSupport command in connection with a canvas widget.
#
# Copyright (c) 2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================
package require Tk
package require scrollutil_tile
set dir [file dirname [info script]]
source [file join $dir styleUtil.tcl]
wm title . "Scrolled Canvas"
set scaleFactor [expr {$scaleutil::scalingPct / 100.0}]
set width [expr {10 * 32 * $scaleFactor}]
set height [expr { 7 * 32 * $scaleFactor}]
set scrlIncr [expr {16 * $scaleFactor}]
#
# Create a canvas widget within a scrollarea
#
set f [ttk::frame .f]
set sa [scrollutil::scrollarea $f.sa]
set c [canvas $sa.c -background white -width $width -height $height \
-xscrollincrement $scrlIncr -yscrollincrement $scrlIncr]
bind $c <Configure> { setScrollRegion %W %w %h }
scrollutil::addMouseWheelSupport $c
$sa setwidget $c
#
# Populate the canvas and then rescale the coordinates
# of all of the items by a factor of $scaleFactor
#
for {set col 0; set x 32} {$col < 20} {incr col; incr x 96} {
for {set row 0; set y 32} {$row < 20} {incr row; incr y 96} {
$c create rectangle $x $y [expr {$x+63}] [expr {$y+63}] -fill gray95
$c create text [expr {$x+32}] [expr {$y+32}] -text "Box\n$row,$col" \
-anchor center -justify center
}
}
$c scale all 0 0 $scaleFactor $scaleFactor
proc setScrollRegion {canv width height} {
set pixels [expr {(20*96 + 32) * $::scaleFactor}]
set rightX $pixels
set lowerY $pixels
if {$rightX < $width} { set rightX $width }
if {$lowerY < $height} { set lowerY $height }
$canv configure -scrollregion [list 0 0 $rightX $lowerY]
}
#
# Variables used in the scan-related binding scripts below:
#
set origCursor [$c cget -cursor]
set scanCursor \
[expr {[tk windowingsystem] eq "aqua" ? "pointinghand" : "hand2"}]
bind $c <Button-1> { %W scan mark %x %y; %W configure -cursor $scanCursor }
bind $c <B1-Motion> { %W scan dragto %x %y }
bind $c <ButtonRelease-1> { %W configure -cursor $origCursor }
#
# 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}
#
# Manage the scrollarea
#
pack $sa -expand yes -fill both -padx 7p -pady 7p
pack $f -expand yes -fill both
|
