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; |
