variable et bouton

**julien terrier** · 29/08/2017, 16h01

Bonjour,

je pensais qu'il était possible de récupérer le retour d'une fonction de callback d'un bouton mais au lieu de ca je récupère une table de HASH (button.frame.frame) bref ce n'est pas ce que j’espérais...

Dans mon exemple je crée une fenêtre de navigation pour récupérer un fichier.

Prog principale:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

my $xorPath = &CREATE_WINDOW;

Module IHM:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
sub CREATE_WINDOW {
 
   my $mw = MainWindow->new( -background => $window_color, -title => "Add Xor GDS" );
    # Give a modern look & feel to the Tk GUI : anti-alias font and a thin border
    $mw->optionAdd("*font", "-*-arial-normal-r-*-*-*-120-*-*-*-*-*-*");
    $mw->optionAdd("*borderWidth", 1);
 
 
    #$mw->geometry("700x720");
    $mw->geometry("500x150");
 
    my $mw_scrolled = $mw->Scrolled( "Pane", -scrollbars => 'e', -borderwidth => 2, -relief => 'groove', -sticky => 'nwse', -background => $window_color );
    $mw_scrolled->pack( -in => $mw, -fill => 'both', -expand => 1 );
    $mw_scrolled->{SubWidget}->{yscrollbar}->configure( -width => 10, -background => $button_color );
 
    my $Menu_techno_scrolled = &CREATE_WINDOW_COMMON($mw_scrolled,
                                                     $directory,
                                                     $directory
    );
 
    $mw_scrolled->Button( -text => "Save", -command => [\&save_xorgds, $mw], -background => $button_color, -font => $font )
      ->grid( -columnspan => 2, -sticky => "nsew", -padx => 5, -pady => 5 );
 
    $mw_scrolled->Button( -text => "Exit", -command => [\&close_xor_ihm, $mw], -background => $button_color, -font => $font )
      ->grid( -columnspan => 2, -sticky => "nsew", -padx => 5, -pady => 5 );
 
# Run GUI !!
MainLoop;
return $gds1;
}
 
sub save_xorgds {
 
	my $mw = shift;
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
 
}
 
sub close_xor_ihm {
 
	$gds1 = "none";
	my $mw = shift;
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}

$gds1 est une variable exportée depuis un autre module soit elle vaut le path choisi dans mon navigateur soit elle vaut none cela fonctionne mais je trouve cette méthode assez peu élégante...

Au départ j'avais en tete de récupérer le retour d'une fonction de callback bouton et en fonction traiter l’événement, mais je n'ai pas réussi a manipuler le retour correctement...

Je voulais faire quelques choses comme ca:

Prog principale:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

my $xorPath = &CREATE_WINDOW;

Module IHM:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
my tmp = "";
sub CREATE_WINDOW {
 
   my $mw = MainWindow->new( -background => $window_color, -title => "Add Xor GDS" );
    # Give a modern look & feel to the Tk GUI : anti-alias font and a thin border
    $mw->optionAdd("*font", "-*-arial-normal-r-*-*-*-120-*-*-*-*-*-*");
    $mw->optionAdd("*borderWidth", 1);
 
 
    #$mw->geometry("700x720");
    $mw->geometry("500x150");
 
    my $mw_scrolled = $mw->Scrolled( "Pane", -scrollbars => 'e', -borderwidth => 2, -relief => 'groove', -sticky => 'nwse', -background => $window_color );
    $mw_scrolled->pack( -in => $mw, -fill => 'both', -expand => 1 );
    $mw_scrolled->{SubWidget}->{yscrollbar}->configure( -width => 10, -background => $button_color );
 
    my $Menu_techno_scrolled = &CREATE_WINDOW_COMMON($mw_scrolled,
                                                     $directory,
                                                     $directory
    );
 
    my $ex = $mw_scrolled->Button( -text => "Save", -command => [\&save_xorgds, $mw, $tmp], -background => $button_color, -font => $font )
      ->grid( -columnspan => 2, -sticky => "nsew", -padx => 5, -pady => 5 );
 
    $mw_scrolled->Button( -text => "Exit", -command => [\&close_xor_ihm, $mw], -background => $button_color, -font => $font )
      ->grid( -columnspan => 2, -sticky => "nsew", -padx => 5, -pady => 5 );
 
# Run GUI !!
MainLoop;
return $ex;
}
 
sub save_xorgds {
 
	my $mw = shift;
        my $tmp = shift;
        $tmp = $gds1;
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
        return $tmp
 
}
 
sub close_xor_ihm {
 
	my $mw = shift;
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}

Avec $tmp modifier dans save_xorgds recuperer la variable modifiée dans $ex puis retourner $ex mais ca ne marche pas...

**dmganges** · 30/08/2017, 04h45

Bonjour,
Je n'ai pas tout compris, sauf :

Dans mon exemple je crée une fenêtre de navigation pour récupérer un fichier.

Je suis parti de ce que t'avait fait djibril.

Rudimentaire, en espérant que cela puisse t'aider :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Tk;
 
my $Filepath = 'E:/_DEV';
 
# Creation de la fenetre ( parent widget )
my $mw = MainWindow->new( -title => "Check Teg width" );
my $mon_cadre = $mw->Frame(
	-borderwidth => 5,
	-relief      => 'groove'
);
 
$mon_cadre->Label( -text => "Souhaitez-vous stopper le programme ?" )->pack;
 
my $bouton_yes = $mon_cadre->Button(
	-text    => "YES",
	-command => \&arret_programme,
);
 
my $bouton_non = $mon_cadre->Button( 
	-text => "NO", 
	-command => \&fermer_interface_graphique, 
);
 
# Choix Fichier
my $bouton_file = $mon_cadre->Button(
	-text    => "Fichier",
	-command => sub {
		get_file();
	},
);
 
$mon_cadre->pack( -side => 'top', -fill => 'x' );
$bouton_file->pack( -side => 'left',  -padx => 50, -pady => 5 );
$bouton_yes->pack( -side => 'left',  -padx => 50, -pady => 5 );
$bouton_non->pack( -side => 'right', -padx => 50, -pady => 5 );
 
MainLoop;
 
print "suite de mon programme avec Fichier = $Filepath\n";
 
########################
# Recherche d'un fichier
#
sub get_file {
  my @types =
       (["All files",        '*'],
        ["Log files", [qw/.txt .log/]],
       );
  $Filepath = $mw->getOpenFile(-filetypes => \@types) or return();
  return($Filepath);
}
 
sub fermer_interface_graphique {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}
 
sub arret_programme {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
 
	# Arrêt du programme complet
	exit;
}

[Edit : 05:22]
Dans sub get_file j'ai oublié le initialdir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
########################
# Recherche d'un fichier
#
sub get_file {
  my @types =
       (["All files",        '*'],
        ["Log files", [qw/.txt .log/]],
       );
  $Filepath = $mw->getOpenFile(-initialdir => $Filepath, -filetypes => \@types) or return();
  return($Filepath);
}

**julien terrier** · 30/08/2017, 08h51

Bonjour merci pour le retour,

la boite oui/non est dissocier de la boite de navigation

Boite oui/non:

Nom : box_yesno.png
Affichages : 177
Taille : 37,3 Ko

Boite de navigation:

Nom : box_xorgds.png
Affichages : 158
Taille : 18,8 Ko

Nom : browser.png
Affichages : 173
Taille : 64,5 Ko

Voila ce que j'obtiens avec le code posté ci-dessus.

Désolé si je ne suis pas clair dans mes explications, en faite ma question porte sur la méthode a utiliser pour récupérer le retour d'une fonction callback associé a un bouton de la bibliothèque Tk.

La commande du bouton étant associée a une fonction si par exemple on modifie le contenue d'une variable dans cette fonction comment fait-on pour récupérer cette variable modifiée sans la déclarer en global, j'espère être plus clair.

Merci pour votre aide.

**dmganges** · 30/08/2017, 09h32

c'est bien plus moi qui devient dur de la comprenette avec l'âge que toi qui n'est pas clair

Je n'ai pas le temps de modifier ton code, et n'étant plus capable d'écrire de tête du code sans erreur, voici un copier/coller d'un bouton perso qui semble faire ce dont tu as besoin :
une variable modifiée par une fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
my $optionmenu_RDeb = $cadre_avancement->Scale(
	-background => $couleur_commune,
	-orient => 'h',	 	-digit=>1,
	-length => 100,
	-from => 1,		-to => 100,
	-variable => \$config{DEFAUT}{RDeb},
	-command => \&affichage_titre,
	-sliderlength => 10,
);

Peu importe que ca soit un Scale ou un Bouton.
Les deux informations dont tu as besoin :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

-variable => \$config{DEFAUT}{RDeb},

à -variable est associé une variable que l'on passe par adresse. Là, la variable se trouve être issue d'un fichier de config mais ça pourrait être $toto, ce qui donnerait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

-variable => \$toto,

ET

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

-command => \&affichage_titre,

à -command on passe la fonction, là aussi par adresse, ce qui dans mon exemple pourrait donner :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
# Choix Fichier
my $bouton_file = $mon_cadre->Button(
	-text    => "Fichier",
        -variable => \$Filepath,
	-command => \&get_file,
	},
);

Code non testé & neurone HS

Je ne peux pas revenir avant 14h00.
@+

**dmganges** · 30/08/2017, 14h12

J'ai un peu plus de temps cet aprem.

Désolé, le widget button ne connait pas l'option -variable mais seulement -textvariable qui modifie le texte écrit sur le bouton.
Ce n'est pas la première fois que je me fais avoir

Le bouquin de Nancy Walsh à télécharger en pdf.
Et le Mastering en ligne.

Là pour l'instant je ne vois pas comment faire sans passer par une variable globale

**julien terrier** · 30/08/2017, 15h15

Merci pour les infos

Je n'ai pas eu le temps de tester tes exemples.

Tu es sur que -variable n'est pas reconnu car dans la doc mastering il y a un tableau récapitulatif des options bouton.

Sample:

Nom : option1.png
Affichages : 151
Taille : 99,1 Ko

Nom : option1.png
Affichages : 151
Taille : 99,1 Ko

Nom : option2.png
Affichages : 191
Taille : 345,7 Ko

Lol je viens de voir que l'option variable n'est pas coché

**dmganges** · 30/08/2017, 15h37

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Tk;
 
my $Filepath = 'E:/_DEV';
 
# Creation de la fenetre ( parent widget )
my $mw = MainWindow->new( -title => "Check Teg width" );
my $mon_cadre = $mw->Frame(
	-borderwidth => 5,
	-relief      => 'groove'
);
 
$mon_cadre->Label( -text => "Souhaitez-vous stopper le programme ?" )->pack;
 
my $bouton_yes = $mon_cadre->Button(
	-text    => "YES",
	-command => \&arret_programme,
);
 
my $bouton_non = $mon_cadre->Button( 
	-text => "NO", 
	-command => \&fermer_interface_graphique, 
);
 
# Choix Fichier
my $bouton_file = $mon_cadre->Button(
	-text    => "Fichier",
	-variable => \$Filepath,
	-command => sub {&get_file()},
);
 
$mon_cadre->pack( -side => 'top', -fill => 'x' );
$bouton_file->pack( -side => 'left', -padx => 50, -pady => 5 );
$bouton_yes->pack( -side => 'left',  -padx => 50, -pady => 5 );
$bouton_non->pack( -side => 'right', -padx => 50, -pady => 5 );
 
MainLoop;
 
print "suite de mon programme avec Fichier = $Filepath\n";
 
########################
# Recherche d'un fichier
#
sub get_file {
  my @types =
       (["All files",        '*'],
        ["Log files", [qw/.txt .log/]],
       );
  $Filepath = $mw->getOpenFile(-initialdir => $Filepath, -filetypes => \@types) or return();
  return($Filepath);
}
 
sub fermer_interface_graphique {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}
 
sub arret_programme {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
 
	# Arrêt du programme complet
	exit;
}

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
E:\_DEV\Terrier>perl Terrier.pl
unknown option "-variable" at C:/Strawberry/perl/site/lib/Tk/Widget.pm line 205.
 at Terrier.pl line 33.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Tk;
 
my $Filepath = 'E:/_DEV';
 
# Creation de la fenetre ( parent widget )
my $mw = MainWindow->new( -title => "Check Teg width" );
my $mon_cadre = $mw->Frame(
	-borderwidth => 5,
	-relief      => 'groove'
);
 
$mon_cadre->Label( -text => "Souhaitez-vous stopper le programme ?" )->pack;
 
my $bouton_yes = $mon_cadre->Button(
	-text    => "YES",
	-command => \&arret_programme,
);
 
my $bouton_non = $mon_cadre->Button( 
	-text => "NO", 
	-command => \&fermer_interface_graphique, 
);
 
# Choix Fichier
my $bouton_file = $mon_cadre->Button(
	-text    => "Fichier",
	-textvariable => \$Filepath,
	-command => sub {&get_file()},
);
 
$mon_cadre->pack( -side => 'top', -fill => 'x' );
$bouton_file->pack( -side => 'left', -padx => 50, -pady => 5 );
$bouton_yes->pack( -side => 'left',  -padx => 50, -pady => 5 );
$bouton_non->pack( -side => 'right', -padx => 50, -pady => 5 );
 
MainLoop;
 
print "suite de mon programme avec Fichier = $Filepath\n";
 
########################
# Recherche d'un fichier
#
sub get_file {
  my @types =
       (["All files",        '*'],
        ["Log files", [qw/.txt .log/]],
       );
  $Filepath = $mw->getOpenFile(-initialdir => $Filepath, -filetypes => \@types) or return();
  return($Filepath);
}
 
sub fermer_interface_graphique {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}
 
sub arret_programme {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
 
	# Arrêt du programme complet
	exit;
}

J'étais en train de répondre...

**julien terrier** · 30/08/2017, 16h21

Yes,

-textvariable ==>Points to a variable containing text to be displayed in Button.
Button text will change as $variable does.

**djibril** · 30/08/2017, 18h27

Bonjour,

Je n'ai pas eu la flème de tout lire, quel est concrètement le besoin ? Le bouton doit faire quoi ?

**julien terrier** · 30/08/2017, 21h27

Bonsoir,

Désolé si je ne suis pas clair dans mes explications, en faite ma question porte sur la méthode a utiliser pour récupérer le retour d'une fonction callback associé a un bouton de la bibliothèque Tk.

La commande du bouton étant associée a une fonction si par exemple on modifie le contenue d'une variable dans cette fonction comment fait-on pour récupérer cette variable modifiée sans la déclarer en global, j'espère être plus clair.

Merci pour votre aide.

**dmganges** · 31/08/2017, 06h39

Bonjour,
Tu as probablement une idée derrière la tête que les plus de vingt ans ne peuvent pas comprendre

Voila, toujours sur l'exemple initial de djibril :
- La fonction appelée par le bouton (get_file) retourne la valeur d'une variable locale à cette fonction
- La valeur est bien récupérée au niveau du bouton :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

my $File = get_file();

- MAIS la variable n'est pas visible dans le programme principal (Après 'MainLoop')

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Tk;
 
# Creation de la fenetre ( parent widget )
my $mw = MainWindow->new( -title => "Check Teg width" );
my $mon_cadre = $mw->Frame(
	-borderwidth => 5,
	-relief      => 'groove'
);
 
$mon_cadre->Label( -text => "Souhaitez-vous stopper le programme ?" )->pack;
 
my $bouton_yes = $mon_cadre->Button(
	-text    => "YES",
	-command => \&arret_programme,
);
 
my $bouton_non = $mon_cadre->Button( 
	-text => "NO", 
	-command => \&fermer_interface_graphique, 
);
 
# Choix Fichier
my $bouton_file = $mon_cadre->Button(
	-text    => "Fichier",
	-command => sub {
		my $File = get_file();
		print "\nFichier =$File=\n";
	},
);
 
$mon_cadre->pack( -side => 'top', -fill => 'x' );
$bouton_file->pack( -side => 'left', -padx => 50, -pady => 5 );
$bouton_yes->pack( -side => 'left',  -padx => 50, -pady => 5 );
$bouton_non->pack( -side => 'right', -padx => 50, -pady => 5 );
 
MainLoop;
 
print "suite de mon programme avec le nom ci-dessus\nMAIS ATTENTION ce nom est dans une variable locale à la fonction get_file\nElle est donc 'invisible' dans le reste du programme!!! \n";
 
########################
# Recherche d'un fichier
#
sub get_file {
  my @types =
       (["All files",        '*'],
        ["Log files", [qw/.txt .log/]],
       );
	my $Filepath = 'E:/_DEV';
  $Filepath = $mw->getOpenFile(-initialdir => $Filepath, -filetypes => \@types) or return();
  return($Filepath);
}
 
sub fermer_interface_graphique {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}
 
sub arret_programme {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
 
	# Arrêt du programme complet
	exit;
}

djibril aura certainement une meilleure idée,
mais si tu nous en disais un peu plus sur ce que tu souhaites faire après
avec cette variable modifiée par la fonction appelée...
ça nous aiderait...

**julien terrier** · 31/08/2017, 08h46

Bien sur,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
my $xorPath = &CREATE_WINDOW;
 
my $Archive_File = `Ewip_files -tegname ${TegName} -tegroot ${Dir} -xorpath ${xorPath}`;

La variable modifiée correspond donc a $xorPath et sert d'argument a un autre script, ce script est en tcsh

Pour récapituler l'utilisateur choisi un fichier depuis la boite de navigation et avec le bouton save il stock le chemin + le nom du fichier dans la variable a modifier.

**djibril** · 31/08/2017, 10h08

Bonjour,

Si je comprends bien, tu veux créer une procédure qui a pour seul but de lancer une petite interface Tk avec un bouton permettant de sélectionner un fichier. tu récupères le fichier sélectionné, la fenêtre se ferme et ton programme continue, c'est ça ?

**julien terrier** · 31/08/2017, 11h00

Bonjour,

J'ai un prog principal voici un échantillon:

Prog_principal.pl:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
if ($CheckValue == 1){
			print $Tee "==================================================\n";	
			print $Tee "Creation of archive file \n";
			my $error_area = "carrefull";
			my $error_alignement = "ERROR";
			my $prompt = `Check_Bbox -f ${gds}`;
			print "$prompt";
			if ($prompt =~ m/\W$error_area/){
 
			&ihm_box_yesno;
 
			}
			elsif ($prompt =~ m/\W$error_alignement/){
			print $Tee " \n ${TegName} was not released, there is a problem of scale \n ";
			die("\n");
			}
 
			&RECUP_ARG(@ARGV);
			&RECUP_ARG_OTHERS();
			my $xorPath = &CREATE_WINDOW;
 
			my $Archive_File = `Ewip_files -tegname ${TegName} -tegroot ${Dir} -xorpath ${xorPath}`;

J'ai crée un module et dans ce module j'ai les procédures qui gèrent l'interface graphique TK.

Gestion_IHM.pm:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
# Module create IHM
 
use Tk;
 
use lib "$ENV{PATH_LIB_PERL}/perlmod";
use Tilt::SetCalibre;
use Tilt::gtcheck;
use Tilt::XorGdsOasislite;
use File::Basename;
use File::stat;
 
my $window_color     = "lavender";
my $button_color     = "gray85";
my $button_colorG    = "LimeGreen";
my $entry_color      = "white";
my $font             = "Arial 10";
my $sfont            = "Arial 8";
my $bfont            = "Arial 12";
 
chop( my $directory = `pwd` );
#&RECUP_ARG(@ARGV);
#&RECUP_ARG_OTHERS();
#&CREATE_WINDOW;
 
###############################################################################################################
# Read specific command-line options and parameters
###############################################################################################################
sub RECUP_ARG_OTHERS {
    my $all_arg = join( " ", @ARGV );
 
    if ( $all_arg =~ /-extract +(\S+)/ )     { $summary        = $1; &EXTRACT_RESULT; exit; }
    if ( $all_arg =~ /-rve/i )               { $rve            = 1;  }
}
 
###############################################################################################################
# Main GUI window
###############################################################################################################
sub CREATE_WINDOW {
 
   my $mw = MainWindow->new( -background => $window_color, -title => "Add Xor GDS" );
    # Give a modern look & feel to the Tk GUI : anti-alias font and a thin border
    $mw->optionAdd("*font", "-*-arial-normal-r-*-*-*-120-*-*-*-*-*-*");
    $mw->optionAdd("*borderWidth", 1);
 
 
    #$mw->geometry("700x720");
    $mw->geometry("500x150");
 
    my $mw_scrolled = $mw->Scrolled( "Pane", -scrollbars => 'e', -borderwidth => 2, -relief => 'groove', -sticky => 'nwse', -background => $window_color );
    $mw_scrolled->pack( -in => $mw, -fill => 'both', -expand => 1 );
    $mw_scrolled->{SubWidget}->{yscrollbar}->configure( -width => 10, -background => $button_color );
 
    my $Menu_techno_scrolled = &CREATE_WINDOW_COMMON($mw_scrolled,
                                                     $directory,
                                                     $directory
    );
 
    $mw_scrolled->Button( -text => "Save", -command => [\&save_xorgds, $mw], -background => $button_color, -font => $font )
      ->grid( -columnspan => 2, -sticky => "nsew", -padx => 5, -pady => 5 );
 
    $mw_scrolled->Button( -text => "Exit", -command => [\&close_xor_ihm, $mw], -background => $button_color, -font => $font )
      ->grid( -columnspan => 2, -sticky => "nsew", -padx => 5, -pady => 5 );
 
# Run GUI !!
MainLoop;
return $gds1;
}
 
sub save_xorgds {
 
	my $mw = shift;
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
 
}
 
sub ihm_box_yesno
{
# Creation de la fenetre ( parent widget )
my $mw = MainWindow->new(-title => "Check Teg width");
my $frame = $mw->Frame(
	-borderwidth => 5, 
	-relief => 'groove'
);
 
$frame->Label(-text => "${TegName} hasn't a regular width, would you force the release ? \n",
	      -foreground => 'red' )->pack;
 
my $button_yes = $frame->Button(
		-text => "YES", 
		-command => [\&close_ihm, $mw],
);
 
my $button_no = $frame->Button(
		-text => "NO", 
		-command => [\&close_program, $mw],
); 
 
$frame->pack( -side => 'top', -fill => 'x' );							  
$button_yes->pack( -side => 'left',  -padx => 50, -pady => 5 );
$button_no->pack( -side => 'right', -padx => 50, -pady => 5 );
 
MainLoop;
}			
sub close_ihm {
 
	my $mw = shift;
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}
 
sub close_xor_ihm {
 
	$gds1 = "none";
	my $mw = shift;
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}
 
sub close_program {
 
	my $mw = shift;
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
	print "\n";
	print "***************************************************************************\n";
	print "*                                                                         *\n";
	print "*                    Config_generator_file was aborted                    *\n";
	print "*                                                                         *\n";
	print "***************************************************************************\n";
	print "\n";
 
	# Arrêt du programme complet
	exit;
 
}
1;

Dans mon prog principal je fais appel aux fonctions de ce module pour créer une boite oui/non ( voir appel de la fonction &ihm_box_yesno

, j'affiche une info sur le prompt et je demande a l'utilisateur si il veut continuer puis il y a 2 appels de fonction pour récupérer des arguments (&RECUP_ARG(@ARGV); &RECUP_ARG_OTHERS()

, toujours dans mon prog principal je demande a l'utilisateur si il veut ajouter ( a l'archivage qui ce fera plus tard ) un fichier spécifique. Pour cette étape je propose un boite de navigation et l'utilisateur choisi le fichier qu'il souhaite archiver.

Quand l'utilisateur choisi le fichier et appui sur le bouton Save le chemin absolue et sauvegardé dans une variable effectivement la boite se ferme et le programme continu, par la suite cette variable est envoyée a un script tcsh ( `Ewip_files ) qui a pour but de créer un .tar.

Pour reprendre ma problématique je voulais savoir quelle méthode doit-on utiliser pour récupérer la valeur d'une variable local modifié par une procédure de callback liée a un boutton.

Exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
my $toto ="tata";
$mw_scrolled->Button( -text => "Save", -command => [\&save_xorgds, $mw, $toto], -background => $button_color, -font => $font )
      ->grid( -columnspan => 2, -sticky => "nsew", -padx => 5, -pady => 5 );
 
sub save_xorgds {
 
	my $mw = shift;
        my $toto =shift
        my $toto = "titi";
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
       return $toto;
 
}

Ce que je voudrais ==> Au depart $toto = "tata" , j'appuie sur le bouton Save et $toto = "titi" ?

Merci pour vos retours.

**djibril** · 31/08/2017, 11h21

Voici un petit conseil personnel.
Il est amusant pour un utilisateur d'avoir des interfaces graphiques, des papillons qui bougent de gauche à droite, mais dans le fond, en terme de programmation derrière, c'est une autre histoire.
Programmer des interfaces à tout-va pour un rendement minime n'est pas toujours ce qu'il y a de plus simple et optimal. Il vaut mieux éduquer ses utilisateurs à savoir lancer un programme avec des paramètres ou à être capable de répondre à des questions durant l'exécution d'un programme en ligne de commande.

Néanmoins, pour ton souci, si le seul but est demander à tes utilisateurs de sélectionner un fichier, il y a trois solutions :
1- lancer ton programme avec en argument le nom du fichier à utiliser
perl toto.pl -f monfichier

Il te suffit d'apprendre à concevoir la création de programme avec la gestion d'arguments : Comment récupérer proprement les arguments de la ligne de commande ?

2- Dans ton programme, tu poses une question à tes utilisateurs et récupères le nom du fichier via <STDIN> (deux lignes de codes).

3- Tu rajoutes une couche graphique. C'est plus long, plus compliqué, c'est faisable mais il faut bien s'y prendre sinon tu vas te retrouver avec 100 lignes de codes supplémentaires pour rien.

Pour les points 1 et 2, je te laisse t'y pencher, c'est très simple et on pourra t'aider si besoin.
Pour le 3, voici un exemple de code que j'ai simplifié. Je pars du principe que l'interface Tk ne sert qu'à sélectionner un fichier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
#!/usr/bin/perl
use strict;
use warnings;
use Encode;
use utf8;
use Tk;
 
my $Repertoire = 'E:/_DEV';
print "Repertoire = $Repertoire\n";
 
# Interface graphique pour récupérer un fichier sélectionné.
my $mon_fichier = selectionner_un_fichier($Repertoire);
 
if ( defined $mon_fichier ) {
	print "Mon fichier = $mon_fichier\n";
}
else {
	print "aucun fichier selectionne\n";
}
 
sub selectionner_un_fichier {
	my $repertoire = shift;
 
	# Creation de la fenetre principale
	my $mw = MainWindow->new();
 
	# On rend cette fenêtre invisible car inutile pour notre projet
	$mw->withdraw();
 
	my @types = ( [ "All files", '*' ], [ "Log files", [qw/.txt .log/] ], );
	my $fichier_selectionne = $mw->getOpenFile(
		-initialdir => $repertoire,
		-filetypes  => \@types
	);
 
	return if not defined $fichier_selectionne;
 
	my $OS = lc($^O);
	if ( $OS eq 'mswin32' ) {
		$fichier_selectionne = encode( 'iso-8859-1', $fichier_selectionne );
	}
 
	# Une fois le fichier sélectionné, on n'a plus besoin de la fenêtre
	$mw->destroy;
 
	return $fichier_selectionne;
 
	MainLoop;
}

**julien terrier** · 01/09/2017, 12h12

Encore une fois merci pour ton aide.

Envoyé par djibril

1- lancer ton programme avec en argument le nom du fichier à utiliser
perl toto.pl -f monfichier

Ok j'avoue prendre le train en route et je veux tout de suite piloter avt de mettre le charbon dans le foyer ( je debute en perl, j'ai de bonne notion en C et un peu en shell) ==> j'ai trouvé des exemples

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

my $All_arg = join(" ",@ARGV);

je récupère l'ensemble des arguments passés a ma commande petit traitement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
if ($All_arg =~ m/-Techno(\s+)(\S+)/i) 
{$Techno = $2;}

C'est ujn exemple

, je pense avoir saisi l'essentiel.

Envoyé par djibril

2- Dans ton programme, tu poses une question à tes utilisateurs et récupères le nom du fichier via <STDIN> (deux lignes de codes).

C'est comme ca que ca marché avt, je demandais a l'utilisateur de rentrer dans le terminal le fichier qui voulait sauvegardé, pour moi cette méthode était peu élégante, c'est l'une des raisons pour laquel j'ai voulu ajouter l'ihm, l'autre est pédagogique c'est pour aprrendre a utiliser TK

.

Envoyé par djibril

3- Tu rajoutes une couche graphique. C'est plus long, plus compliqué, c'est faisable mais il faut bien s'y prendre sinon tu vas te retrouver avec 100 lignes de codes supplémentaires pour rien.

Merci pour ton exemple je tenterais de m'en inspirer...

Egalement merci Dmganges pour ton aide vous etes au top

**djibril** · 01/09/2017, 15h59

Envoyé par julien terrier

Ok j'avoue prendre le train en route et je veux tout de suite piloter avt de mettre le charbon dans le foyer ( je debute en perl, j'ai de bonne notion en C et un peu en shell) ==> j'ai trouvé des exemples

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

my $All_arg = join(" ",@ARGV);

je récupère l'ensemble des arguments passés a ma commande petit traitement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
if ($All_arg =~ m/-Techno(\s+)(\S+)/i) 
{$Techno = $2;}

C'est ujn exemple

, je pense avoir saisi l'essentiel.

Pour la gestion des arguments, utilises la méthode que je cite ci-dessus. C'est la norme, la façon la plus propre ne nécessitant aucune installation de module.

**julien terrier** · 04/09/2017, 10h34

Ok, merci ^pour vos conseils je cloture.

variable et bouton

Interfaces Graphiques Perl

Discussions similaires

Partager

Partager