tk Menubutton question

remling has asked for the wisdom of the Perl Monks concerning the following question:

I have a perl/tk question. I created a gui that uses the Menubutton widget and am using the -tearoff option (-tearoff =>1). I am trying to figure out how to change the icon in the upper-left corner of the torn-off menu window. I've got it working for the mainwin and every other dialog win. I've tried every combination I could come up with and have not been able to figure out how to change the icon for the Menubutton win. Here's a basic examp. This produces a menubutton and when you click on it you get just the dashed-line separator from the -tearoff option. If you click on the dashed-line you get the separate menubutton window. I want this window to use my own icon instead of the generic Tk icon. You have to have an icon file to run this example (couldn't figure out how to attach one to this question).

#! /usr/local/bin/perl -w
use Tk;

my $main = MainWindow->new();
my $wgif = $main->Bitmap("./someicon.ico");
$main->iconbitmap($wgif);

my $mbut = $main->Menubutton(-text => 'Menu', -tearoff => 1)->pack();

&MainLoop;
[download]

Comment on tk Menubutton question Download Code

Replies are listed 'Best First'.
Re: tk Menubutton question by Khen1950fx (Canon) on Jun 28, 2011 at 04:30 UTC
Bitmaps use xbm files. Here's an example using betty_boop.xbm: `#! /usr/local/bin/perl use strict; use warnings; use Tk; my $mw = MainWindow->new(); my $b = $mw->Bitmap( -file => '/path/to/betty_boop.xbm', -foreground => 'black', -background => 'white', ); my $l = $mw->Label( -image => $b, -background => 'gray')->pack; MainLoop;` [download] And here's betty_boop.xbm `#define betty_boop_width 20 #define betty_boop_height 20 static unsigned char betty_boop_bits[] = { 0x20, 0x00, 0x00, 0xe0, 0xff, 0x00, 0xf8, 0xff, 0x01, 0xfc, 0xff, 0 +x03, 0xfc, 0xff, 0x07, 0xfc, 0xff, 0x07, 0x7c, 0x43, 0x03, 0xbe, 0xc1, 0 +x03, 0x9f, 0x40, 0x06, 0x3c, 0x63, 0x03, 0x98, 0xf7, 0x02, 0xb8, 0xb5, 0 +x03, 0xb8, 0x94, 0x02, 0xb8, 0xe3, 0x01, 0x38, 0x08, 0x03, 0x38, 0x1c, 0 +x01, 0xe0, 0xff, 0x00, 0xf0, 0x60, 0x00, 0x78, 0x40, 0x00, 0xb0, 0x58, 0 +x00};` [download] Or use whatever xbm that you want.	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re: tk Menubutton question
by Khen1950fx (Canon) on Jun 28, 2011 at 04:30 UTC

#! /usr/local/bin/perl 

use strict;
use warnings;
use Tk;

my $mw = MainWindow->new();
my $b  = $mw->Bitmap(
         -file       => '/path/to/betty_boop.xbm',
         -foreground => 'black',
         -background => 'white', ); 
my $l  = $mw->Label(
         -image => $b,
         -background => 'gray')->pack;

MainLoop;
[download]

#define betty_boop_width 20
#define betty_boop_height 20
static unsigned char betty_boop_bits[] = {
   0x20, 0x00, 0x00, 0xe0, 0xff, 0x00, 0xf8, 0xff, 0x01, 0xfc, 0xff, 0
+x03,
   0xfc, 0xff, 0x07, 0xfc, 0xff, 0x07, 0x7c, 0x43, 0x03, 0xbe, 0xc1, 0
+x03,
   0x9f, 0x40, 0x06, 0x3c, 0x63, 0x03, 0x98, 0xf7, 0x02, 0xb8, 0xb5, 0
+x03,
   0xb8, 0x94, 0x02, 0xb8, 0xe3, 0x01, 0x38, 0x08, 0x03, 0x38, 0x1c, 0
+x01,
   0xe0, 0xff, 0x00, 0xf0, 0x60, 0x00, 0x78, 0x40, 0x00, 0xb0, 0x58, 0
+x00};
[download]

[reply]
[d/l]
[select]