You can use Tk::Compound with some success, to make fancier menus. Here is an example discussed before. Just premake images for your menus. Gtk2 and Wx, etc have better control over menus
if you really need more flexibility.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::PNG;
require Tk::Compound;
my $maindlg = MainWindow->new();
my $bunny = $maindlg->Photo(-data =>
'iVBORw0KGgoAAAANSUhEUgAAAB4AAAAjEAIAAABcJvHFAAAACXBIWXMAAAsSAAALEgHS3
+X78AAAD
F0lEQVR42u1YL+yqUBj1vfcLbhY3C44is8BIREYSG9FoNBqNkok2aFhp2BhJDWyadCZN/i
+lOGxan
jRdOuRsPxl/f+23vJKfX7x6+73znu5dK5RviV9QPDMMwDIPP7/f7/X6XTWU0Go1Go06n0+
+l0PM/z
PC91CNu2bduWZVmW5bLpjsfj8XgcBEEQBJPJZDKZZAw0n8/n8zkCGYZhGIYgCIIgFEt3OB
+wOh8OA
gKZpmqZlDDedTqfTKRnO933f95GVer1er9fz0BVFURRFxCR3QfyMQfv9fr/fDyLgOI7jON
+mo419k
JUkMBoPBYJCRNBrxdrvdbrco6qvVarVaIWdFpQO/5tIcFBbE4nQ6nU6nJIpHjlGlEklTFE
+VRFDIa
T32/3+/3+3jqHMdxHBcfB2sK6HFFURRFeb1er9crfksoNUrr0GvUfxGfnA+FmX+QALDItG
+LDA6O2
pQyCJFkPqxMDK2p9LodOAhQaLRjfoKRGo2wObl3G8PoDsA0Gb5Q5oonjfSNKTh96AOh+u9
+1ut1uS
FuZrONPJ7bJ06tA9TDDsD6QkCnDltEDRkV1Q9AnENyuk8hcyChkkcZKo5uv1er1er3S6cA
+PkFXSx
MQodPrXFg2zTEsVANhO2JNdEmVo80ub7K/lSDHPyLkNaXrVarVar2W46LMuyLFsKaZ7neZ
+4nvwFR
NGKeGjYajUajkXz9z+RLn8/n8/ms/ANIQXq5XC6Xy/v9fr/fvw3p9Xq9Xq9VVVVV9fF4PB
+6Pokhc
r9fr9Vr6s6Lf4dNpbS6/exQA3BHDt/fkPl3wwT85wlcEcrCHZyHO1tmOSl95iGLcQN80Td
+M0jTa1
LMuyLF3XdV03TdM0zWaz2Ww2Xdd1XRenDlDHgTbtvj/ykMZpDm/6LpfL5XLBmGi32+12G6
+Th5RAA
Pne73W63iwfGYFosFovF4kOZrtVqtVoN16TD4XA4HPAAKDp5yZUkSZIk1GGz2Ww2m91ut9
+vt0Mof
lcfxeDwej7PZbDaboRFbrVar1SJfIsLdYZfn8/l8Pue3y1zyiH9VAMFElb5Yp/+PcvAbH/
+25ox5S
PYYAAAAASUVORK5CYII=');
my $dummy_frame = $maindlg->Frame
->pack( -side => 'top', -anchor => 'n', -fill => 'x' );
Create_Menubar($dummy_frame);
my $menureport;
my @standard_pack = (-side => 'top', -fill =>'x', -expand =>1);
my $frame_text = $maindlg->Frame(-borderwidth=>3,
-relief=>'groove')->pack(@standard_pack);
my $txtbox = $frame_text->Scrolled("Text",
-scrollbars => "osoe",
-width =>35,
-height =>6,
-wrap =>'word',
-font=>"fixed",
-selectbackground => "yellow",
)->pack(@standard_pack);
MainLoop;
sub Create_Menubar{
my $frame = shift;
my $mf = $frame->Frame->pack( -side => 'left', -anchor => 'w', -
padx => 10 );
$maindlg->bind( $mf, '<Leave>', [\&Leave,$mf] );
sub Leave {
my $mf = shift;
my @state = $mf->packSlaves();
foreach (@state) {
if ( $_->cget('-state') eq 'active' ) {
$_->Leave();
}
}
}
my $compound_image = $frame->Compound(-relief =>'raised');
$compound_image->Image(-image => $bunny );
$compound_image->Text(-text => "Menu");
$menureport = $mf->Menubutton( -image => $compound_image,
-tearoff=> 0)->pack( -side => 'left' ); ##Works Fine
my @tmp_array;
push @tmp_array, ['command'=>"SubMenu 1 Cntrl V" ];
push @tmp_array, ['command'=>"SubMenu 2"];
push @tmp_array, ['command'=>"SubMenu 3"];
$menureport->menu()->cascade(-image => $compound_image,-menuitems=
+> \@tmp_array );
$menureport->menu()->cascade(-label => "Menu 2",-menuitems =>\@tmp
+_array );
}
|