On 27/07/07, [EMAIL PROTECTED] <[EMAIL PROTECTED]> wrote:
> is it possible to show an icon within a menu?
Not directly using Win32::GUI, but using Win32::API too ... I posted
some code to the list a few months ago - I was going to give you a
pointer to the list archive, but it appears that SF's search is broken
again, so I attach it below.
Regards,
Rob.
#!perl -w
use strict;
use warnings;
use Win32::API();
Win32::API->Import('user32', 'SetMenuItemInfo', 'LILP', 'L') or die;
Win32::API->Import('user32', 'SetMenuInfo', 'LP', 'L') or die;
use Win32::GUI qw(CW_USEDEFAULT SM_CXMENUCHECK SM_CYMENUCHECK TRANSPARENT);
use Win32::GUI::DIBitmap();
sub MIIM_BITMAP() {0x00000080}
sub MIM_STYLE() {0x00000010}
sub MNS_CHECKORBMP() {0x04000000}
sub MNS_NOCHECK() {0x80000000}
my $menu = Win32::GUI::Menu->new(
'Popup' => 'Popup',
'>Item &1' => { -name => 'Item1', -onClick => sub { print
"Item1\n"; 0; }, },
'>Item &2' => { -name => 'Item2', -onClick => sub { print
"Item2\n"; 0; }, },
'>Item &3' => { -name => 'Item3', -onClick => sub { print
"Item3\n"; 0; }, },
'>-' => 'Seperator',
'>Item &4' => { -name => 'Item4', -onClick => sub { print
"Item4\n"; 0; }, },
);
# Remove the reserved space for check marks - comment out this
# line to see the effect of leaving the reserved space
set_menu_info($menu->{Popup}->{-handle});
my @bitmaps; # we need to keep a reference to the bitmaps to stop them
getting destroyed
my $pos = 0;
for my $color ( [255,0,0], [0,255,0], [0,0,255] ) { # ( Blue, Green, Red )
my $bmp = create_bitmap($color);
set_menuitem_bitmap($menu->{Popup}->{-handle}, $pos++, $bmp->{-handle});
push @bitmaps, $bmp;
}
my $mw = Win32::GUI::Window->new(
-left => CW_USEDEFAULT,
-size => [400,300],
-onMouseRightUp => \&context_menu,
-onPaint => \&instructions,
);
$mw->Show();
Win32::GUI::Dialog();
$mw->Hide();
exit(0);
# Handler for onMouseRightUp event
sub context_menu {
my ($self) = @_;
$self->TrackPopupMenu($menu->{Popup});
return 0;
}
# Set the bitmap for the menu item. We set by position, as in Win32::GUI I
# can see no way to get the menu item identifier.
# IN: handle to menu
# position of item in menu (zero based)
# handle to bitmap
# OUT: returns true on success, die()s on failure
sub set_menuitem_bitmap {
my ($hmenu, $pos, $hbmp) = @_;
# Create a MENUITEMINFO structure
my $mii = pack( 'IIIIILLLLLIL',
12 * 4, # cbsize = sizeof(MENUITEMINFO)
MIIM_BITMAP, # fMask = MIIM_BITMAP
0, # fType - unused
0, # fState - unused
0, # wID - unused
0, # hSubMenu - unused
0, # hbmpChecked - unused
0, # hbmpUnchecked - unused
0, # dwItemData - unused
0, # dwTypeData - unused
0, # cch - unused
$hbmp, # hbmpItem
);
my $r = SetMenuItemInfo($hmenu, $pos, 1, $mii);
if ( $r == 0 ) {
die qq(SetMenuItemInfo() failed: $^E);
}
return 1;
}
# Set the menu style so that we don't reserve space for checkmarks,
# otherwise we have an extra gap to the left of the bitmap
# IN: handle to menu
# OUT: returns true on success, die()s on failure
sub set_menu_info {
my ($hmenu) = @_;
# Create a MENUINFO structure
my $mi = pack( 'LLLILLL',
7 * 4, # cbsize = sizeof(MENUITEMINFO)
MIM_STYLE, # fMask = MIM_STYLE
MNS_NOCHECK, # dwStyle (or MNS_CHECKORBMP if we want some items to
# have checks and some to have bitmaps)
0, # cyMax - unused
0, # hbrBack - unused
0, # dwContextHelpID - unused
0, # dwMenuData - unused
);
my $r = SetMenuInfo($hmenu, $mi);
if ( $r == 0 ) {
die qq(SetMenuInfo() failed: $^E);
}
return 1;
}
# Create a solid color bitmap of the correct size
# IN: COLOR - array ref [ Blue, Green, Red ]
# OUT: Win32::GUI::Bitmap
sub create_bitmap {
my ($color) = @_;
my $cx = Win32::GUI::GetSystemMetrics(SM_CXMENUCHECK);
my $cy = Win32::GUI::GetSystemMetrics(SM_CYMENUCHECK);
my $dib = Win32::GUI::DIBitmap->new($cx, $cy);
for my $y ( 0 .. $cy-1 ) {
for my $x ( 0 .. $cx-1 ) {
# Using array ref, as DIBitmap appears to have a bug with
# passing a COLORREF value (0xBBGGRR). Note that when DIBitmap
# uses an array ref the colors are in a different order to most
# Win32::GUI usage of array refs for colors: BGR rather than RGB.
$dib->SetPixel($x, $y, $color);
}
}
my $bmp = $dib->ConvertToBitmap();
return $bmp;
}
# Handler for onPaint event
sub instructions {
my ($self, $dc) = @_;
my $saved = $dc->Save();
$dc->Validate();
my ($l, $t, $r, $b) = $self->GetClientRect();
$dc->BkMode(TRANSPARENT);
$dc->DrawText("Right-Click to see menu", $l, $t, $r, $b);
$dc->Restore($saved);
return 0;
}
__END__
-------------------------------------------------------------------------
This SF.net email is sponsored by: Splunk Inc.
Still grepping through log files to find problems? Stop.
Now Search log events and configuration files using AJAX and a browser.
Download your FREE copy of Splunk now >> http://get.splunk.com/
_______________________________________________
Perl-Win32-GUI-Users mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/perl-win32-gui-users
http://perl-win32-gui.sourceforge.net/
