use
subs
qw/bitmaps_row/
;
sub
bitmaps {
my
(
$demo
) =
@_
;
$TOP
=
$MW
->WidgetDemo(
-name
=>
$demo
,
-text
=>
'This window displays all of Tk\'s built-in bitmaps, along with the names you can use for them in Perl scripts.'
,
-title
=>
'Bitmap Demonstration'
,
-iconname
=>
'bitmaps'
,
);
my
$frame
=
$TOP
->Frame;
$frame
->
pack
(
qw/-side top -expand yes -fill both/
);
bitmaps_row
$frame
,
qw/error gray12 gray25 gray50 gray75 hourglass/
;
bitmaps_row
$frame
,
qw/info questhead question Tk transparent warning/
;
}
sub
bitmaps_row {
my
(
$w
,
@names
) =
@_
;
my
$row
=
$w
->Frame->
pack
(
qw/-side top -fill both/
);
foreach
my
$bitmap_name
(
@names
) {
my
$bit
=
$row
->Frame;
$bit
->
pack
(
qw/-side left -fill both -pady .25c -padx .25c/
);
my
$label
=
$bit
->Label(
-text
=>
$bitmap_name
,
-width
=> 9);
$label
->
pack
(
qw/-side bottom/
);
my
$bitmap
=
$bit
->Label(
'-bitmap'
=>
$bitmap_name
);
$bitmap
->
pack
(
qw/-side bottom/
);
}
}
1;