1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
|
#!/usr/local/bin/perl
use strict;
use warnings;
use Tk;
use Tk::BrowseEntry;
use Tk::DirTree;
use Spreadsheet::WriteExcel;
my $fenetre_principale = MainWindow->new(-title=>'Journaux d\'inventaire', -background => '#4A44F7',);
$fenetre_principale->geometry("1000x600+60+30");
my ($mon_choix, $retour, $nd, $repertoire, $resume, $elem, $line, $select, $champs, $lst_f, $listeRepertoire);
my (@files, @allfiles, @select, @champs);
my ($choixUn, $choixDeux);
# DEFINITION DES CADRES-BOX
$lst_f = $fenetre_principale->Scrolled(
"Listbox",
-scrollbars => 'e',
-background => 'white',
-foreground =>"black",
)->place( -x => 410, -y => 30, -width => 350, -height => 300, );
$lst_f->bind( "<Button-1>", \&Colonnes );
$listeRepertoire = $fenetre_principale->Scrolled('DirTree',-scrollbars =>'e',-directory=>"C:/Users/xxx/Desktop/",
-command=>\&repertoire)->place( -x => 30, -y => 30, -width => 350, -height => 300, );
$listeRepertoire->configure(-background =>"lightblue", -foreground =>"#CC0063", -showhidden=>1) ;
$listeRepertoire->Subwidget("yscrollbar")->configure(-background => "lightgreen",-troughcolor => "blue") ;
# AFFICHE LES CHAMPS DU FICHIER
$fenetre_principale->BrowseEntry(
-label => 'champsUn',
-choices=> \@champs,
-variable => \$choixUn,
)->pack(qw/ -side left/);
$fenetre_principale->BrowseEntry(
-label => 'champsDeux',
-choices=> \@champs,
-variable => \$choixDeux,
)->pack(qw/ -side left/);
sub Colonnes {
my @select = $lst_f->curselection();
my $elem = $lst_f -> get( $select[0] );
open IN, "<$elem" or die "$!";
while ( my $line = <IN> ) {
if ( $line =~ /^Edition\tPublication/ ) {
@champs = split (/\t/, $line);
}
} # while
} # sub
# bouton action
my $BoutonGO = $fenetre_principale->Button(
-text => "Générer le fichier",
-command => [\&go, \$mon_choix], # code pas à jour...
)->pack(qw/ -side left/); # -padx 100 -pady 450
sub repertoire {
my $nd=shift;
chdir $nd;
$repertoire=$nd;
@files=() ;
$lst_f->delete(0,'end') ;
my @allfiles=() ;
opendir DH,$nd ;
@allfiles=readdir DH ;
closedir DH ;
foreach (@allfiles){
if(-f $_ && $_ =~ /\.utx/){
push(@files,$_) ;
$lst_f->insert('end',$_) ;
}
}
}
#sub go {
# my ($ref_choix) = @_;
# my $choix = ${$ref_choix};
# if ( $choix eq 'Communication' ) { sub_Communication($fenetre_principale); }
# elsif ( $choix eq 'Acquisitions' ) { sub_Acquisitions($fenetre_principale); }
# }
$fenetre_principale->Button(
-text => 'Quitter',
-command => sub { $fenetre_principale->destroy() },
)->place( -x => 900, -y => 100, );
MainLoop; |
Partager