home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _8146ab83c8483d3498ac2201cc05666e < prev    next >
Encoding:
Text File  |  2004-06-01  |  2.9 KB  |  125 lines
  1. # HList and ItemStyle, multicolumn listbox with individual cell styles.
  2. # -*- perl -*-
  3.  
  4. #
  5. # $Id: $
  6. # Author: Slaven Rezic
  7. #
  8. # Copyright (C) 1999 Slaven Rezic. All rights reserved.
  9. # This program is free software; you can redistribute it and/or
  10. # modify it under the same terms as Perl itself.
  11. #
  12. # Mail: eserte@cs.tu-berlin.de
  13. # WWW:  http://user.cs.tu-berlin.de/~eserte/
  14. #
  15.  
  16. use Tk::HList;
  17. use Tk::ItemStyle;
  18.  
  19. sub HList2 {
  20.     my($demo) = @_;
  21.     my $TOP = $MW->WidgetDemo(
  22.         -name => $demo,
  23.         -text => 'HList and ItemStyle, multicolumn listbox with individual cell styles.',
  24.     -geometry_manager => 'grid',
  25.     );
  26.  
  27.     my $h = $TOP->Scrolled
  28.       (qw/HList
  29.        -header 1
  30.        -columns 4
  31.        -width 50
  32.        -height 20/
  33.       )->grid(qw/-sticky nsew/);
  34.  
  35.     for (0 .. 3) {
  36.     $h->header('create', $_, -text => 'Column ' . $_);
  37.     }
  38.  
  39.     my @img;
  40.     foreach ('Xcamel.gif', 'anim.gif', 'icon.gif', 'Camel.xpm') {
  41.     push @img, $TOP->Photo(-file => Tk->findINC($_)),
  42.     }
  43.  
  44.     my(@fonts) = ('-*-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-*',
  45.           '-*-Courier-Medium-R-Normal--*-180-*-*-*-*-*-*',
  46.           '-*-times-medium-r-normal--*-240-*-*-*-*-*-*',
  47.           '-Adobe-Courier-Bold-O-Normal--*-120-*-*-*-*-*-*',
  48.           'fixed',
  49.          );
  50.  
  51.     my(@colors) = qw(red green blue yellow red cyan black);
  52.  
  53.     my $rnd_font = sub {
  54.     $fonts[rand($#fonts+1)];
  55.     };
  56.     my $rnd_color = sub {
  57.     $colors[rand($#colors+1)];
  58.     };
  59.     my $rnd_image = sub {
  60.     my $yn = int(rand(2));
  61.     if ($yn) {
  62.         $img[rand($#img+1)];
  63.     } else {
  64.         undef;
  65.     }
  66.     };
  67.     my $rnd_window = sub {
  68.     my $yn = int(rand(10));
  69.     if ($yn == 3) {
  70.         ('Button', 'Entry')[rand(2)];
  71.     } else {
  72.         undef;
  73.     }
  74.     };
  75.  
  76.     for my $y (0 .. 20) {
  77.     my $e = $h->addchild("");
  78.     for my $col (0 .. 3) {
  79.         my $window = $rnd_window->();
  80.         my $image = $rnd_image->();
  81.         my $fg = $rnd_color->();
  82.         my $bg = $rnd_color->();
  83.         if ($bg eq $fg) { $fg = 'white' }
  84.  
  85.         my $style_type = ($window ? 'window' :
  86.                   ($image ? 'imagetext' : 'text'));
  87.         my $btn;
  88.         my $style = $h->ItemStyle($style_type);
  89.         if ($style_type eq 'window') {
  90.         $style->configure(-pady => 0, -padx => 0, -anchor => "nw");
  91.         if ($window eq 'Button') {
  92.             $btn = $h->Button
  93.               (-text => 'Click me!',
  94.                -command => sub {
  95.                $btn->configure(-activeforeground => $rnd_color->());
  96.                },
  97.               );
  98.         } else {
  99.             $btn = $h->Entry;
  100.         }
  101.         } else {
  102.         $style->configure(-foreground => $fg,
  103.                   -background => $bg,
  104.                   -font       => $rnd_font->(),
  105.                  );
  106.         }
  107.         $h->itemCreate
  108.           ($e, $col,
  109.            -itemtype => $style_type,
  110.            -style => $style,
  111.            ($style_type eq 'imagetext'
  112.         ? (-image => $image) : ()
  113.            ),
  114.            ($style_type eq 'window'
  115.         ? (-widget => $btn) : (-text => 'Cell ' . $y . '/' . $col)
  116.            ),
  117.           );
  118.     }
  119.     }
  120. }
  121.  
  122. 1;
  123.  
  124. __END__
  125.