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 : Sélectionner tout - Visualiser dans une fenêtre à part
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 : Sélectionner tout - Visualiser dans une fenêtre à part
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;
}