| 1 | |
| 2 | |
| 3 | sub scroll_enter { |
| 4 | |
| 5 | my($c) = @_; |
| 6 | |
| 7 | my $id = $c->find('withtag', 'current'); |
| 8 | $id-- if ($c->gettags('current'))[0] eq 'text'; |
| 9 | $mkScroll::old_fill = ($c->itemconfigure($id, -fill))[4]; |
| 10 | if ($mkScroll->depth > 1) { |
| 11 | $c->itemconfigure($id, -fill => 'SeaGreen1'); |
| 12 | } else { |
| 13 | $c->itemconfigure($id, -fill => 'black'); |
| 14 | $c->itemconfigure($id+1, -fill => 'white'); |
| 15 | } |
| 16 | |
| 17 | } # end scroll_enter |
| 18 | |
| 19 | |
| 20 | sub scroll_leave { |
| 21 | |
| 22 | my($c) = @_; |
| 23 | |
| 24 | my $id = $c->find('withtag', 'current'); |
| 25 | $id-- if ($c->gettags('current'))[0] eq 'text'; |
| 26 | $c->itemconfigure($id, -fill => $mkScroll::old_fill); |
| 27 | $c->itemconfigure($id+1, -fill => 'black'); |
| 28 | |
| 29 | } # end scroll_leave |
| 30 | |
| 31 | |
| 32 | sub scroll_button { |
| 33 | |
| 34 | my($c) = @_; |
| 35 | |
| 36 | my $id = $c->find('withtag', 'current'); |
| 37 | $id++ if ($c->gettags('current'))[0] ne 'text'; |
| 38 | print STDOUT 'You buttoned at ', ($c->itemconfigure($id, -text))[4], "\n"; |
| 39 | |
| 40 | } # end scroll_button |
| 41 | |
| 42 | sub mkScroll { |
| 43 | |
| 44 | # Create a top-level window containing a simple canvas that can be scrolled in two dimensions. |
| 45 | |
| 46 | $mkScroll->destroy if Exists($mkScroll); |
| 47 | $mkScroll = $top->Toplevel(); |
| 48 | my $w = $mkScroll; |
| 49 | dpos $w; |
| 50 | $w->title('Scrollable Canvas Demonstration'); |
| 51 | $w->iconname('Canvas'); |
| 52 | $w->minsize(100, 100); |
| 53 | |
| 54 | my $w_msg = $w->Label(-font => '-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*', -wraplength => '4i', |
| 55 | -justify => 'left', -text => 'This window displays a canvas widget that can be scrolled either ' . |
| 56 | 'using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one ' . |
| 57 | 'of the rectangles, its indices will be printed on stdout.'); |
| 58 | my $w_frame = $w->Frame(); |
| 59 | my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]); |
| 60 | $w_msg->pack(-side => 'top', -fill => 'x'); |
| 61 | $w_ok->pack(-side => 'bottom', -pady => '5'); |
| 62 | $w_frame->pack(-side => 'top', -expand => 'yes', -fill => 'both'); |
| 63 | |
| 64 | my $c = $w_frame->Canvas(-relief => 'sunken', -bd => 2, -scrollregion => ['-10c', '-10c', '50c', '20c']); |
| 65 | my $w_frame_vscroll = $w_frame->Scrollbar(-command => ['yview', $c]); |
| 66 | my $w_frame_hscroll = $w_frame->Scrollbar(-command => ['xview', $c], -orient => 'horiz'); |
| 67 | $c->configure(-xscrollcommand => ['set', $w_frame_hscroll], -yscrollcommand => ['set', $w_frame_vscroll]); |
| 68 | $w_frame_vscroll->pack(-side => 'right', -fill => 'y'); |
| 69 | $w_frame_hscroll->pack(-side => 'bottom', -fill => 'x'); |
| 70 | $c->pack(-expand => 'yes', -fill => 'both'); |
| 71 | |
| 72 | my($bg, $i, $j, $x, $y) = ($c->configure(-background))[4]; |
| 73 | for ($i = 0; $i < 20; $i++) { |
| 74 | $x = -10 + 3 * $i; |
| 75 | $j = 0; |
| 76 | $y = -10; |
| 77 | while ($j < 10) { |
| 78 | $c->create('rectangle', sprintf("%dc", $x), sprintf("%dc", $y), sprintf("%dc", $x+2), sprintf("%dc", $y+2), |
| 79 | -outline => 'black', -fill => $bg, -tags => 'rect'); |
| 80 | $c->create('text', sprintf("%dc", $x+1), sprintf("%dc", $y+1), -text => "$i,$j", -anchor => 'center', |
| 81 | -tags => 'text'); |
| 82 | $j++; |
| 83 | $y += 3; |
| 84 | } # whilend |
| 85 | } # forend |
| 86 | |
| 87 | $c->bind('all', '<Any-Enter>' => sub {scroll_enter(@_)}); |
| 88 | $c->bind('all', '<Any-Leave>' => sub {scroll_leave(@_)}); |
| 89 | $c->bind('all', '<1>' => sub {scroll_button(@_)}); |
| 90 | $c->Tk::bind('<2>' => sub { |
| 91 | my ($c) = @_; |
| 92 | my $e = $c->XEvent; |
| 93 | $c->scan('mark', $e->x, $e->y); |
| 94 | }); |
| 95 | $c->Tk::bind('<B2-Motion>' => sub { |
| 96 | my ($c) = @_; |
| 97 | my $e = $c->XEvent; |
| 98 | $c->scan('dragto', $e->x, $e->y); |
| 99 | }); |
| 100 | |
| 101 | } # end MkScroll |
| 102 | |
| 103 | 1; |