develooper Front page | perl.beginners | Postings from January 2002

Re: help with tk

From:
Murzc
Date:
January 8, 2002 19:48
Subject:
Re: help with tk
Message ID:
14.208e084c.296d1770@aol.com



> > I have a TK issue.
> >
> > This code creates the initial TK box.
> >
> >
> > When the user clicks the button of his choice, the TK box disappears into
> the task bar.
> > When the user clicks the task bar on the program's name,
> > a window of a DOS screen pops up and asks the user
> > "Enter Perl Script to execute."
> >
> > 
>   
> > The question we are having.
> > Why do it in 2 steps. 1: Click the TK button.  2: Click the Task bar.
> > Why not do it one step if possible?
> > Can the DOS screen pop up right away after the button is clicked?
> >
> > If you need more of the code let me know.
> >
> > Thank you.
> >
> 
> I have been asked to post all the code...
> 
> Here is part of it.    I am sorry it is so long.
> Any help is appreciated.
> 
> 
> ***************************
> ##  The code and some subroutines
> 
> require 5.004;
> 
> use English;
> use Tk;
> 
> use vars qw/$MW $TOP $wc $wc_t/;
> 
> $TOP = Tk::MainWindow->new;
> 
> $TOP->title('Tk screen');
> $TOP->configure(-background => lc('PeachPuff1'));
> $TOP->geometry('+20+100');
> 
> 
> 
> 
> Macro_Proc();
> 
> 
> Tk::MainLoop;
> 
> 
> 
> 
> ############################################################################
> 
> ############################################################################
> # Macro_Proc
> use vars qw/$TOP/;
> 
> sub Macro_Proc {
> 
> 
> 
> 
>     if ($TOP) { $TOP->destroy; }
> 
>     $TOP = Tk::MainWindow->new;
> 
>     # Create a top-level window that displays a bunch of entries with 
>     # tabs set up to move between them.
> 
>     my($demo) = @_;
> 
> 
> 
>     my $size = -18;
>     $TOP->fontCreate('C_big',-family => 'arial', -weight => 'normal', -size
> => int($size*18/14));
> 
> 
>     $STATUS_VAR = "Select Option";
> 
>     $status = $TOP->Label(-textvariable => \$STATUS_VAR, qw/-anchor c/,
>     -background => 'DarkSeaGreen3',
>     -font => 'C_big',
>         );
> 
>     $status->pack(-fill => 'both');
> 
>     $STATUS_VAR2 = "Launcher  $Version";
> 
>     # 01/25/00  Changed font
>     $status = $TOP->Label(-textvariable => \$STATUS_VAR2, qw/-anchor e/,
>     -background => 'DarkSeaGreen3',
>     -font => [-weight => normal, -size => 9],
>         );
>     $status->pack(-fill => 'both');
> 
>     my $f = $TOP->Frame(-background => 'DarkSeaGreen1',
>             -relief => 'groove',
>             -borderwidth => 2,
>             )->pack(-fill => 'both' );
>     my $row = 0;
> 
> 
>     $TOP->bind('<Return>' => sub {
>         $TOP->eventGenerate('<Tab>')   });
> 
> 
>     $TOP->configure(-background => 'DarkSeaGreen3');
> 
>     foreach my $function ('Individual',
> 
>               'Exit')
>     {  
>      my $b = $f->Button(
>             -text    => $function,
>         -pady    => 0,
>         -font    => [-weight => bold, -size => 9],
>         -cursor  => 'arrow',
>         -height  => 1,
>         -background => 'SeaGreen1',
>         -activebackground => 'SeaGreen3',
>             -width   => 30,
>             -command => sub {   
>                  if ($function =~ /Exit/)   {exit}
>                  if ($function =~ /Individual/)     
> {Param('do_individual')}
>     
>                 },
>          );
> 
>          $b->pack(qw/-side top -expand no -padx 200 -pady 15/);
> 
>     }
> 
> 
> 
> } # end form
> 
> 
> ###############################################
> sub do_individual {
> 
>     $TOP->iconify;
>     $TOP->withdraw;
> 
>     $wpar->iconify;
>     $wpar->withdraw;
> 
> 
>     print "\nEnter Perl Script to execute: ";
> 
>     $pgm = <STDIN>;
>     chomp($pgm);
>     unless ($pgm =~ /\./) {$pgm .= '.pl'}
>     
>     if (!-e $pgm) { $pgm_to_exec = "c\\$pgm"}
> 
>     if (!-e $pgm) { 
>         msg_error("Program \'$pgm\' can't be found.");
> 
>         print "\nPress Enter key to continue ....";
>         $dummy = <STDIN>;
> 
>         $TOP->deiconify;
>         return  
>     }
>     
>     $cntFlag=0;
>     if($cntFlag ne 1)
>     {
>     if(!opendir(WRK, "d:/wrk"))
>     #@list=readdir(WRK);
>     #if (!@list)
>     {
>         opendir(WRK, "c:/worker");
>         #@list=readdir(WRK);
>         @list=grep(/^$Infile\.*/, readdir(WRK));
>         if (@list)
>         {
>             $Infile="c:/worker/" . $Infile;
>             $cntFlag=1;
>         }
>     }
>     else
>     {
>         $Infile="d:/wrk/" . $Infile;    
>         $cntFlag=1; 
>     }
>     }
>     system "perl $pgm $Infile ";
>     
> 
> 
>     $TOP->deiconify;
> }
> 
> 
> 
> ############################################################################
> # Param
> 
> sub Param {
> 
>             $subroutine = shift;    # Subroutine to call after ParamInput
> 
>             $wpar = $TOP->Toplevel();
> 
>             $wpar->title('Parameter Entry');
>             $wpar->configure(-background => 'DarkSeaGreen3');
> 
>             $header = "Enter Parameters";
> 
>             $statuspar = $wpar->Label(-textvariable => \$header, qw/-anchor
> c/,
>                 -background => 'DarkSeaGreen3',
>                 -font => 'C_big',
>                 );
> 
>             $statuspar->pack(-fill => 'both');
> 
>             $OrderNo = "$Infile";
> 
>             $Match = "$strMatch";
> 
>             my $f = $wpar->Frame(-background => 'DarkSeaGreen3')->pack(-f
> ill
> => 'both');
>             my $row = 0;
>             foreach my $field ('Search Order :', 'String to Match:') {
>                 if ($field =~ /Search Order /) { 
>                     $e = $f->Entry(-textvariable => \$Infile, qw/-relief
> sunken -width 30/,
>                         -font   => [-weight => normal, -size => 9],
>                     );
>                 }
>                 if ($field =~ /String to Match/) { 
>                     $e = $f->Entry(-textvariable => \$strMatch, qw/-relief
> sunken -width 30/,
>                         -font   => [-weight => normal, -size => 9],
>                     );
>                 }   
>                 my $l = $f->Label(-text => $field,
>                         -font    => [-weight => bold, -size => 9],
>                         -anchor => 'e', -justify => 'right');
> 
>                 Tk::grid( $l, -row => $row, -column => 0, -sticky => 'e');
> 
>                 Tk::grid( $e, -row => $row++, -column => 1,-sticky => 
> 'ew');
> 
>                 $f->gridRowconfigure(1,-weight => 1);
>   
>                 $e->focus if $field eq 'Search Order ID:';
>             }
> 
>             $wpar->bind( '<Return>' => sub  { &$subroutine; } );
> 
>             my $b = $wpar->Button(
>                 -text    => 'OK',
>                 -pady    => 0,
>                 -font    => [-weight => bold, -size => 9],
>                 -cursor  => 'arrow',
>                 -height  => 1,
>                 -background => 'SeaGreen1',
>                 -activebackground => 'SeaGreen3',
>                     -width   => 8,
>                     -command => sub { &$subroutine; },    #   Proceed to 
> call
> appropriate subroutine pressed
>             #-command => [ $b->bind('<Enter>' => sub  { &$subroutine; })]
>                 );
>             #$b->bind( '<Enter>' => sub  { &$subroutine; } );
> 
>                 $b->pack(qw/-side top -expand no -padx 120 -pady 15/);
> 
>             $wpar -> focusForce;
> 
> }
> 
> 
> ************************
> 
> 
> 
> 




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About