Ce paragraphe montre comment construire une barre d'outils à partir de petites images, de préférence au format gif. Leur taille sera de préférence comprise entre 20x20 et 32x32.

Le principe est de construire une frame dans laquelle il y a plusieurs sous-frames, correspondant chacune à une catégorie d'outils. Par exemple, la première sous-frame contient des outils liés à des commandes du menu Fichier (Nouveau, Ouvrir, Enregistrer), la seconde des outils de visualisation (Zoom...), ..., la dernière des outils d'aide.

De plus lorsque l'utilisateur passe la souris au dessus d'un bouton d'outil, la barre d'état (voir Barre d'état (ou d'aide en ligne) ) contient un résumé de la commande associée au bouton.

proc ShowToolBar {w packing souspacking} {
# Crée une barre d'outils avec bulles d'aide et aide contextuelle dans le widget w
# packing est le packing des sous-frames les unes par rapport aux autres, et souspacking
# est le packing des boutons des sous-frames les uns par rapport aux autres
# On suppose que toutes les images ont été créées au début
frame $w.tools
frame $w.tools.file
pack configure $w.tools.file -side $packing -ipadx 5
button $w.tools.file.open -command {Open} -image {ImageOuvrirFichier}
pack configure $w.tools.file.open -side $souspacking
menu $w.tools.file.open.m -tearoff 0 -foreground black -background yellow \
-borderwidth 1 -activeforeground black -activebackground yellow -activeborderwidth 0
$w.tools.file.open.m add command -label {Open} -state disabled
# Crée un menu fils du bouton, que l'on affichera lorsque la souris passera sur le bouton
bind $w.tools.file.open <Enter> {
PushState "Open a file"
$w.tools.file.open.m post %X %Y
}
# Lorsque la souris arrive sur le bouton, l'aide contextuelle et la bulle d'aide sont affichées
bind $w.tools.file.open <Leave> {
PopState
$w.tools.file.open.m unpost
}
# Lorsque la souris quitte le bouton, l'aide contextuelle et la bulle d'aide sont enlevées
# ...........................
# etc... pour tous les boutons et les sous-frames
return $w.tools
}

Pour l'instant, la version alpha2 de Tcl/TK 8.0 ne supporte pas le binding du leave sur le bouton, j'espère que c'est dû à un bug de cette version, sinon, pour les bulles d'aide, une autre méthode sera nécessaire...

Remarque: grâce aux paramétrages du packing, on peut imaginer un bouton dans la barre d'outils qui va décrocher ou raccrocher la barre d'outils à la fenêtre principale. Par exemple pour décrocher la barre d'outils et la mettre dans une toplevel .top1 avec les sous-frames de boutons les unes au dessous des autres:

destroy $w.tools
ShowToolBar .top1 top left

Voilà, pour avoir tous les éléments d'une application réussie, il ne nous reste plus qu'à créer un canvas dans lequel nous allons créer par exemple des rectangles, les déplacer, et les colorer à l'aide de menus contextuels.

      5 Canvas scrollable

Construisons notre canvas à l'intérieur de la fonction ShowCanvas. La construction est identique à celle présentée en III.B.4.b.

proc ShowCanvas {w} {
#Construit un canvas scrollable à l'intérieur du widget w
frame $w.canvas
scrollbar $w.canvas.scrollv -orient vertical -command "$w.canvas.f.c yview"
pack configure $w.canvas.scrollv -side right -fill y -expand 1
# Scrollbar verticale
frame $w.canvas.f
pack configure $w.canvas.f -side left -fill both -expand 1
# Sous-frame pour packer la scrollbar horizontale et le canvas
scrollbar $w.canvas.f.scrollh -orient vertical -command "$w.canvas.f.c xview"
pack configure $w.canvas.f.scrollh -side bottom -fill x -expand 1
# Création de la scrollbar horizontale
canvas $w.canvas.f.c -scrollregion "0 0 1024 768" \
-yscrollcommand "$w.canvas.scrollv set" -xscrollcommand "$w.canvas.f.scrollh set"
pack configure $w.canvas.f.c -side top -fill both -expand 1
global Canvas
set Canvas $w.canvas.f.c
#Création du canvas. En général, comme pas mal de fonctions auront à utiliser le canvas,
# on met son nom dans une variable globale, ici Canvas.
global tcl_platform
if {[string compare $tcl_platform(platform) mac]==0} {
# On détermine quel binding appliquer au menu contextuel suivant la plateforme
set binding <Shift-ButtonPress>
} else {
set binding <ButtonPress-3>
}
bind $Canvas $binding "CanvasContextualMenu %X %Y %x %y"
# Le menu contextuel sera mis à jour puis affiché par la fonction "CanvasContextualMenu"
# à écrire...
return $w.canvas
}