To get you started, Tk::HList (Tk::Tree) colors are best controlled by Tk::ItemStyle. So it's really a question of setting up your styles, and browsecmd, etc, to do exactly what you want. Here is an example I had handy.
#!/usr/bin/perl
#------------------------
use strict;
use Tk;
use Tk::ItemStyle;
use Tk::Tree;
my $TK_top = MainWindow->new();
# create tree
my $TK_tree = $TK_top->Scrolled(
'Tree',
-background => 'white',
-selectbackground => 'black',
-selectforeground => 'hotpink',
-scrollbars => 'osoe',
-browsecmd => \&TK_tree_FileSelect,
-command => \&TK_tree_FileSelect
)->form(
-left => '%0',
-top => '%5',
-bottom => '%70',
-right => '%95'
);
# create style for different colors
my $Style_Red = $TK_tree->ItemStyle(
'text',
-foreground => 'red',
-background => 'white',
-selectforeground =>'purple',
);
my $Style_Blue = $TK_tree->ItemStyle(
'text',
-foreground => 'blue',
-background => 'white',
-selectforeground =>'orange',
);
my $Style_Green = $TK_tree->ItemStyle(
'text',
-stylename => 'green',
-foreground => 'green',
-background => 'white',
-selectforeground =>'cyan',
);
my $Style_Black = $TK_tree->ItemStyle(
'text',
-foreground => 'black',
-background => 'white',
-selectforeground =>'yellow',
);
# create exit button
my $TK_Button_exit = $TK_top->Button( -font => 'code' )->form(
-right => [ '%100', '-20' ],
-bottom => [ '%100', '-20' ]
);
$TK_Button_exit->configure(
-text => 'Exit',
-relief => 'raised',
-width => 30,
-height => 1,
-command => sub { exit; }
);
PopulateTree();
MainLoop();
sub PopulateTree {
my $entry;
$entry = $TK_tree->addchild(
"",
-text => "RED",
-data => "",
-itemtype => 'text'
);
$TK_tree->entryconfigure( $entry, -style => $Style_Red );
$entry = $TK_tree->addchild(
"",
-text => "GREEN",
-data => "",
-itemtype => 'text'
);
$TK_tree->entryconfigure( $entry, -style => $Style_Green );
$entry = $TK_tree->addchild(
"",
-text => "BLUE",
-data => "",
-itemtype => 'text'
);
$TK_tree->entryconfigure( $entry, -style => $Style_Blue );
$entry = $TK_tree->addchild(
"",
-text => "BLACK",
-data => "",
-itemtype => 'text'
);
$TK_tree->entryconfigure( $entry, -style => $Style_Black );
$entry = $TK_tree->addchild(
"",
-text => "RED",
-data => "",
-itemtype => 'text'
);
$TK_tree->entryconfigure( $entry, -style => $Style_Red );
$entry = $TK_tree->addchild(
"",
-text => "GREEN",
-data => "",
-itemtype => 'text'
);
$TK_tree->entryconfigure( $entry, -style => $Style_Green );
}
sub TK_tree_FileSelect {
my $entry = shift;
if (@_) {
my $style = $TK_tree->itemCget( $entry, 0, -style );
if ( $style eq $Style_Green ) {
$TK_tree->configure( -selectbackground => 'gray45' );
}
elsif ( $style eq $Style_Red ) {
$TK_tree->configure( -selectbackground => 'red' );
}
elsif ( $style eq $Style_Blue ) {
$TK_tree->configure( -selectbackground => 'blue' );
}
elsif ( $style eq $Style_Black ) {
$TK_tree->configure( -selectbackground => 'black' );
}
return;
$TK_tree->update();
}
}
| [reply]
[d/l] |
Thanks for the reply. Unfortunately, the problem is not the ItemStyle definition. As you can see in my code, I use the Options Database to set the background and foreground colors and I pass the selectbackground settings directly to the Tk::Tree at the time of creation. That's why even after explicitly defining the ItemStyle for my tree items, the behavior is still the same :-/.
my $style = $tree->ItemStyle(
'imagetext',
-foreground => 'black',
-background => 'white',
-selectforeground =>'white',
);
for my $top ( 1 .. 3) {
$tree->add( $top, -text => $top );
for ( 'A' .. 'C') {
my $q = $tree->add( "$top.$_", -text => "$_" );
$tree->entryconfigure("$top.$_", -style => $style);
}
}
| [reply]
[d/l] |
It gets to be a real juggling act when you try to finesse the colors in these lists. You always run into a situation where one setting interferes with another. You just need to experiment. Try this:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Tree;
use Tk::ItemStyle;
my $fgcolor = "#000000"; # foreground color
my $bgcolor = "#FFFFFF"; # background color
my $text_font = 'helvetica 12'; # Body text font
my $mw = MainWindow->new();
$mw->optionAdd("*background", $bgcolor);
$mw->optionAdd("*foreground", $fgcolor);
$mw->optionAdd("*rotext*font", $text_font);
$mw->optionAdd("*tree*font", $text_font);
$mw->optionAdd("*entry*font", $text_font);
my $tree;
$tree = $mw->Scrolled('Tree',
-font=>$text_font,
-scrollbars=>'ose',
-selectmode=>'extended',
-selectbackground=>'white',
-highlightcolor=>'white',
-highlightthickness => 0,
-drawbranch=>0,
-browsecmd=>sub {
foreach ($tree->selectionGet) {
if (/\./) { # do not allow selection of top level i
+tems
$tree->configure(-selectbackground => 'blue')
}else{
# $tree->selectionClear($_);
$tree->configure(-selectbackground => 'white')
}
}
$tree->anchorClear()
}
)->pack(-side=>'top', -fill=>'both', -expand=>1);
$tree->columnWidth(0, -char, 90); #get full row color
# create style for different colors
my $S1 = $tree->ItemStyle(
'imagetext',
-foreground => 'black',
-background => 'white',
-selectforeground =>'black',
-selectbackground =>'white',
);
my $S2 = $tree->ItemStyle(
'imagetext',
-foreground => 'black',
-background => 'white',
-selectforeground =>'yellow',
-selectbackground =>'blue',
);
for my $top ( 1 .. 3) {
$tree->add( $top, -text => $top, -style=> $S1 );
for ( 'A' .. 'C') {
$tree->add( "$top.$_", -text => "$_", -style=> $S2 );
}
}
MainLoop();
| [reply]
[d/l] |