Snippets Pour Tk

Version imprimable

Snippets Pour Tk

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.

La procédure ne doit pas prendre plus de trois arguments
Chaque procédure doit être correctement indentée et commentée
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
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:

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

01/12/2008, 21h22
djibril

Je constate que personne ne fait du Tk 8O
02/12/2008, 09h26
Arioch

Citation:

Envoyé par djibril

Je constate que personne ne fait du Tk 8O

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

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 :aie:
02/12/2008, 09h36
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
17/12/2008, 21h46
Invité

Citation:

Envoyé par djibril

Je constate que personne ne fait du Tk 8O

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

horloge ou automate

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.

29/01/2009, 15h06
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.
:king:
29/01/2009, 15h13
djibril

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