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
|
# cscroll.pl
use subs qw/cscroll_button cscroll_enter cscroll_leave/;
use vars qw/$TOP/;
sub cscroll {
# Create a top-level window containing a simple canvas that can be
# scrolled in two dimensions.
my($demo) = @_;
$TOP = $MW->WidgetDemo(
-name => $demo,
-text => 'This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout.',
-title => 'Scrollable Canvas Demonstration',
-iconname => 'cscroll',
);
my $c = $TOP->Scrolled(qw/Canvas -relief sunken -borderwidth 2
-scrollbars se -scrollregion/ => ['-10c', '-10c', '50c', '20c']);
$c->pack(qw/-expand yes -fill both/);
my($bg, $i, $j, $x, $y) = ($c->configure(-background))[4];
for ($i = 0; $i < 20; $i++) {
$x = -10 + 3 * $i;
$j = 0;
$y = -10;
while ($j < 10) {
$c->createRectangle("${x}c", "${y}c",
($x+2).'c', ($y+2).'c',
-outline => 'black', -fill => $bg, -tags => 'rect');
$c->createText(($x+1).'c', ($y+1).'c',
-text => "$i,$j", -anchor => 'center', -tags => 'text');
$j++;
$y += 3;
} # whilend
} # forend
my $old_fill = '';
$c->bind('all', '<Any-Enter>' => [\&cscroll_enter, \$old_fill]);
$c->bind('all', '<Any-Leave>' => [\&cscroll_leave, \$old_fill]);
$c->bind('all', '<1>' => \&cscroll_button);
$c->CanvasBind('<2>' => [ scanMark => Ev('x'), Ev('y') ]);
$c->CanvasBind('<B2-Motion>' => [ scanDragto => Ev('x'), Ev('y') ]);
} # end cscroll
sub cscroll_button {
my($c) = @_;
my ($id) = $c->find(qw/withtag current/);
$id++ if ($c->gettags('current'))[0] ne 'text';
print STDOUT 'You buttoned at ', ($c->itemconfigure($id, -text))[4], "\n";
} # end cscroll_button
sub cscroll_enter {
my($c, $old_fill) = @_;
my ($id) = $c->find(qw/withtag current/);
$id-- if ($c->gettags('current'))[0] eq 'text';
$$old_fill = ($c->itemconfigure($id, -fill))[4];
if ($c->depth > 1) {
$c->itemconfigure($id, -fill => 'SeaGreen1');
} else {
$c->itemconfigure($id, -fill => 'black');
$c->itemconfigure($id+1, -fill => 'white');
}
} # end cscroll_enter
sub cscroll_leave {
my($c, $old_fill) = @_;
my ($id) = $c->find(qw/withtag current/);
$id-- if ($c->gettags('current'))[0] eq 'text';
$c->itemconfigure($id, -fill => $$old_fill);
$c->itemconfigure($id+1, -fill => 'black');
} # end cscroll_leave
1;
|