File: image_test

package info (click to toggle)
perl-tk 1%3A804.036%2Bdfsg1-5
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 35,284 kB
  • sloc: ansic: 349,560; perl: 52,292; sh: 12,678; makefile: 5,700; asm: 3,565; ada: 1,681; pascal: 1,082; cpp: 1,006; yacc: 883; cs: 879
file content (32 lines) | stat: -rwxr-xr-x 1,101 bytes parent folder | download | duplicates (10)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#!/usr/local/bin/perl -w

use Tk;


$path = Tk->findINC("demos/images");

$top = MainWindow->new();

$bitmap = $top->Bitmap( '-file' => "$path/dir.icon",
                        '-maskfile' => "$path/dir.mask");

$photo  = $top->Photo( 'photo');

$pixmap = $top->Pixmap( 'quit' ,  '-file' => "$path/QuitPB.xpm");

$top->Label('-image'=> $bitmap)->pack;
$top->Label('-image'=> $photo  )->pack;
my $f = $top->Frame->pack;
$f->Button('-text' => 'PPM', '-command'
             => ['configure',$photo, -file => "$path/teapot.ppm" ] )->pack(-side => 'left');
$f->Button('-text' => 'GIF', '-command'
             => ['configure',$photo, -file => "$path/mickey.gif" ] )->pack(-side => 'left');

$f->Button('-text' => 'XBM', '-command'
             => ['configure',$photo, -file => "$path/face" ] )->pack(-side => 'left');
$f->Button('-text' => 'XPM', '-command'
             => ['configure',$photo, -file => "$path/QuitPBa.xpm" ] )->pack(-side => 'left');
$f->Button('-text' => 'Blank', '-command' => ['blank',$photo] )->pack;
$top->Button('-image'=> $pixmap, '-command'=>['destroy',$top] )->pack;

MainLoop;