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

# Hi all, # Q1........ how do I colour the separator in the Menubutton in the script below # Q2........ and how do I colour the system menu icon's dropdown 

use diagnostics;
use strict;
use Tk;

my $colour = "white";

my $main = MainWindow->new;

my $label = $main->Label(-text => 'Hello, world!')->pack;

my $button1 = $main->Menubutton(-text => "More...",  -underline => 0, 
+-tearoff => 0, -activebackground => $colour, -relief=> "raised",)->pa
+ck;
my $entry1 = $button1->command(-label => 'Quit1',-command => [$main =>
+ 'destroy'], );
my $entry2 = $button1->separator();       # colour it ?!?      -bg => 
+$colour, does not work ????
my $entry3 = $button1->command(-label => 'Quit2',-command => [$main =>
+ 'destroy'], );


# Q3...........  would also like to know if it is possible to get the 
+proper names (var names maybe that I used) for the $widgets so I can 
+read them better...
# as of "$main" rather than "MainWindow=HASH(0x1828c84)"
# or "$label" rather than "Tk::Label=HASH(0x1c02eb8)"
# from this part of the script:

############ to catch(recolour) any non white(coloured) areas ########
+########################
print "<<<<<<<<<<<<<<<<<<<<<<< Colouring widgets >>>>>>>>>>>>>>>>>>>>>
+>>>>>>\n";
change_colors2( $main, $colour, # $colourt, $foreground
);

sub change_colors2{
my ( $widget, $color, ) = @_;
print "Widget is $widget, it's background color is $color.\n";
# The above is the part where I'm trying to get the proper names (var 
+names maybe that I used) for the $widget so I can read them better.
# as of "MainWindow=$main" in "Widget is MainWindow=HASH(0x1828c84), i
+t's background color is white."
# or "Tk::Label=$label" rather than "Tk::Label=HASH(0x1c02eb8)"

$widget->configure( -bg => $color,);
# $main->update;

if ( my @children = $widget->children ) {
        change_colors2( $_, $color,) for @children;
print "Child widget is $_, it's background color is $color.\n" for @ch
+ildren;
# try to get the proper names (var names maybe that I used) for the $w
+idget/$_ so I can read them better ?!?
# or give names ???

       $main->update;
   }

}
######################################################################
+################


# Q4......... also, who would I use the Tk::Label=HASH(0x1c02eb8) entr
+ies, in a configure, as of:
# Tk::Label=HASH(0x1c03614)->configure(-fg => "gray",);
# as apposed to:
$label->configure(-fg => "gray",);

$main->update;



MainLoop;

[download]
# Extras I'm also after: # Q5........ how would I go about getting sound from a microphone and send it to a speaker # Q6........ and how do I update/upgrade Tk # Am on Windows XP Home # With ActiveState ActivePerl 5.8 # Tk version 800.024 # Also use EnginSite Perl Editor LITE If it's not broken, why not tinker with it some more :)

2006-01-12 Retitled by g0n, as per Monastery guidelines
Original title: 'How do I change the colour of a separator'

Replies are listed 'Best First'.
Re: How do I change the colour of a Tk separator
by zentara (Cardinal) on Jan 12, 2006 at 12:48 UTC
    You asked over 5 unrelated questions in this node. Try to make each question relate to a single problem, and preferably show some code which does or dosn't work.

    First the MenuButton is rather hard to deal with just on it's own, let alone changing colors of it's constituent parts. So all you can do is read it's perldoc, and if it dosn't have an "advertised subwidget" for the particular constituent part, it means you will have to write your own sub-classed version, and change the default color yourself.

    The only example I've seen of manipulating the fonts, colors, and icons of a menu is below. 

    #!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::JPEG;

my $mw = MainWindow->new(
    -title      => 'Testing Tk::Menu',
    -width      => 500,
    -height     => 100,
    -background => 'yellow',
    -name       => 'Demo',
);
$mw->minsize( 500, 300 );

my $folder_image = $mw->Photo(-data =>' 
R0lGODlhFAAQAKIAANnZ2QAAAP//AP///4SGAP///////////yH5BAEAAAAALAAAAAAUAB
+AA 
AANzCLrcgYGgy70YgaDLjaGrCLqsGLoKgAARgaCrEQi6IYOCoRugCLoxgiMjIzgBEQi6IY
+My 
MjIogaC7MSgjGLqMoBoyKEFCgiQkFAiqMYJBQkIoJBQIuiGBJCQkSEKBoAsRSEJCgiQUCL
+qK 
ocuBoMvtDyNACQA7');


my $bf = $mw->fontCreate('big',
   -family=>'arial',
   -weight=>'bold',
   -size=>int(-18*18/14));

my $menubar = $mw->Menu(
    -type => 'menubar',
    -font => "Verdana 18 bold",
#    -font => 'big' 
);

$mw->configure( -menu      => $menubar );
$menubar->configure( -font => "Verdana 18 bold" );
#$menubar->configure( -font => 'big' );    

my $m1 = $menubar->cascade(
    -label     => 'File',
    -tearoff   => 0,
    -menuitems => [
        [
            Button   => 'New',
            -font    => "Verdana 18 bold",
            -command => \&create_new_file
        ],
        [
            Button   => 'Open',
            -command => \&open_file,
            -font => 'big',
            -background => 'black',
            -foreground=> 'white',
            -image => $folder_image,
        ],
        [
            Button   => 'Exit',
            -background => 'red',
            -foreground=> 'white',
            -command => sub {exit}
        ],
    ]
);

MainLoop;

sub create_new_file { print "create_new_file...\n"; }

sub open_file { print "open_file...\n"; }

__END__

    [download]
    The syntax 
    # Tk::Label=HASH(0x1c03614)->configure(-fg => "gray",);

    [download]
    is almost never used. Maybe it's your EnginSite Perl Editor doing it. Boilerplate code generators probably would use that syntax.

    As far as sending sound from the microphone to the speaker, it is more of a mixer setting, that a Perl question. On linux we can use alsactl to set the capture settings on the sound card inputs. There must be something in the Win32 set of modules to control the mixer and microphone mute buttons.

    To upgrade to the latest Perl, go to ActiveState's website and get the latest version. Tk is included.

    Don't believe the "don't upgrade if it isn't broke B.S.". The current Tk version is a major update over the old 024 release. If you write with the older version, your code may not run for everyone with the newer version( which is almost everyone who answers questions). There have been many bugfixes and syntax updates. So if you continue to use the old version, you will find yourself asking questions about something not working, and being told to upgrade.

    I'm not really a human, but I play one on earth. flash japh
[reply]
[d/l]
[select]
      Thanks for the reply zentara... I'll go over your example tonight and see if it's of use.
[reply]

Back to Seekers of Perl Wisdom