home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _15358b88e7d084bd9608205161a36375 < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.4 KB  |  49 lines
  1. # vscale.pl
  2.  
  3. use subs qw/vscale_height/;
  4. use vars qw/$TOP/;
  5.  
  6. sub vscale {
  7.  
  8.     # Create a top-level window that displays a vertical scale.
  9.  
  10.     my($demo) = @_;
  11.     $TOP = $MW->WidgetDemo(
  12.         -name     => $demo,
  13.         -text     => 'An arrow and a vertical scale are displayed below.  If you click or drag mouse button 1 in the scale, you can change the size of the arrow.',
  14.         -title    => 'Vertical Scale Demonstration',
  15.         -iconname => 'vscale',
  16.     );
  17.  
  18.     my $frame = $TOP->Frame(-borderwidth => 10)->pack;
  19.  
  20.     my $canvas = $frame->Canvas(
  21.         qw/-width 50 -height 50 -borderwidth 0 -highlightthickness 0/);
  22.     $canvas->createPolygon(qw/0 0 1 1 2 2 -fill SeaGreen3 -tags poly/);
  23.     $canvas->createLine(qw/0 0 1 1 2 2 0 0 -fill black -tags line/);
  24.  
  25.     my $scale = $frame->Scale(qw/-orient vertical -length 284 -from 0
  26.         -to 250 -tickinterval 50 -command/ => [\&vscale_height, $canvas]);
  27.     $scale->set(75);
  28.  
  29.     $scale->pack(qw/-side left -anchor ne/);
  30.     $canvas->pack(qw/-side left -anchor nw -fill y/)
  31.  
  32. } # end vscale
  33.  
  34. sub vscale_height {
  35.  
  36.     my($w, $height) = @_;
  37.  
  38.     $height += 21;
  39.     my $y2 = $height - 30;
  40.     $y2 = 21 if $y2 < 21;
  41.     $w->coords('poly', 15, 20, 35, 20, 35, $y2, 45, $y2, 25, $height, 5, $y2,
  42.            15, $y2, 15, 20);
  43.     $w->coords('line', 15, 20, 35, 20, 35, $y2, 45, $y2, 25, $height, 5, $y2,
  44.            15, $y2, 15, 20);
  45.  
  46. } # end vscale_height
  47.  
  48. 1;
  49.