Re: [perl-win32-gui-users] icons in TrackPopupMenu

Robert May Wed, 21 Mar 2007 15:28:01 -0700

Chuck Pierce wrote:

anyone know how (or if it's possible) to add/update icons to the
TrackPopupMenu?  Also, how do you add separator bars in the menu as well?

It's not currently possible using Win32::GUI alone. There's a featurerequest open asking for it, and I've just had a quick look at the code,and don't think it would be too hard to add .... but I need to get thetime (unless someone else wants to have a go, then I can point them tothe right bits of code)

In the meantime, here's a horrible hack to do it using Win32::API to getdirect access to the SetMenuInfo and SetMenuItemInfo API calls. I'vethrown in a separator so you can see how that's done too.


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 themgetting 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 ratherthan 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__

Re: [perl-win32-gui-users] icons in TrackPopupMenu

Reply via email to