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

my $main = MainWindow->new();

$main->fontCreate('big', -size=> 24 );

    my $tx  = 'Larry';

    my $fr = $main->LabFrame(
        -label     => '3 Stooges',
        -labelside => 'acrosstop',
    )->pack();

    my @choices = ( 'Curly', 'Larry', 'Moe' );
   
    my $be = $fr->BrowseEntry(
        -label     => 'Whoop Whoop',
        -labelPack => [
            -side   => 'left',
            -anchor => 'w',
            -expand => 1,
            -padx   => 4
        ],
        -font => 'big',
        -width    => 20,
        -state    => 'normal',
        -choices  => \@choices,
        -variable => \$tx
    )->pack( -side => 'top', -anchor => 'e' );

    $be->Subwidget('entry')->Subwidget('entry')->configure(
        '-background' => 'white',
        '-fg'         => 'red'
    );
    $be->Subwidget("slistbox")->configure( -background => 'white' );

    $be->Subwidget('entry')->Subwidget('entry')->configure(
        '-background' => 'white',
        '-fg'         => 'red'
    );
    $be->Subwidget("slistbox")->configure( -background => 'white' );

 
    my @choices1 = ( 'A', 'B', 'C' );
    my $tx1 = 'B';
   
    my $be1 = $fr->BrowseEntry(
        -label     => 'Select',
        -labelPack => [
            -side   => 'left',
            -anchor => 'w',
            -expand => 1,
            -padx   => 4
        ],
        -font => 'big',
        -width    => 20,
        -state    => 'normal',
        -choices  => \@choices1,
        -variable => \$tx1
    )->pack( -side => 'top', -anchor => 'e' );

    $be1->Subwidget('entry')->Subwidget('entry')->configure(
        '-background' => 'white',
        '-fg'         => 'blue'
    );
    $be1->Subwidget("slistbox")->configure( -background => 'white' );

    $be1->Subwidget('entry')->Subwidget('entry')->configure(
        '-background' => 'white',
        '-fg'         => 'blue'
    );
    $be1->Subwidget("slistbox")->configure( -background => 'white' );

MainLoop();
[download]

Sorry, here's a more detailed question.... I need to add multiple BrowseEntry to a table and get the selection, and the corresponding value of $layer. The table is built in a loop. I thought I could create a hash key to store when a selection is made in the drop down, but I don't know how to relate it to the $layer. (Why do I get the small window with the script name?) Here's an example

#!/usr/bin/perl
use strict;
use warnings;

use Tk;
use Tk::DialogBox;
use Tk::LabFrame;
use Tk::Table;
use Tk::BrowseEntry;

my $TKmain = MainWindow->new();
my $fontname = '-adobe-times-medium-r-normal--20-140-75-75-p-77-hp-rom
+an8';
my $fontnameb = '-adobe-times-bold-r-normal--20-140-75-75-p-77-hp-roma
+n8';
my @dropdownarray = ( 'Curly', 'Larry', 'Moe' );
my @layers = ( 'lyr1', 'lyr2', 'lyr3', 'lyr4', 'lyr5' );
my @scx = ( '1', '2', '3', '4', '5' );

$TKmain->DialogBox(-title=>"Set Scales",-buttons=>["OK", "Cancel"]);
my $dlgSetScales = $TKmain->DialogBox(-title=>"Set Scales",-buttons=>[
+"OK", "Cancel"]);
$dlgSetScales->resizable(0,0);
$dlgSetScales->{SubWidget}{B_Cancel}->configure(-font=>$fontnameb,-bg=
+>"firebrick");
$dlgSetScales->{SubWidget}{B_OK}->configure(-font=>$fontnameb,-bg=>"fo
+restgreen");

my $f = $dlgSetScales->Frame()->pack(-fill=>'both');
$f->Label(-text=>"Set Scales",-font=>'-adobe-times-bold-r-normal--32-1
+00-75-75-p-57-iso8859-1')->pack();

my $table = $f->Table(-rows=>10,
                          -columns=> 6,
                          -scrollbars=>'e',
                          -fixedrows=>1,
                          -highlightbackground=>'black',
                          -relief => 'raised',
                          -fixedcolumns=>0,
                          -takefocus=>1)->pack(-fill=>'x');

$table->put(0,0,$table->Label(-text=>" *Layer Name* ",-font=>$fontname
+b,-bg=>"cadetblue"));
$table->put(0,1,$table->Label(-text=>" *Scale X* ",-font=>$fontnameb,-
+bg=>"mediumaquamarine"));
$table->put(0,2,$table->Label(-text=>" *Scale Y* ",-font=>$fontnameb,-
+bg=>"cadetblue"));
$table->put(0,3,$table->Label(-text=>" *Factor X* ",-font=>$fontnameb,
+-bg=>"mediumaquamarine"));
$table->put(0,4,$table->Label(-text=>" *Factor Y* ",-font=>$fontnameb,
+-bg=>"cadetblue"));
$table->put(0,5,$table->Label(-text=>" *Map to Layer* ",-font=>$fontna
+meb,-bg=>"mediumaquamarine"));


my ($w,$cnt,%ScaleVal,$NewXScale,$NewYScale);
my $xscale = 1.0002;
my $yscale = 1.00018;
$cnt = 1;

foreach my $layer (@layers)
{
    $ScaleVal{$layer} = {};
    
    my $text = $layer;
    my $color = 'black';
    
    $w = $table->Checkbutton(-text=>$text,-fg=>$color,-anchor=>'w',-va
+riable=>\$ScaleVal{$layer}{CHECK},-font=>$fontname,-activebackground 
+=> "lightgoldenrodyellow");
    $table->put($cnt,0,$w);
    
    $ScaleVal{$layer}{REALFACTORX} = $xscale;
    $ScaleVal{$layer}{REALFACTORY} = $yscale;

    $ScaleVal{$layer}{FACTORX} = sprintf("%0.06f",$xscale);
    $ScaleVal{$layer}{FACTORY} = sprintf("%0.06f",$yscale);

    $ScaleVal{$layer}{SCALEX} = sprintf("%0.01f",(($xscale-1)*12*1000)
+);
    $ScaleVal{$layer}{SCALEY} = sprintf("%0.01f",(($yscale-1)*18*1000)
+);
    
    #create labels w/ current scale
    $w = $table->Label(-textvariable=>\$ScaleVal{$layer}{SCALEX},-font
+=>$fontname,-relief => 'groove');
    $table->put($cnt,1,$w);
    $w = $table->Label(-textvariable=>\$ScaleVal{$layer}{SCALEY},-font
+=>$fontname,-relief => 'groove');
    $table->put($cnt,2,$w);
    $w = $table->Label(-textvariable=>\$ScaleVal{$layer}{FACTORX},-fon
+t=>$fontname,-relief => 'groove');
    $table->put($cnt,3,$w);
    $w = $table->Label(-textvariable=>\$ScaleVal{$layer}{FACTORY},-fon
+t=>$fontname,-relief => 'groove');
    $table->put($cnt,4,$w);
    
    $w = $table->BrowseEntry(-relief => 'groove');
    foreach my $dropdownlist (@dropdownarray)
    {
        $w->insert('end', $dropdownlist);
    }
    $table->put($cnt,5,$w);

    #next row
    $cnt++;
}
$dlgSetScales->Show();
MainLoop();
[download]

UPDATE: See the reply node further below for a correct answer. It still mystifies me why a global hash dosn't work, but the subwidget method will allow you to pull the selection out.

Yeah, you have a tough bug in there, probably due to you trying to stuff too much into a dialogbox. First, to remove the small window, you can withdraw the mainwindow, and not use MainLoop. Thats easy.

The hard problem is that the Dialog dosn't seem to recognize global variables. I wonder if you really need to use a Dialog to put all that table data in there? Can't you just use the mainwindow or a toplevel? It may resolve the problem which I show in my modified version of your code. You can see, within the Dialog the values for my hash %be get printed, but it is not recognized elsewhere, like when you press the ShowValues button. That stumps me, and maybe a smarter monk may know the secret. :-)

If it was me, I would rewrite it without the Dialog.

Read more... (7 kB)

---

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

After a night's sleep, I found a way for you to get the values out of the BrowseEntrys. I still don't know why the global hash didn't work for storing the \$var, but you can resort to pulling the value directly from the BrowseEntry's entry subwidget. Below are 2 versions, the first using the DialogBox, and the second just using a mainwindow, in the readmore. Look at the sub for the $showbutton for the method.

#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::DialogBox;
use Tk::LabFrame;
use Tk::Table;
use Tk::BrowseEntry;

my %be;  #use a hash to store the BrowseEntry's stuff

my $TKmain = MainWindow->new();

$TKmain->withdraw; #eliminates the small main window

my $fontname = '-adobe-times-medium-r-normal--20-140-75-75-p-77-hp-rom
+an8';
my $fontnameb = '-adobe-times-bold-r-normal--20-140-75-75-p-77-hp-roma
+n8';
my @dropdownarray = ( 'Curly', 'Larry', 'Moe' );
my @layers = ( 'lyr1', 'lyr2', 'lyr3', 'lyr4', 'lyr5' );
my @scx = ( '1', '2', '3', '4', '5' );

#$TKmain->DialogBox(-title=>"Set Scales",-buttons=>["OK", "Cancel"]); 
+#redundant

my $dlgSetScales = $TKmain->DialogBox(-title=>"Set Scales",-buttons=>[
+"OK", "Cancel"]);

$dlgSetScales->resizable(0,0);

$dlgSetScales->{SubWidget}{B_Cancel}->configure(-font=>$fontnameb,-bg=
+>"firebrick");

$dlgSetScales->{SubWidget}{B_OK}->configure(-font=>$fontnameb,-bg=>"fo
+restgreen");

my $f = $dlgSetScales->Frame()->pack(-fill=>'both');

$f->Label(-text=>"Set Scales",-font=>'-adobe-times-bold-r-normal--32-1
+00-75-75-p-57-iso8859-1')->pack();

my $table = $f->Table(-rows=>10,
                          -columns=> 6,
                          -scrollbars=>'e',
                          -fixedrows=>1,
                          -highlightbackground=>'black',
                          -relief => 'raised',
                          -fixedcolumns=>0,
                          -takefocus=>1)->pack(-fill=>'x');

$table->put(0,0,$table->Label(-text=>" *Layer Name* ",-font=>$fontname
+b,-bg=>"cadetblue"));
$table->put(0,1,$table->Label(-text=>" *Scale X* ",-font=>$fontnameb,-
+bg=>"mediumaquamarine"));
$table->put(0,2,$table->Label(-text=>" *Scale Y* ",-font=>$fontnameb,-
+bg=>"cadetblue"));
$table->put(0,3,$table->Label(-text=>" *Factor X* ",-font=>$fontnameb,
+-bg=>"mediumaquamarine"));
$table->put(0,4,$table->Label(-text=>" *Factor Y* ",-font=>$fontnameb,
+-bg=>"cadetblue"));
$table->put(0,5,$table->Label(-text=>" *Map to Layer* ",-font=>$fontna
+meb,-bg=>"mediumaquamarine"));


my ($w,$cnt,%ScaleVal,$NewXScale,$NewYScale);
my $xscale = 1.0002;
my $yscale = 1.00018;
$cnt = 1;


foreach my $layer (@layers)
{
    $ScaleVal{$layer} = {};
    
    my $text = $layer;
    my $color = 'black';
    
    $w = $table->Checkbutton(-text=>$text,-fg=>$color,-anchor=>'w',-va
+riable=>\$ScaleVal{$layer}{CHECK},-font=>$fontname,-activebackground 
+=> "lightgoldenrodyellow");
    $table->put($cnt,0,$w);
    
    $ScaleVal{$layer}{REALFACTORX} = $xscale;
    $ScaleVal{$layer}{REALFACTORY} = $yscale;

    $ScaleVal{$layer}{FACTORX} = sprintf("%0.06f",$xscale);
    $ScaleVal{$layer}{FACTORY} = sprintf("%0.06f",$yscale);

    $ScaleVal{$layer}{SCALEX} = sprintf("%0.01f",(($xscale-1)*12*1000)
+);
    $ScaleVal{$layer}{SCALEY} = sprintf("%0.01f",(($yscale-1)*18*1000)
+);
    
    #create labels w/ current scale
    $w = $table->Label(-textvariable=>\$ScaleVal{$layer}{SCALEX},-font
+=>$fontname,-relief => 'groove');
    $table->put($cnt,1,$w);
    $w = $table->Label(-textvariable=>\$ScaleVal{$layer}{SCALEY},-font
+=>$fontname,-relief => 'groove');
    $table->put($cnt,2,$w);
    $w = $table->Label(-textvariable=>\$ScaleVal{$layer}{FACTORX},-fon
+t=>$fontname,-relief => 'groove');
    $table->put($cnt,3,$w);
    $w = $table->Label(-textvariable=>\$ScaleVal{$layer}{FACTORY},-fon
+t=>$fontname,-relief => 'groove');
    $table->put($cnt,4,$w);
  

#    foreach my $dropdownlist (@dropdownarray)
#    {
     
#                $w->insert('end', $dropdownlist);
#    }


     
     $be{$cnt}{'var'} = $dropdownarray[0];

     $be{$cnt}{'widget'} = $table->BrowseEntry(
        -label     => "BE $cnt",
        -labelPack => [
            -side   => 'left',
            -anchor => 'w',
            -expand => 1,
            -padx   => 4
        ],
        
        -width    => 20,
        -state    => 'normal',
        -choices  => \@dropdownarray,
        -variable => \$be{$cnt}{'var'}, # dosn't seem to work globally
                                        # for some unknown glitch
        -relief => 'groove'
     );


    $table->put($cnt,5, $be{$cnt}{'widget'} );

    #next row
    $cnt++;
    
}


my $showbutton = $f->Button(-text => 'Show Values',
                        -bg => 'white',
                        -command => sub{
                             
                            for my $row (1..( $cnt -1 ) ){
                                   my $widget = $table->get($row,5);
                                   print "$widget\n";
                                   print $widget->Subwidget('entry')->
+Subwidget('entry')->get(),"\n";
                                }
                        
                        })->pack();

$dlgSetScales->Show();

#MainLoop();  # to exit after Dialog close
[download]