Discussion :

[Mersenne]

Bonsoir.

J'utilise Perl Tk sous Windows XP.

La méthode grabGlobal(), appliquée à une MainWindow, est censée bloquer tous les autres TopLevel de la même application et aussi toutes les autres applications.

Malheureusement, dans le programme qui suit, elle semble perturber une routine (provisoire) que j'ai associée à la fermeture de cette MainWindow : la croix de fermeture de Windows n'a aucun effet et les deux autres moyens (le bouton Quitter et le menu Application/Quitter de ce programme) affichent le messageBox prévu, mais il est impossible de fermer ce messageBox.

Voici ce programme.

Remarques.

1° J'ai mis "use utf8;" parce que j'enregistre mes programmes Perl en UTF8. Si vous l'enregistrez en MS-DOS ou en Windows, ne laissez pas le pragma "use utf8;", sinon je pense que les caractères hors-ASCII du messageBox poseront des problèmes.

2° Pour l'instant, l'instruction qui comporte grabGlobal() est neutralisée et le programme, tel qu'il est ainsi, s'exécute correctement.
Si, pour tester l'effet de grabGlobal(), vous décommentarisez cette instruction, je vous suggère de lancer le programme à la ligne de commande.
Dans ce cas, pour échapper au blocage du messageBox, il suffit de fermer la boîte de la ligne de commande.

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
 
 
#!/usr/bin/perl -w
 
# Ce programme montre un problème que me pose la méthode grabGlobal().
 
use utf8;
use Tk;
 
use strict;
 
 
 
my $mw = MainWindow->new;
 
# $mw->grabGlobal(); # bloque les autres fenêtres de l'application (sauf ses enfants) et les autres applications.
# ATTENTION : IL ME SEMBLE QU'AVEC ÇA, IL EST PARFOIS IMPOSSIBLE DE FERMER UN MESSAGEBOX, MÊME FILS DE $MW.
# (EN TOUT CAS, J'AI DES PROBLÈMES AVEC LA SUB FERMERFENETREPRINCIPALE.)
 
 
$mw->protocol('WM_DELETE_WINDOW', \&fermerFenetrePrincipale); # Associe à la
# croix de fermeture que Windows met d'office à droite de la barre de titre
# la même fonction de rappel qu'à l'item de menu Application/Quitter. Puisque
# $mw est une variable globale, il ne me semble pas nécessaire de donner
# un paramètre à la fonction de rappel.
 
my $hauteurEcran = $mw->screenheight();
my $largeurEcran = $mw->screenwidth();
 
my $hauteurBarreDeTaches = ((30 * $hauteurEcran) - ((30 * $hauteurEcran) % 768))/ 768; # quotient entier de 30 * $hauteurEcran par 768. Utiliser la fonction int ? La valeur 30 est présumée par moi.
 
my $hauteurBarreDeTitre = ((30 * $hauteurEcran) - ((30 * $hauteurEcran) % 768))/ 768; # quotient entier de 30 * $hauteurEcran par 768. Utiliser la fonction int ? La valeur 30 est présumée par moi.
 
 
 
my $hauteurLibreDansApplication = ($hauteurEcran - $hauteurBarreDeTaches) - $hauteurBarreDeTitre;
 
# Ce que j'appelle $hauteurLibreDansApplication correspond à ce que le système attribue comme height à la mainwindow.
 
 
my $largeurApplication = int( (95 * $largeurEcran) / 100); # Je ne prends que les 95/100 pour retirer la largeur de l'espèce de barre de tâches que l'utilisateur risque d'avoir à droite de son écran.
 
 
$mw->configure(
 
 
                          -width => $largeurApplication,
                          -height => $hauteurLibreDansApplication);
 
 
$mw->title("Archivage.");
 
$mw->geometry("+0+0");
 
 
 
 
 
  my $cadreHautPourMenus = $mw->Frame(
                            -borderwidth => 1,
                            -relief => 'solid',
                         )->place(
                                      -relx => 0.0,
                                      -rely => 0.0,
                                      -relheight => 0.04,
                                      -relwidth => 1,
                                      -anchor => "nw",
                                   );
 
 
my $menuApplication = $cadreHautPourMenus->Menubutton(
                           -borderwidth => 5,
                           -width => 13, # = largeur en nombre de caractères, parce qu'il y a du texte.
                           ###-height => 5, # On va plutôt lui permettre de remplir le cadre en hauteur
                           -relief => 'solid',
                           -text => 'Application',
                           -menuitems => [
                                          [ 'command' => "Quitter",
                                            -command => \&fermerFenetrePrincipale ]
                                         ]
 
                       )->pack(
                                      -side => 'left',
                                      -anchor => 'center',
                                      -fill => 'y',
                         );
 
 
  my $cadreBasPourBoutonQuitter = $mw->Frame(
                            -borderwidth => 1,
                            -relief => 'solid',
                         )->place(
                                      -relx => 0.0,
                                      -rely => 1.0,
                                      -relheight => 0.05,
                                      -relwidth => 1.0,
                                      -anchor => "sw",
                                  );
 
 
my $boutonQuitter = $cadreBasPourBoutonQuitter->Button(
                           -text => "Quitter",
                           -command => \&fermerFenetrePrincipale,
                               )->pack(
#                                       -side => 'bottom',
                                       -anchor => 'center',
                                       -fill => 'none',
                                       );
 
 
 
sub fermerFenetrePrincipale
{
    $mw->messageBox(-title => 'Erreur',
                    -message => "Il faudra encore penser au protocole de fermeture de la fenêtre (bouton Quitter, menu Application/Quitter et croix x de Windows).",
                    -type => 'OK',
                    -icon => 'error');
 
  $mw->destroy()
}
 
 
 
MainLoop;

Merci d'avance à qui pourra m'aider.

(Je souhaite empêcher l'utilisateur d'aller modifier par une autre application le fichier que ce programme interactif doit traiter, donc grabGlobal() me serait précieuse.)

Mersenne

[Mersenne]

Bon, j'ai fait ce que j'aurais dû faire plus tôt : googler.

Le CPAN signale lui-même que grabGlobal est boguée :

http://www.annocpan.org/~NI-S/Tk-804.026/pod/grab.pod

Bonsoir.