home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _2e6fd4027ea49ad01c49b57b52d9aae6 < prev    next >
Encoding:
Text File  |  2004-04-13  |  2.9 KB  |  126 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.     return undef; # XXX disable for now
  69.     my $yn = int(rand(10));
  70.     if ($yn == 3) {
  71.         ('Button', 'Entry')[rand(2)];
  72.     } else {
  73.         undef;
  74.     }
  75.     };
  76.  
  77.     for my $y (0 .. 20) {
  78.     my $e = $h->addchild("");
  79.     for my $col (0 .. 3) {
  80.         my $window = $rnd_window->();
  81.         my $image = $rnd_image->();
  82.         my $fg = $rnd_color->();
  83.         my $bg = $rnd_color->();
  84.         if ($bg eq $fg) { $fg = 'white' }
  85.         
  86.         my $style_type = ($window ? 'window' : 
  87.                   ($image ? 'imagetext' : 'text'));
  88.         my $btn;
  89.         my $style = $h->ItemStyle($style_type);
  90.         if ($style_type eq 'window') {
  91.         $style->configure(-pady => 0, -padx => 0);
  92.         if ($window eq 'Button') {
  93.             $btn = $h->Button
  94.               (-text => 'Click me!',
  95.                -command => sub {
  96.                $btn->configure(-activeforeground => $rnd_color->());
  97.                },
  98.               );
  99.         } else {
  100.             $btn = $h->Entry;
  101.         }
  102.         } else {
  103.         $style->configure(-foreground => $fg,
  104.                   -background => $bg,
  105.                   -font       => $rnd_font->(),
  106.                  );
  107.         }
  108.         $h->itemCreate
  109.           ($e, $col,
  110.            -itemtype => $style_type,
  111.            -style => $style,
  112.            ($style_type eq 'imagetext'
  113.         ? (-image => $image) : ()
  114.            ),
  115.            ($style_type eq 'window'
  116.         ? (-widget => $btn) : (-text => 'Cell ' . $y . '/' . $col)
  117.            ),
  118.           );
  119.     }
  120.     }
  121. }                
  122.  
  123. 1;
  124.  
  125. __END__
  126.