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 !
- Comment afficher les messages d'erreur Perl dans une fenêtre Tk ?
- Comment rediriger la sortie standard STDOUT dans une fenêtre TK ?
- Comment sélectionner un répertoire ?
- Comment sélectionner un ou plusieurs fichiers ?
- Comment récupérer des fichiers ou répertoires via un drag & drop ?
- Comment créer un calendrier ?
- Comment afficher l'heure dans un widget ?
- Comment obtenir une palette de couleur ?
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; } |
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; |
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; |
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 ); } |
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"; |
Code perl : | Sélectionner tout |
1 2 3 4 5 | my $File = $widget->getOpenFile( -initialdir => "C:/", ); print $File; |
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 => "." ); |
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 ); } |
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; } |
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.
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; |
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 } |
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); ... |
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; |
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 çaLes 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 © 2024 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.