Snippets Pour Tk [Sources]

[djibril]

Bonjour,

Je vous propose de lister des procédures pratiques qu'on puisse utiliser dans nos applications TK.

Afin que tout soit propre, lisible pour tous et facilement utilisable, voici quelques recommandations.

1. La procédure ne doit pas prendre plus de trois arguments
2. Chaque procédure doit être correctement indentée et commentée
3. Chaque procédure doit avoir une entête commentée donnant le but de la procédure, les arguments et les modules dont elle dépend et la valeur de retour
4. En début de procédure, Veuillez toujours tester le nombre d'arguments et donner un exemple d'utilisation

Alors, je me lance :

- Procédure pour centrer tous vos widgets

Code perl :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
#================================================
# But : Centrer un widget automatiquement
# Arguments : Largeur, Hauteur, widget
# Retour : $geometry (Get the geometry position to center a widget)
#================================================
sub CentrerWidget {
  unless ( scalar(@_) == 3 ) {
    my $Usage = <<'FIN_USAGE';
      Usage: my $Geometry = CentrerWidget($WidthWidget, $HeigthWidget, $widget);
      ....$widget->geometry( $Geometry );
FIN_USAGE
    die($Usage);
  }
  my ( $WidthWidget, $HeigthWidget, $MainWidget ) = @_;
 
  # Height and width of the screen
  my $WidthScreen  = $MainWidget->screenwidth();
  my $HeightScreen = $MainWidget->screenheight();
 
  my $NewWidth  = int( ( $WidthScreen - $WidthWidget ) / 2 );
  my $NewHeight = int( ( $HeightScreen - $HeigthWidget ) / 2 );
 
  return $WidthWidget . "x" . $HeigthWidget . "+$NewWidth+$NewHeight";
}

- Afficher les messages d'erreur Perl dans une fenêtre Tk

Code :

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
#================================================
# But : Afficher ces messages d'erreur dans une fenêtre TK
# Arguments : Aucun (Tk en envoie 3 par défaut)
# Retour : Rien
#===============================================
sub Tk::Error {
  my ( $Widget, $Error, @Locations ) = @_;
 
  # Error widget
  my $MwError = MainWindow->new( -background => "white",);
  $MwError->title( "Message d'erreur" );
  $MwError->minsize( 300, 300 );
  $MwError->focusForce();
 
  my $MessageError = $MwError->Scrolled( 
    "Text", 
    -scrollbars => "oe",
    -background => "white", 
  );
  $MessageError->delete( "1.0", "end" );
  $MessageError->insert( "end", $Error );
 
  $MessageError->pack( -fill => "both", -expand => 1, );
  $MwError->bell();
 
  return;
}

[djibril]

Je constate que personne ne fait du Tk

[Arioch]

Envoyé par djibril

Je constate que personne ne fait du Tk

Quand je peux m'en passer, je m'en passe très bien, de Tk

Par chance, pour mes récents scripts Perl au boulot, personne ne m'a demandé de truc graphique, ce qui m'a permi de me concentrer exclusivement sur le boulot en lui-même, et non son maquillage

[djibril]

C'est clair que si on a pas besoin de faire une interface graphique, pas besoin de se prendre la tête pour, et ce quelque soit le langage, mais on fait quand même pas mal de chose avec, il suffit de s'y mettre.
dommage qu'il n'y ait pas plus de retour

[vtrone]

Envoyé par djibril

Je constate que personne ne fait du Tk

Tu fais bien d'en parler, je m'y mets de plus en plus ces derniers temps, notamment pour publier scripts classiques habillés avec une interface Tk, que je publierai sous Citrix.

Je posterai prochainement quelques procédures...

[yep2cv]

un petit cadeau de ma part,
pas forcement tres propre a cause du pack mais surement bien utile

Code :

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
 
# ================================================
# But: executer regulierement une action, comme donner l heure
# Argument: le widget dans lequel placer (mainwindow ou autre)
# Attention, j appelle le PACK, mais ca doit correspondre avec le widget parent
# Exemple d appel: $mw=MainWindow... UneCaseHorlogePack($mw)
# ================================================
 
# avec quelle frequence je met a jour
my $FREQUENCY      = 1000 ;	# millisecondes: 60000=1min
 
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();
  # zone d affichage de l heure
  # on peut avoir Label ou Button
  my $horloge=$menubar->Button( 
		-font => "dtinfo"  ,
		-text => "mon horloge"  ,
		-height=>'1' ,
		-background => "black",
		-foreground => "white",
		-width=>30,
		-justify =>'center',
		) -> pack();
 
   # cette frame appelle regulierement une fonction
   $menubar->repeat( $FREQUENCY, [\&UpdateTimeNow ,$horloge] );
}
 
# la fonction qui s execute regulierement
sub UpdateTimeNow { 
   my $horloge = shift ;
   # attraper l heure machine
   my $now= localtime(time) ;
   # puis l afficher dans la zone prevue 
   $horloge->configure(-text => $now );
   # remarque: il est possible de l afficher dans le bandeau fenetre de l application
   # $mw->title($now)
   # remarque: en general, je fais plein de truc ici, regulierement, pour des tableaux de bord
}

On dirait que je ne maitrise pas encore la mise en forme des messages dans ce forum. Désolé pour les indentations.

[djibril]

Si si, ton balisage est correct, c'est bug sur le forum que je vais faire modifier.
Merci pour ton snippet, je le test et le mets à dispo dès que possible.

[djibril]

En faite pour afficher l'heure, j'avais une petite procédure simple que je te mettrais à profit d'ici là