daily pastebin goal
44%
SHARE
TWEET

Tk example with inner sub

hakonhagland Nov 22nd, 2017 58 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #! /usr/bin/env perl
  2.  
  3. use strict;
  4. use warnings;
  5. use Tk;
  6. use Tk::LabFrame;
  7.  
  8.  
  9. #####################
  10. sub choose_doc_type {
  11. #####################
  12.     my $mw = MainWindow->new;
  13.     # Mainwindow: sizex/y, positionx/y
  14.     $mw->geometry("210x260-0+0");
  15.  
  16.     # Default value
  17.     my $doc_type = "";
  18.  
  19.     my $frame = $mw->LabFrame(
  20.         -label => "Fax/Doc Type",
  21.         -labelside => 'acrosstop',
  22.         -width => 180,
  23.         -height => 200,
  24.     )->place(-x=>10,-y=>10);
  25.  
  26.     # Put these values into the frame
  27.     $frame->Radiobutton(
  28.         -variable => \$doc_type,
  29.         -value => 'RC_SAVE',
  30.         -text => 'Docs for RC',
  31.     )->place( -x => 10, -y => 5 );
  32.     $frame->Radiobutton(
  33.         -variable => \$doc_type,
  34.         -value => 'OCP_SAVE',
  35.         -text => 'OCP Docs',
  36.     )->place( -x => 10, -y => 30 );
  37.     $frame->Radiobutton(
  38.         -variable => \$doc_type,
  39.         -value => 'NV_SAVE',
  40.         -text => 'New Vendor Docs.',
  41.     )->place( -x => 10, -y => 55 );
  42.     $frame->Radiobutton(
  43.         -variable => \$doc_type,
  44.         -value => 'DELETE',
  45.         -text => 'Junk. Delete it',
  46.     )->place( -x => 10, -y => 80 );
  47.     $frame->Radiobutton(
  48.         -variable => \$doc_type,
  49.         -value => 'NADA',
  50.         -text => 'Leave it.',
  51.     )->place( -x => 10, -y => 105 );
  52.     $frame->Radiobutton(
  53.         -variable => \$doc_type,
  54.         -value => 'SAVE_FAX',
  55.         -text => 'Other - Save it',
  56.     )->place( -x => 10, -y => 130 );
  57.     $frame->Radiobutton(
  58.         -variable => \$doc_type,
  59.         -value => 'AP_SAVE',
  60.         -text => 'AP Docs',
  61.     )->place( -x => 10, -y => 130 );
  62.    
  63.     my $button_frame = $mw->Frame()->pack(-side => "bottom");
  64.     my $ok_button = $button_frame->Button(-text => 'OK',
  65.                                           -command => [$mw=>'destroy']
  66.                                       )->pack(-side => "left");      
  67.     MainLoop;
  68.  
  69.     #print $doc_type . "\n";
  70.     #chomp (my $jj = <STDIN>);
  71.     return $doc_type;
  72.  
  73. ############################
  74. } # end of sub choose doc type
  75. ############################
  76.  
  77. #####################
  78. sub carr_docs_box {
  79. #####################
  80.  
  81.     my ($c_no) = @_;
  82.  
  83.     my $mw = MainWindow->new;
  84.     $mw->geometry("180x270-0-30");
  85.     $mw->title("Check Button Select");
  86.  
  87.     my @check = (undef) x 10;
  88.     my $doc_string;
  89.  
  90.     my $check_frame = $mw->Frame()->pack(-side => "top");
  91.     $check_frame->Label(-text=>"Select Included Documents.")->pack(-side => "top")->pack();
  92.  
  93.     $check_frame->Checkbutton(-text => 'BC Agrm',
  94.                                      -variable => \$check[1],
  95.                                      -onvalue => '_BCA',
  96.                                      -offvalue => '')->pack();
  97.  
  98.     $check_frame->Checkbutton(-text => 'Bond',
  99.                                      -variable => \$check[2],
  100.                                      -onvalue => '_ATH',
  101.                                      -offvalue => '')->pack();
  102.  
  103.     $check_frame->Checkbutton(-text => 'Gen Liab. Insr.',
  104.                                      -variable => \$check[3],
  105.                                      -onvalue => '_INL',
  106.                                      -offvalue => '')->pack();
  107.  
  108.     $check_frame->Checkbutton(-text => 'Auto Insr.',
  109.                                      -variable => \$check[4],
  110.                                      -onvalue => '_INC',
  111.                                      -offvalue => '')->pack();
  112.  
  113.     $check_frame->Checkbutton(-text => 'Indp. Contractor',
  114.                                      -variable => \$check[5],
  115.                                      -onvalue => '_IND',
  116.                                      -offvalue => '')->pack();
  117.  
  118.     $check_frame->Checkbutton(-text => 'Profile',
  119.                                      -variable => \$check[6],
  120.                                      -onvalue => '_PRF',
  121.                                      -offvalue => '')->pack();
  122.  
  123.     $check_frame->Checkbutton(-text => 'W9 Form',
  124.                                      -variable => \$check[7],
  125.                                      -onvalue => '_W9',
  126.                                      -offvalue => '')->pack();
  127.  
  128.     $check_frame->Checkbutton(-text => 'Rush Pay Agrm.',
  129.                                      -variable => \$check[8],
  130.                                      -onvalue => '_RP',
  131.                                      -offvalue => '')->pack();
  132.  
  133.     $check_frame->Checkbutton(-text => 'Other',
  134.                                      -variable => \$check[9],
  135.                                      -onvalue => '_OTH',
  136.                                      -offvalue => '')->pack();
  137.  
  138.     my $button_frame = $mw->Frame()->pack(-side => "bottom");
  139.     my $ok_button = $button_frame->Button(
  140.         -text => 'OK',
  141.         #-command => \&check_sub)->pack(-side => "left");
  142.         -command => sub {
  143.             check_sub( $mw, \@check, \$doc_string, $c_no )
  144.         })->pack(-side => "left");
  145.  
  146.     # summary sub
  147.     sub check_sub {
  148.  
  149.         my ($mw, $check, $doc_string, $c_no) = @_;
  150.        
  151.         # check to see if they selected quick Pay
  152.         if (defined $check->[8] && $check->[8] eq '_RP') {
  153.             # user says that recvd a Rush Pay agrm
  154.             # verify rush pay agrm and set up rush pay
  155.             rush_pay_set_up($c_no);
  156.            
  157.         }
  158.         $$doc_string = join "", grep { defined $_ } @$check;
  159.         #print "Doc " . $doc_string . "\n";
  160.         #chomp (my $TT=<STDIN>);
  161.  
  162.         $mw->destroy;
  163.     }
  164.  
  165.     MainLoop;
  166.  
  167.     return $doc_string;
  168.  
  169.     #########      
  170. } # end of sub
  171. ############
  172.  
  173. my $dt; # type of documents viewed
  174. my $quit = 'n';
  175. my $test_cno = 1111;
  176.  
  177. while ($quit ne 'q') {
  178.     ($dt) = choose_doc_type();
  179.     print "quit equals: $quit\n";
  180.     if ($dt eq 'OCP_SAVE') { # Classify vendor docs.
  181.  
  182.         my $doc_string = carr_docs_box($test_cno);  
  183.         print "Doc String would be: " . $doc_string . "\n";
  184.     }
  185.     print "Press (q) to quit Enter to continue any other key to quit.\n";
  186.     chomp ($quit = <STDIN>);
  187. }
RAW Paste Data
Top