home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _23b4645617b0fe094b727af50b7d5137 < prev    next >
Encoding:
Text File  |  2004-06-01  |  4.6 KB  |  147 lines
  1. # ruler.pl
  2.  
  3. use subs qw/ruler_make_tab ruler_move_tab ruler_new_tab ruler_release_tab
  4.         ruler_select_tab/;
  5. use vars qw/$TOP/;
  6.  
  7. sub ruler {
  8.  
  9.     # Create a canvas demonstration consisting of a ruler displays a ruler
  10.     # with tab stops that can be set individually.
  11.  
  12.     my($demo) = @_;
  13.     $TOP = $MW->WidgetDemo(
  14.         -name     => $demo,
  15.         -text     => ['This canvas widget shows a mock-up of a ruler.  You can create tab stops by dragging them out of the well to the right of the ruler.  You can also drag existing tab stops.  If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button.', qw/-wraplength 5i/],
  16.         -title    => 'Ruler Demonstration',
  17.         -iconname => 'ruler',
  18.     );
  19.  
  20.     my $c = $TOP->Canvas(qw/-width 14.8c -height 2.5c/);
  21.     $c->pack(qw/-side top -fill x/);
  22.  
  23.     my %rinfo;            # ruler information hash
  24.     $rinfo{grid} = '.25c';
  25.     $rinfo{left} = $c->fpixels('1c');
  26.     $rinfo{right} = $c->fpixels('13c');
  27.     $rinfo{top} = $c->fpixels('1c');
  28.     $rinfo{bottom} = $c->fpixels('1.5c');
  29.     $rinfo{size} = $c->fpixels('.2c');
  30.     $rinfo{normalStyle} = [qw/-fill black/];
  31.     if ($TOP->depth > 1) {
  32.     $rinfo{activeStyle} = [qw/-fill red -stipple/ => undef];
  33.     $rinfo{deleteStyle} = [
  34.             -fill    => 'red',
  35.         -stipple => '@'.Tk->findINC('demos/images/grey.25'),
  36.         ];
  37.     } else {
  38.     $rinfo{activeStyle} = [qw/-fill black -stipple/ => undef];
  39.     $rinfo{deleteStyle} = [
  40.             -fill    => 'black',
  41.             -stipple => '@'.Tk->findINC('demos/images/grey.25'),
  42.         ];
  43.     }
  44.  
  45.     $c->create(qw/line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1/);
  46.     my $i;
  47.     for ($i = 0; $i < 12; $i++) {
  48.     my $x = $i+1;
  49.     $c->create('line', "$x.c",  '1c', "$x.c",  '0.6c', -width => 1);
  50.     $c->create('line', "$x.25c", '1c', "$x.25c", '0.8c', -width => 1);
  51.     $c->create('line', "$x.5c",  '1c', "$x.5c",  '0.7c', -width => 1);
  52.     $c->create('line', "$x.75c", '1c', "$x.75c", '0.8c', -width => 1);
  53.     $c->create('text', "$x.15c", '.75c',-text => $i, -anchor => 'sw');
  54.     }
  55.     $c->addtag('well', 'withtag', $c->create(qw/rect 13.2c 1c 13.8c 0.5c
  56.         -outline black -fill/, ($c->configure(-bg))[4]));
  57.     $c->addtag('well', 'withtag', ruler_make_tab($c, $c->pixels('13.5c'),
  58.         $c->pixels('.65c'), \%rinfo));
  59.  
  60.     $c->bind('well', '<1>' => [\&ruler_new_tab, \%rinfo]);
  61.     $c->bind('tab', '<1>' => [\&ruler_select_tab, \%rinfo]);
  62.     $c->Tk::bind('<B1-Motion>' => [\&ruler_move_tab, \%rinfo]);
  63.     $c->Tk::bind('<Any-ButtonRelease-1>', [\&ruler_release_tab, \%rinfo]);
  64.  
  65. } # end ruler
  66.  
  67. sub ruler_make_tab {
  68.  
  69.     my($c, $x, $y, $rinfo) = @_;
  70.  
  71.     return $c->create('polygon', $x, $y, $x+$rinfo->{size}, $y+$rinfo->{size},
  72.                                      $x-$rinfo->{size}, $y+$rinfo->{size});
  73.  
  74. } # end ruler_make_tab
  75.  
  76. sub ruler_move_tab {
  77.  
  78.     my($c, $rinfo) = @_;
  79.  
  80.     return if not defined $c->find('withtag', 'active');
  81.     my $e = $c->XEvent;
  82.     my($x, $y) = ($e->x, $e->y);
  83.     my $cx = $c->canvasx($x, $rinfo->{grid});
  84.     my $cy = $c->canvasy($y);
  85.     if ($cx < $rinfo->{left}) {
  86.     $cx =  $rinfo->{left};
  87.     }
  88.     if ($cx > $rinfo->{right}) {
  89.     $cx =  $rinfo->{right};
  90.     }
  91.     if (($cy >= $rinfo->{top}) and ($cy <= $rinfo->{bottom})) {
  92.     $cy =  $rinfo->{top} + 2;
  93.     $c->itemconfigure('active', @{$rinfo->{activeStyle}});
  94.     } else {
  95.     $cy =  $cy - $rinfo->{size} - 2;
  96.     $c->itemconfigure('active', @{$rinfo->{deleteStyle}});
  97.     }
  98.     $c->move('active',  $cx-$rinfo->{'x'}, $cy-$rinfo->{'y'});
  99.     $rinfo->{'x'} = $cx;
  100.     $rinfo->{'y'} = $cy;
  101.  
  102. } # end ruler_move_tab
  103.  
  104. sub ruler_new_tab {
  105.  
  106.     my($c, $rinfo) = @_;
  107.  
  108.     my $e = $c->XEvent;
  109.     my($x, $y) = ($e->x, $e->y);
  110.     $c->addtag('active', 'withtag', ruler_make_tab($c, $x, $y, $rinfo));
  111.     $c->addtag('tab', 'withtag', 'active');
  112.     $rinfo->{'x'} = $x;
  113.     $rinfo->{'y'} = $y;
  114.     ruler_move_tab($c, $rinfo);
  115.  
  116. } # end ruler_new_tab
  117.  
  118. sub ruler_release_tab {
  119.  
  120.     my($c, $rinfo) = @_;
  121.  
  122.     return if not defined $c->find('withtag', 'active');
  123.     if ($rinfo->{'y'} != $rinfo->{top} + 2) {
  124.     $c->delete('active');
  125.     } else {
  126.     $c->itemconfigure('active', @{$rinfo->{normalStyle}});
  127.     $c->dtag('active');
  128.     }
  129.  
  130. } # end ruler_release_tab
  131.  
  132. sub ruler_select_tab {
  133.  
  134.     my($c, $rinfo) = @_;
  135.  
  136.     my $e = $c->XEvent;
  137.     my($x, $y) = ($e->x, $e->y);
  138.     $rinfo->{'x'} = $c->canvasx($x, $rinfo->{grid});
  139.     $rinfo->{'y'} = $rinfo->{top} + 2;
  140.     $c->addtag('active', 'withtag', 'current');
  141.     $c->itemconfigure('active', @{$rinfo->{activeStyle}});
  142.     $c->raise('active');
  143.  
  144. } # end ruler_select_tab
  145.  
  146. 1;
  147.