FAQ Perl/TkConsultez toutes les FAQ

Nombre d'auteurs : 3, nombre de questions : 86, dernière mise à jour : 24 mai 2013  Ajouter une question

 

Bienvenue sur la FAQ Perl/Tk. Cette FAQ a pour vocation de vous enseigner ou de vous faire revoir les notions de Perl/Tk. N'hésitez pas à utiliser le moteur de recherche.

Vous souhaitez participer à l'amélioration de cette FAQ, n'hésitez pas !! Commentez

Bonne lecture !


SommaireAstuces et divers (8)
précédent sommaire
 

Si vous souhaitez que les messages d'erreurs Tk apparaissent dans une fenêtre Tk, plutôt que sur la console, utilisez la procédure Tk::Error.
Toutes les erreurs Tk obtenues seront récupérées par la procédure. Il suffit de les faire afficher dans un widget fils.

Code perl : Sélectionner tout
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 warnings; 
use strict; 
use Tk;    # Appel du module Tk 
  
my $fenetre = new MainWindow( 
  -title      => "Première fenêtre Tk ", 
  -background => "white", 
);  
  
# Affichage d'un bouton pour fermer la fenêtre 
my $bouton = $fenetre->Button ( 
    -text    => "Détruire la fenêtre",  
-command => \&DestructionFenetre, 
)->pack(); 
  
MainLoop;  # Obligatoire 
  
sub DestructionFenetre {  
  $fenetre->TOTO;  # => On introduit délibérément une erreur car la méthode TOTO n'existe pas 
  exit; 
  
  return;  
}  
  
#================================================ 
# But : Afficher les messages d'erreurs dans une fenêtre 
# Arguments : rien 
# Retour    : Rien 
#================================================ 
sub Tk::Error { 
  my ( $widget, $Error, @Locations ) = @_; 
  
  # Error widget 
  my $MwError = $widget->Toplevel( -background => "white" ); 
  $MwError->title( "Fenêtre d'erreurs" ); 
  $MwError->minsize( 300, 300 ); 
  $MwError->grab(); 
  
  my $MessageError = $MwError->Scrolled( "Text", -scrollbars => "oe" ); 
  $MessageError->delete( "1.0", "end" ); 
  $MessageError->insert( "end", "Erreur : $Error\n\n" ); 
  #$MessageError->insert( "end", "Location : @Locations\n\n" ); 
  #$MessageError->insert( "end", "Widget : $widget\n" ); 
  
  $MessageError->pack( -fill => "both", -expand => 1, ); 
  
  return; 
}
Pour tester ce script, lancez-le et cliquez sur le bouton.

Mis à jour le 10 décembre 2008 djibril

Il est possible d'afficher la sortie STDOUT dans un widget Tk (Text ou ROText).

Code perl : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#!/usr/bin/perl 
use warnings; 
use strict; 
  
use Tk; 
  
my $mw = MainWindow->new; 
  
my $Scrolled = $mw->Text( 
      -height     => 10, 
      -wrap       => "none", 
      -relief     => "solid", 
      -background  => "white", 
    )->pack(-fill => "both", -expand => 1); 
  
 tie *STDOUT, ref $Scrolled, $Scrolled; 
  
print "Hello Text World!\n\n"; 
print "ceci est un test\n\n"; 
  
MainLoop;

Mis à jour le 24 janvier 2009 djibril

Utilisez la méthode "chooseDirectory" pour sélectionner un répertoire.

Code perl : Sélectionner tout
1
2
3
4
5
6
7
my $Directory = $widget->chooseDirectory( 
  -title      => "Mon titre",   # Titre fenêtre 
  -initialdir => "C:/",         # Répertoire par défaut 
  -mustexist  => 1,             # Le répertoire sélectionné doit exister 
); 
  
print $Directory;
Vous pouvez mettre ce code dans une procédure pour le lier à un bouton.

N.B. Sous Windows, vous pouvez avoir des soucis avec les chemins contenant des accents, dans ce cas, utiliser le module Encode.

Code perl : Sélectionner tout
1
2
3
4
5
# Windows 
  my $OS = lc($^O); 
  if ( $OS eq 'mswin32' ) { 
    $Directory = encode( 'iso-8859-1', $Directory ); 
  }

Mis à jour le 18 décembre 2008 djibril

Utilisez la méthode "getOpenFile" pour sélectionner vos fichiers.

Code perl : Sélectionner tout
1
2
3
4
5
6
my @TabFiles = $widget->getOpenFile( 
  -initialdir => "C:/", 
  -multiple   => 1, 
); 
  
print "@TabFiles";
Modifiez les options pour sélectionner un fichier.

Code perl : Sélectionner tout
1
2
3
4
5
my $File = $widget->getOpenFile( 
    -initialdir => "C:/", 
); 
  
print $File;
Il est possible de spécifier les types de fichiers que vous souhaitez afficher par défaut.

Code perl : Sélectionner tout
1
2
3
4
5
6
7
8
9
my $types = [  
	[ 'Fichiers log', '.log' ], 
	['Tous les fichiers',    '*'] 
]; 
  
my $filename = $widget->getOpenFile( 
    -filetypes  => $types, 
    -initialdir => "." 
  );
Lisez la documentation officielle pour en savoir davantage.

N.B. Sous Windows, vous pouvez avoir des soucis avec les chemins contenant des accents, dans ce cas, utilisez le module Encode.

Code perl : Sélectionner tout
1
2
3
4
5
# Windows 
  my $OS = lc($^O); 
  if ( $OS eq 'mswin32' ) { 
    $File = encode( 'iso-8859-1', $File ); 
  }

Mis à jour le 18 décembre 2008 djibril

Le but est de faire un glisser-déposer de fichiers ou répertoires dans un widget Text sous Windows afin de trouver le chemin et le nom du fichier ou répertoire.

Code perl : Sélectionner tout
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
#!/usr/bin/perl 
use warnings; 
use strict; 
use Tk; 
use Tk::Dropsite 'Win32'; 
use File::Basename; 
use utf8; 
  
my $mw = MainWindow->new( -background => '#E0F0FF', ); 
  
$mw->Label( 
  -text       => 'Faire un glisser-déposer de fichiers ou répertoires dans le widget ci-dessous', 
  -background => '#E0F0FF', 
)->pack(qw/ -side top -pady 2/); 
  
my $widgetTextDragDrop = $mw->Scrolled( 
  'Text', 
  -background => 'white', 
  -scrollbars => 'osoe', 
  -wrap       => 'none', 
  -height     => 7, 
)->pack(qw/ -side top -pady 2/); 
  
$mw->Label( 
  -text       => 'Résultat', 
  -background => '#E0F0FF', 
)->pack(qw/ -pady 2/); 
  
my $widgetTextResultat = $mw->Scrolled( 
  'Text', 
  -background => 'white', 
  -scrollbars => 'osoe', 
  -wrap       => 'none', 
)->pack(qw/ -pady 2 -fill both -expand 1/); 
  
# Conception du glisser-déposer 
$widgetTextDragDrop->DropSite( 
  -dropcommand => [ \&ActionDrop, $widgetTextDragDrop, $widgetTextResultat ], 
  -droptypes   => 'Win32', 
); 
  
MainLoop; 
  
sub ActionDrop { 
  my ( $widgetTextDragDrop, $widgetTextResultat ) = @_; 
  
  my $sel = $widgetTextDragDrop->SelectionGet( -selection => 'CLIPBOARD' ); 
  foreach my $fichier_rep ( split( /\n/, $sel ) ) { 
    $widgetTextDragDrop->insert( 'end', "$fichier_rep\n" ); 
    $widgetTextResultat->insert( 'end', "$fichier_rep\n" ); 
    if ( -d $fichier_rep ) { 
      $widgetTextResultat->insert( 'end', "\tRépertoire : $fichier_rep\n" ); 
    } 
    elsif ( -f $fichier_rep ) { 
      $widgetTextResultat->insert( 'end', 
        "\tFichier : (" . dirname($fichier_rep) . ', ' . basename($fichier_rep) . ")\n" ); 
    } 
  } 
  return; 
}
Voici le résultat :

Pour appliquer le glisser-déposer au widget Text, on utilise la méthode DropSite du module Tk::Dropsite sur le widget Text. Puis pour effectuer les sélections, on utilise la méthode SelectionGet du module Tk::Selection.

Mis à jour le 1er novembre 2010 djibril

Pour créer un calendrier, dans un but didactique, on peut essayer de le faire soi-même. Mais dans un but pratique, il existe déjà un module sur le CPAN qui le fait pour nous. Il s'agit du module Tk::MiniCalendar. Il fonctionne très bien et peut être personnalisé. Exemple d'utilisation :

Code perl : Sélectionner tout
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
#!/usr/bin/perl 
use warnings; 
use strict; 
use Tk; 
use Tk::MiniCalendar; 
  
my $fenetre = new MainWindow( -title => 'Calendrier Tk', ); 
$fenetre->minsize( 300, 300 ); 
  
my @tab_date = localtime(time); 
my $Jour     = $tab_date[3]; 
my $Mois     = $tab_date[4] + 1; 
my $Annee    = $tab_date[5] + 1900; 
  
my $CalendrierWidget = $fenetre->MiniCalendar( 
  -day         => $Jour, 
  -month       => $Mois, 
  -year        => $Annee, 
  -day_names   => [ 'Lu', 'M', 'Me', 'Je', 'V', 'Sam', 'Dim' ], 
  -month_names => [ 
    'Janvier', 'Février', 'Mars',      'Avril',   'Mai',      'Juin', 
    'Juillet', 'Août',    'Septembre', 'Octobre', 'Novembre', 'Décembre' 
  ], 
)->pack; 
  
my $date = 'Aucune date sélectionnée'; 
$fenetre->Label( -textvariable => \$date, )->pack; 
  
$fenetre->Button( 
  -text    => 'Date selectionnée ?', 
  -command => sub { 
    my ( $Annee, $Mois, $Jour ) = $CalendrierWidget->date; 
    $date = "Date après clic : $Jour/$Mois/$Annee\n"; 
  }, 
)->pack; 
  
MainLoop;

Mis à jour le 22 décembre 2008 djibril

Pour afficher l'heure dans un widget, voici deux procédures.

Code perl : Sélectionner tout
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
# ================================================ 
# But: exécuter régulièrement une action, comme donner une heure 
# Argument: le widget dans lequel placer (mainwindow ou autre) 
# Attention, j'appelle le PACK, mais ça doit correspondre avec le widget parent 
# Exemple d'appel: $mw=MainWindow... UneCaseHorlogePack($mw) 
# ================================================ 
  
  
sub UneCaseHorlogePack { 
  my $parent = shift ; 
  unless ($parent->IsWidget) { die "Erreur: mauvais appel, ce n'est pas un widget\n"; } 
  my $menubar = $parent->Frame(-relief => 'raised', -borderwidth => 2)-> pack(); 
  
  # avec quelle fréquence je mets à jour 
  my $FREQUENCY      = 1000 ;	# millisecondes: 60000 = 1 min 
  
  # zone d'affichage de l heure 
  # on peut avoir Label ou Button 
  my $horloge=$menubar->Label(  
		-font => "dtinfo"  , 
		-text => "mon horloge"  , 
		-height=>'1' , 
		-background => "black", 
		-foreground => "white", 
		-width=>30, 
		-justify =>'center', 
		) -> pack(); 
  
   # ce frame appelle régulièrement une fonction 
   $menubar->repeat( $FREQUENCY, [\&UpdateTimeNow ,$horloge] ); 
} 
  
# la fonction qui s'exécute régulièrement 
sub UpdateTimeNow {  
   my $horloge = shift ; 
   # attraper l'heure machine 
   my $now= localtime(time) ; 
   # puis l'afficher dans la zone prévue  
   $horloge->configure(-text => $now ); 
   # remarque: il est possible de l'afficher dans le bandeau fenêtre de l'application 
   # $mw->title($now) 
   # remarque: en général, je fais plein de trucs ici, régulièrement, pour des tableaux de bord 
}
Exemple d'utilisation

Code perl : Sélectionner tout
1
2
3
4
5
6
7
8
9
#!/usr/bin/perl 
use Tk; 
use strict; 
use warnings; 
  
my $mw = MainWindow->new( -background => "white" ); 
UneCaseHorlogePack($mw); 
  
...

Mis à jour le 29 janvier 2009 yep2cv

La méthode choosecolor permet d'obtenir une fenêtre avec toutes les couleurs. Vous pouvez ainsi en choisir une.

Code perl : Sélectionner tout
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#!/usr/bin/perl 
use strict; 
use warnings; 
  
use Tk; 
  
my $mw = MainWindow->new( 
  -title      => "Couleurs", 
  -background => 'white' 
); 
  
my $Anim = $mw->Button( 
  -text    => 'Select color with chooseColor', 
  -command => sub { 
    my $couleur = $mw->chooseColor( -title => 'Choisir couleur' ); 
    $mw->configure( -background => $couleur ); 
  }, 
)->pack(qw/ -pady 10 -padx 10/); 
  
MainLoop;


Mis à jour le 28 juin 2010 djibril

Proposer une nouvelle réponse sur la FAQ

Ce n'est pas l'endroit pour poser des questions, allez plutôt sur le forum de la rubrique pour ça


Réponse à la question

Liens sous la question
précédent sommaire
 

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2019 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.