home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _cc35ee55e73f246b06549fa0a14b50b1 < prev    next >
Encoding:
Text File  |  2004-06-01  |  2.6 KB  |  87 lines
  1. # cscroll.pl
  2.  
  3. use subs qw/cscroll_button cscroll_enter cscroll_leave/;
  4. use vars qw/$TOP/;
  5.  
  6. sub cscroll {
  7.  
  8.     # Create a top-level window containing a simple canvas that can be
  9.     # scrolled in two dimensions.
  10.  
  11.     my($demo) = @_;
  12.     $TOP = $MW->WidgetDemo(
  13.         -name     => $demo,
  14.         -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.',
  15.         -title    => 'Scrollable Canvas Demonstration',
  16.         -iconname => 'cscroll',
  17.     );
  18.  
  19.     my $c = $TOP->Scrolled(qw/Canvas -relief sunken -borderwidth 2
  20.         -scrollbars se -scrollregion/ => ['-10c', '-10c', '50c', '20c']);
  21.     $c->pack(qw/-expand yes -fill both/);
  22.  
  23.     my($bg, $i, $j, $x, $y) = ($c->configure(-background))[4];
  24.     for ($i = 0; $i < 20; $i++) {
  25.     $x = -10 + 3 * $i;
  26.     $j = 0;
  27.     $y = -10;
  28.     while ($j < 10) {
  29.         $c->createRectangle("${x}c", "${y}c",
  30.                ($x+2).'c', ($y+2).'c',
  31.                -outline => 'black', -fill => $bg, -tags => 'rect');
  32.         $c->createText(($x+1).'c', ($y+1).'c',
  33.                -text => "$i,$j", -anchor => 'center', -tags => 'text');
  34.         $j++;
  35.         $y += 3;
  36.     } # whilend
  37.     } # forend
  38.  
  39.     my $old_fill = '';
  40.     $c->bind('all', '<Any-Enter>' => [\&cscroll_enter, \$old_fill]);
  41.     $c->bind('all', '<Any-Leave>' => [\&cscroll_leave, \$old_fill]);
  42.     $c->bind('all', '<1>' => \&cscroll_button);
  43.  
  44.     $c->CanvasBind('<2>' => [ scanMark => Ev('x'), Ev('y') ]);
  45.     $c->CanvasBind('<B2-Motion>' => [ scanDragto => Ev('x'), Ev('y') ]);
  46.  
  47. } # end cscroll
  48.  
  49. sub cscroll_button {
  50.  
  51.     my($c) = @_;
  52.  
  53.     my ($id) = $c->find(qw/withtag current/);
  54.     $id++ if ($c->gettags('current'))[0] ne 'text';
  55.     print STDOUT 'You buttoned at ', ($c->itemconfigure($id, -text))[4], "\n";
  56.  
  57. } # end cscroll_button
  58.  
  59. sub cscroll_enter {
  60.  
  61.     my($c, $old_fill) = @_;
  62.  
  63.     my ($id) = $c->find(qw/withtag current/);
  64.     $id-- if ($c->gettags('current'))[0] eq 'text';
  65.     $$old_fill = ($c->itemconfigure($id, -fill))[4];
  66.     if ($c->depth > 1) {
  67.     $c->itemconfigure($id, -fill => 'SeaGreen1');
  68.     } else {
  69.     $c->itemconfigure($id, -fill => 'black');
  70.     $c->itemconfigure($id+1, -fill => 'white');
  71.     }
  72.  
  73. } # end cscroll_enter
  74.  
  75. sub cscroll_leave {
  76.  
  77.     my($c, $old_fill) = @_;
  78.  
  79.     my ($id) = $c->find(qw/withtag current/);
  80.     $id-- if ($c->gettags('current'))[0] eq 'text';
  81.     $c->itemconfigure($id, -fill => $$old_fill);
  82.     $c->itemconfigure($id+1, -fill => 'black');
  83.  
  84. } # end cscroll_leave
  85.  
  86. 1;
  87.