Une boîte à cocher dans un canvas

 

ulis, 2006-10-31. Une boîte à cocher, tout à la main, dans un canvas.


Pourquoi

Pfff! Pourquoi toujours pourquoi ?

Pour l'amour de Tk, tiens !


Comment

Toujours pareil : des rectangles pour faire la boîte, des lignes pour la croix, un texte pour le texte. Et une variable.


Script

  package require Tk
  # v2 : la croix est plus visible
  # v2.1 : script facultatif

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

  proc createCheckBox {w x0 y0 var on off {script ""}} \
  {
    variable {}
    # box
    set tag $var
    set ($w:$tag:on) $on
    set ($w:$tag:off) $off
    set ($w:$tag:script) $script
    set width 9
    set height 9
    set x1 [expr {$x0 + $width + 1}]
    set y1 [expr {$y0 + $height + 1}]
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $tag $tag:se] \
      -fill "" -outline $(color:light)
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $tag $tag:nw] \
      -fill "" -outline $(color:dark)
    $w move $tag:nw -1 -1
    incr x1 -1; incr y1 -1
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $tag $tag:bg] \
      -fill $(color:bg) -outline $(color:bg)
    set x2 [expr {$x0 + 2}]
    set y2 [expr {$y0 + 2}]
    set x3 [expr {$x1 - 1}]
    set y3 [expr {$y1 - 1}]
    $w create line $x2 $y2 $x3 $y3 -state hidden \
      -tags [list $tag $tag:check] -fill $(color:check)
    $w create line $x2 $y2 $x3 $y3 -state hidden \
      -tags [list $tag $tag:check $tag:check:2] -fill $(color:check)
    set y2 [expr {$y1 - 2}]
    set y3 [expr {$y0 + 1}]
    $w create line $x2 $y2 $x3 $y3 -state hidden \
      -tags [list $tag $tag:check] -fill $(color:check)
    $w create line $x2 $y2 $x3 $y3 -state hidden \
      -tags [list $tag $tag:check $tag:check:2] -fill $(color:check)
    $w move $tag:check:2 1 0
    set x3 [expr {$x1 + 8}]
    set y3 [expr {($y0 + $y1) / 2}]
    $w create text $x3 $y3 -anchor w -text $off \
      -tags [list $tag $tag:text]
    $w bind $tag <ButtonPress-1> [list toggleCheckBox $w $var]
    set $var 0
  }
  proc toggleCheckBox {w var} \
  {
    variable {}
    set value [set $var]
    set value [expr {!$value}]
    set state [expr {$value ? "normal" : "hidden"}]
    $w itemconfig $var:check -state $state
    set txt [expr {$value ? $($w:$var:on) : $($w:$var:off)}]
    $w itemconfig $var:text -text $txt
    set $var $value
    eval $($w:$var:script)
  }

Demo

  # exemple d'utilisation
  wm title . CheckBox-canvas
  . config -padx 10 -pady 10
  set width 100
  set height 100
  set x0 45
  set y0 30
  canvas .c -width $width -height $height \
    -bd 1 -relief groove -highlightt 0
  grid .c
  createCheckBox .c $x0 $y0 ::var1 actif inactif script
  incr y0 30
  createCheckBox .c $x0 $y0 ::var2 haut bas script
  proc script {} { tk_messageBox -message Yo! }

Voir Aussi


Exercices


Discussion


Catégorie Exemple | Catégorie Interface utilisateur