Un bouton dans un canvas

 

ulis, 2006-10-01. Comment faire un bouton dans un canvas. Tout à la main.


Pourquoi

Comme on peut tout faire avec un canvas certains pourraient être tentés de mettre toute l'interface dans un canvas.

Et donc d'y incorporer un bouton pour quitter, par exemple.


Comment

Une recette toute simple :


Le script

  package require Tk

  # paramètres
  variable {}
  array set {} {}
  entry .e
  set (color:light) [.e cget -background]
  set (color:bg)    [.e cget -disabledbackground]
  set (color:dark)  [.e cget -disabledforeground]
  destroy .e

  # procs gestion bouton
  proc createButton {w tag x0 y0 width height text script} \
  {
    variable {}
    set (button:$w:$tag) [list $x0 $y0 $width $height]
    set x1 [expr {$x0 + $width}]
    set y1 [expr {$y0 + $height}]
    set xc [expr {($x0 + $x1) / 2}]
    set yc [expr {($y0 + $y1) / 2}]
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $tag $tag:nw] \
      -fill "" -outline $(color:light)
    $w move $tag:nw -1 -1
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $tag $tag:se] \
      -fill "" -outline $(color:dark)
    $w move $tag:se 1 1
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $tag $tag:bg] \
      -fill $(color:bg) -outline $(color:bg)
    $w create text $xc $yc -text $text -tags [list $tag $tag:txt]
    $w bind $tag <ButtonPress-1> [list lowerButton $w $tag]
    $w bind $tag <ButtonRelease-1> [list raiseButton $w $tag %x %y $script]
  }
  proc lowerButton {w tag} \
  {
    variable {}
    $w itemconfig $tag:nw -outline $(color:dark)
    $w itemconfig $tag:se -outline $(color:light)
    $w move $tag:txt 1 1
  }
  proc raiseButton {w tag x y script} \
  {
    variable {}
    $w itemconfig $tag:nw -outline $(color:light)
    $w itemconfig $tag:se -outline $(color:dark)
    $w move $tag:txt -1 -1
    onButton $w $tag $x $y $script
  }
  proc onButton {w tag x y script} \
  {
    variable {}
    foreach {x0 y0 width height} $(button:$w:$tag) break
    if {$x >= $x0 && $x <= $x0 + $width \
     && $y >= $y0 && $y <= $y0 + $height} \
    { eval $script }
  }

Demo

  # exemple d'utilisation
  wm title . Bouton-canvas
  . config -padx 10 -pady 10
  set width 200
  set height 100
  set bw 100
  set bh 20
  canvas .c -width $width -height $height \
    -bd 1 -relief groove -highlightt 0
  grid .c
  set x0 [expr {($width - $bw) / 2}]
  set y0 10
  createButton .c button $x0 $y0 $bw $bh Quitter exit

Voir Aussi


Discussion

ulis Trouver les couleurs de bordure 3d dans les couleurs du widget entry n'est pas très élégant.

Quelqu'un aurait-il une idée plus à la mode ?


Catégorie Exemple | Catégorie Interface utilisateur