Une entrée de texte dans un canvas

 

ulis, 2006-10-03. Comment faire une entrée de texte dans un canvas. Tout à la main.

"tout doux" :


Pourquoi

J'ai entendu des racontars comme quoi "on pouvait tout faire avec un canvas" et j'ai voulu vérifier.

Eh bien... Il l'a fait.


Comment

Le canvas a déjà prévu la gestion du curseur d'insertion et la sélection. Il a suffit de mettre en musique.

Trois rectangles pour la bordure et le fond. Un texte, bien sûr. Quelques binding. Un peu de Tcl. Et c'est parti !


Le script

  package require Tk

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

  # procs gestion entry
  proc createEntry {w var x0 y0 width height} \
  {
    variable {}
    set (entry:$w:$var) [list $x0 $y0 $width $height]
    set (entry:$w:$var:cur) 0
    set x1 [expr {$x0 + $width}]
    set y1 [expr {$y0 + $height}]
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $var $var:nw] \
      -fill "" -outline $(color:dark)
    $w move $var:nw -1 -1
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $var $var:se] \
      -fill "" -outline $(color:light)
    $w move $var:se 1 1
    $w create rectangle $x0 $y0 $x1 $y1 \
      -tags [list $var $var:bg] \
      -fill $(color:bg) -outline $(color:bg)
    set xc [expr {$x0 + 3}]
    set yc [expr {$y0 + 3}]
    $w create text $xc $yc -anchor nw -text [set $var] \
      -tags [list $var txt:$var]
    set (entry:$w:font) [$w itemcget txt:$var -font]
    $w bind txt:$var <ButtonPress-1> [list placeCursor $w $var %x %y]
    $w bind txt:$var <KeyPress> [list editEntry $w $var %K %k]
    $w bind txt:$var <B1-Motion> [list selectEntry $w $var %x %y]
    $w bind txt:$var <Double-1> [list selectEntry $w $var]
    trace add variable $var write [list updateEntry $w $var]
  }
  proc editEntry {w var key code} \
  {
    puts "editEntry $w $var $key $code"
    variable {}
    set text [set $var]
    set len [string length $text]
    set cur [$w index $var insert]
    set first ""
    catch \
    {
      set first [$w index txt:$var sel.first]
      set last [$w index txt:$var sel.last]
    }
    switch -- $key \
    {
      Home      { $w icursor txt:$var 0 }
      End       { $w icursor txt:$var $len }
      Left      { $w icursor txt:$var [incr cur -1] }
      Right     { $w icursor txt:$var [incr cur] }
      BackSpace \
      {
        if {$first != ""} \
        {
          set $var [deleteEntry $w $var $first $last]
        } \
        elseif {$cur > 0} \
        {
          set i [expr {$cur - 2}]
          set $var [string range $text 0 $i][string range $text $cur end]
          $w icursor txt:$var [incr cur -1]
        }
      }
      Delete    \
      {
        if {$first != ""} \
        {
          set $var [deleteEntry $w $var $first $last]
        } \
        elseif {$cur < $len} \
        {
          set i1 [expr {$cur - 1}]
          set i2 [expr {$cur + 1}]
          set $var [string range $text 0 $i1][string range $text $i2 end]
        }
      }
      space     { set key " " }
      default   \
      {
        if {[string length $key] > 1} { return }
      }
    }
    if {[string length $key] == 1} \
    {
      # char
      if {$first != ""} \
      {
        # delete selection
        set cur $first
        set text [deleteEntry $w $var $first $last]
      }
      set n [expr {$cur - 1}]
      # compute value
      set value "[string range $text 0 $n]$key[string range $text $cur end]"
      # check length
      set len [font measure $(entry:$w:font) $value]
      foreach {- - width -} $(entry:$w:$var) break
      if {$len < $width - 4} \
      {
        # update
        set $var $value
        $w icursor txt:$var [incr cur]
      }
    }
    set i [$w index $var insert]
    $w select from txt:$var $i
    set (entry:$w:$var:from) $i
  }
  proc deleteEntry {w var first last} \
  {
    variable {}
    $w select clear
    set text [set $var]
    set text2 ""
    if {$first > 0} \
    {
      incr first -1
      append text2 [string range $text 0 $first]
    }
    incr last
    append text2 [string range $text $last end]
    return $text2
  }
  proc updateEntry {w var args} \
  {
    $w itemconfig txt:$var -text [set $var]
  }
  proc selectEntry {w var {x ""} {y ""}} \
  {
    variable {}
    if {$x == ""} \
    {
      # select all
      set text [set $var]
      set len [string length $text]
      $w select from txt:$var 0
      $w select to txt:$var $len
    } \
    else \
    {
      # selecting
      $w select adjust txt:$var @$x,$y
      set first [$w index txt:$var sel.first]
      set last [$w index txt:$var sel.last]
      set from $(entry:$w:$var:from)
      if {$from > $last} \
      {
        $w select from txt:$var $first
        $w select to txt:$var $from
      }
    }
  }
  proc placeCursor {w var x y} \
  {
    variable {}
    set text [set $var]
    set len [string length $text]
    set font [$w itemcget txt:$var -font]
    foreach {x0 - x1 -} [$w bbox txt:$var] break
    $w icursor txt:$var 0
    for {set i 0} {$i < $len} {incr i} \
    {
      set m [font measure $font [string range $text 0 $i]]
      if {$x0 + $m > $x} { break }
      $w icursor txt:$var [expr {$i + 1}]
    }
    $w focus txt:$var
    $w select clear
    $w select from txt:$var $i
    set (entry:$w:$var:from) $i
  }

Demo

  # exemple d'utilisation
  wm title . Entry-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
  set ::var "my entry"
  createEntry .c ::var $x0 $y0 $bw $bh
  focus -force .c

Voir Aussi


Discussion


Catégorie Exemple | Catégorie Interface utilisateur