PerlTk - How to show sub menu without clicking on the main menu??

Author

How to show sub menu without clicking on the main menu??

Joy

2007-01-06, 7:14 pm

Hi All,
Here is my small script.

use warnings;
use strict;
use Tk;
use Tk::ROText;
my( $popupMenuDHBM, $popupMenuStopFileDir);
my $maindlg = MainWindow->new();
my @standard_pack = (-side => 'top', -fill =>'x', -expand =>1);
my $frame_canvas = $maindlg->Frame()->pack(@standard_pack);
my $frame_text = $maindlg->Frame(-borderwidth=>3,
-relief=>'groove')->pack(@standard_pack);
my $txtbox = $frame_text->Scrolled("ROText",
-scrollbars => "osoe",
-width =>35,
-height =>6,
-wrap =>'word',
-font=>"fixed",
-selectbackground => "yellow",
)->pack(@standard_pack);
createPopupMenuDHBM();
$maindlg->Tk::bind( "<3>", [ \&showPopupMenuDHBM, 3, Ev('x'), Ev('y'),
Ev('X'), Ev('Y') ] );
MainLoop;

sub createPopupMenuDHBM {
$popupMenuDHBM = $txtbox->Menu( -tearoff => 0, -menuitems =>
[[ 'command' => "Menu 1",-command => sub{print "\nMenu 1
Selected\n";} ],
"-",
['command' => "Menu 2", -command => sub{print "\nMenu 2
Selected\n";}],
[ 'cascade' => "Menu 3"],
[ 'cascade' => "Menu 4"]]);

$popupMenuStopFileDir = $popupMenuDHBM->Menu( -menuitems=>[[
'command' => "Sub Menu 1",
-command => sub{print "\nSub Menu 1 Selected\n";}],
[ 'command' => "Sub Menu 2", -command => sub{print
"\nSub Menu 2 Selected\n";}],
[ 'command' => "Sub Menu 3", -command => sub{print
"\nSub Menu 3 Selected\n";}]]);
$popupMenuDHBM->entryconfigure("Menu 3",-menu =>
$popupMenuStopFileDir);
$popupMenuDHBM->entryconfigure("Menu 4",-menu =>
$popupMenuStopFileDir);
}

sub showPopupMenuDHBM {
my ( $win, $btn, $x, $y, $X, $Y ) = @_;
$popupMenuDHBM->post( $X, $Y );
}

sub unpostPopupMenuDHBM {
if ($popupMenuDHBM) {
$popupMenuDHBM->unpost;
}
}

Here I have to click on Menu 3 or Menu 4 to see the sub menu.
Is there any way to do that without a left click??
I mean I want some way that the sum menu be shown automatically when
Menu 3/ Menu 4 has focus on it.
(It is like mozilla).
Please let me know, if there is some way.

Thanks in advance,
Joy

allenjo5@mail.northgrum.com

2007-01-06, 7:14 pm

Joy wrote:
> Hi All,
> Here is my small script.
>
> use warnings;
> use strict;
> use Tk;
> use Tk::ROText;
> my( $popupMenuDHBM, $popupMenuStopFileDir);
> my $maindlg = MainWindow->new();
> my @standard_pack = (-side => 'top', -fill =>'x', -expand =>1);
> my $frame_canvas = $maindlg->Frame()->pack(@standard_pack);
> my $frame_text = $maindlg->Frame(-borderwidth=>3,
> -relief=>'groove')->pack(@standard_pack);
> my $txtbox = $frame_text->Scrolled("ROText",
> -scrollbars => "osoe",
> -width =>35,
> -height =>6,
> -wrap =>'word',
> -font=>"fixed",
> -selectbackground => "yellow",
> )->pack(@standard_pack);
> createPopupMenuDHBM();
> $maindlg->Tk::bind( "<3>", [ \&showPopupMenuDHBM, 3, Ev('x'), Ev('y'),
> Ev('X'), Ev('Y') ] );
> MainLoop;
>
>
> sub createPopupMenuDHBM {
> $popupMenuDHBM = $txtbox->Menu( -tearoff => 0, -menuitems =>
> [[ 'command' => "Menu 1",-command => sub{print "\nMenu 1
> Selected\n";} ],
> "-",
> ['command' => "Menu 2", -command => sub{print "\nMenu 2
> Selected\n";}],
> [ 'cascade' => "Menu 3"],
> [ 'cascade' => "Menu 4"]]);
>
> $popupMenuStopFileDir = $popupMenuDHBM->Menu( -menuitems=>[[
> 'command' => "Sub Menu 1",
> -command => sub{print "\nSub Menu 1 Selected\n";}],
> [ 'command' => "Sub Menu 2", -command => sub{print
> "\nSub Menu 2 Selected\n";}],
> [ 'command' => "Sub Menu 3", -command => sub{print
> "\nSub Menu 3 Selected\n";}]]);
> $popupMenuDHBM->entryconfigure("Menu 3",-menu =>
> $popupMenuStopFileDir);
> $popupMenuDHBM->entryconfigure("Menu 4",-menu =>
> $popupMenuStopFileDir);
> }
>
> sub showPopupMenuDHBM {
> my ( $win, $btn, $x, $y, $X, $Y ) = @_;
> $popupMenuDHBM->post( $X, $Y );
> }
>
>
> sub unpostPopupMenuDHBM {
> if ($popupMenuDHBM) {
> $popupMenuDHBM->unpost;
> }
> }
>
>
> Here I have to click on Menu 3 or Menu 4 to see the sub menu.
> Is there any way to do that without a left click??
> I mean I want some way that the sum menu be shown automatically when
> Menu 3/ Menu 4 has focus on it.
> (It is like mozilla).
> Please let me know, if there is some way.

Insert the following code after your "use Tk::ROText". It redefines
the Motion method to always act as if a button is depressed while
motion is occuring. The new sub is a stripped down version of the one
in Menu.pm (in perl 5.8.8). It seems to work even without the
IS($Tk::window) test, but I'm not really sure what the point of that
is.

Of course, this change will affect all menus in your application.
There's probably a way to do it for just a particular menu with clever
bind() calls, but I didn't want to try that hard. Maybe another
poster would care to?

{
use Tk::Menu;
package Tk::Menu;
no warnings 'redefine';

sub Motion
{
my ($menu, $x, $y) = @_;

if ($menu->IS($Tk::window))
{
$menu->activate("\@$x,$y");
$menu->GenerateMenuSelect;
}
$menu->postcascade('active')
}
}

allenjo5@mail.northgrum.com

2007-01-06, 7:14 pm

allenjo5@mail.northgrum.com wrote:

> Insert the following code after your "use Tk::ROText". It redefines
> the Motion method to always act as if a button is depressed while
> motion is occuring. The new sub is a stripped down version of the one
> in Menu.pm (in perl 5.8.8). It seems to work even without the
> IS($Tk::window) test, but I'm not really sure what the point of that
> is.

Obviously, I meant to say which version of Perl/Tk I'm using, which is
804.027, not which version of perl.

Oh, and I've since found out that if the IS($Tk::window) test is not
done, you get the appearance of the default ROText secondary menus when
holding down button 3 while raking over your menu. Very strange.
Perhaps someone else can explain?

> Of course, this change will affect all menus in your application.
> There's probably a way to do it for just a particular menu with clever
> bind() calls, but I didn't want to try that hard. Maybe another
> poster would care to?
>
> {
> use Tk::Menu;
> package Tk::Menu;
> no warnings 'redefine';
>
> sub Motion
> {
> my ($menu, $x, $y) = @_;
>
> if ($menu->IS($Tk::window))
> {
> $menu->activate("\@$x,$y");
> $menu->GenerateMenuSelect;
> }
> $menu->postcascade('active')
> }
> }

Sponsored Links