home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _1da8cf24aa1706f6e9e7483d4bdb8414 < prev    next >
Text File  |  2004-06-01  |  2KB  |  49 lines
  1. # hscale.pl
  2.  
  3. use subs qw /hscale_width/;
  4. use vars qw/$TOP/;
  5.  
  6. sub hscale {
  7.  
  8.     # Create a top-level window that displays a horizontal scale.
  9.  
  10.     my($demo) = @_;
  11.     $TOP = $MW->WidgetDemo(
  12.         -name     => $demo,
  13.         -text     => 'An arrow and a horizontal 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    => 'Horizontal Scale Demonstration',
  15.         -iconname => 'hscale',
  16.     );
  17.  
  18.     my $frame = $TOP->Frame(-borderwidth => 10)->pack(qw/-side top -fill x/);
  19.  
  20.     my $canvas = $frame->Canvas(
  21.         qw/width 50 -height 50 -bd 0 -highlightthickness 0/);
  22.     $canvas->createPolygon(qw/0 0 1 1 2 2 -fill DeepSkyBlue3 -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 horizontal -length 284 -from 0
  26.         -to 250 -tickinterval 50 -command/ => [\&hscale_width, $canvas]);
  27.     $scale->set(75);
  28.  
  29.     $canvas->pack(qw/-side top -expand yes -anchor w -fill x/);
  30.     $scale->pack(qw/-side bottom -expand yes -anchor w/);
  31.  
  32. } # end hscale
  33.  
  34. sub hscale_width {
  35.  
  36.     my($w, $width) = @_;
  37.  
  38.     $width += 21;
  39.     my $x2 = $width - 30;
  40.     $x2 = 21 if $x2 < 21;
  41.     $w->coords('poly', 20, 15, 20, 35, $x2, 35, $x2, 45, $width, 25, $x2, 5,
  42.            $x2, 15, 20, 15);
  43.     $w->coords('line', 20, 15, 20, 35, $x2, 35, $x2, 45, $width, 25, $x2, 5,
  44.            $x2, 15, 20, 15);
  45.  
  46. } # end hscale_width
  47.  
  48. 1;
  49.