Un label vertical

 

ulis, 2003-01-23. Voici un package pour un label dont le texte est vertical.


Package

  if {![info exists ::vlabel::version]} \
  {
    namespace eval ::vlabel \
    {
      namespace export vlabel
      package require Tk
      variable version 0.1
      package provide Vlabel $version
      proc vlabel {w args} \
      {
        label $w
        rename $w ::vlabel::_$w
        interp alias {} ::$w {} ::vlabel::vdispatch $w
        if {[llength $args] %2 == 1} \
        { return -code error "value for \"[lindex $args end]\" missing" }
        if {$args != ""} { eval vconfig $w $args }
        return $w
      }
      proc vtext {text} { join [split $text {}] \n }
      proc vdispatch {w {cmd ""} args} \
      {
        set rc [catch \
        {
          switch -glob -- $cmd \
          {
            con*    { uplevel 1 ::vlabel::vconfig $w $args }
            default { uplevel 1 ::vlabel::_$w $cmd $args }
          }
        } res]
        if {$rc != 1} { return -code $rc $res } \
        else \
        { return -code 1 [string map [list ::vlabel::_$w $w] $res] }
      }
      proc vconfig {w args} \
      {
        set l [llength $args]
        if {$l == 0} { return [eval ::vlabel::_$w config $args] }
        set n 0
        foreach {key value} $args \
        {
          incr n
          if {$n == $l} { return [::vlabel::_$w config $key] }
          switch -glob -- $key \
          {
            -text   \
            { ::vlabel::_$w config -text [vtext $value] }
            default \
            { ::vlabel::_$w config $key $value }
          }
          incr n
        }
      }
    }
  }

Démo

  package require Vlabel
  namespace import ::vlabel::vlabel
  pack [vlabel .l -text vlabel -bg gold]

Voir aussi


Discussion

dMc(23 mars 2007): et pourquoi pas simplement un "text", un "message" ou même un "label"?

 #_________________________

 # 2 simili-labels verticaux
 #__ dMc ________________

 package require Tk

 #<COMMANDE_NOUVELLE_VtextoLabel>

 # On utilisera cette commande comme pour
 # un widget ordinaire avec les options
 # la seule précaution sera de mettre les "options"
 # entre 2 accolades ou 2 guillemets
 # de même que le "texto" à insérer.

 proc VtextoLabel {widget options texto} {
	eval "text  $widget $options"
 	for {set i 0} {$i <= [string length $texto ]} {incr i} {
		$widget insert end "\n[string index $texto $i ]"
		}
	$widget configure -state disabled
 }

 #<DEMO>

 VtextoLabel .t  {-bg brown  -fg white -relief raise\
 -spacing1 1 -spacing2 3 -spacing3 5 -padx 10 \
 -font {helvetica 16 bold} -width 1 } "les poules vertes"
 pack .t -side left -expand 0

 # methode encore plus simple !
 pack [message .m -width 3 -text "poule\n à\n vendre" -bg azure] -side right -fill y

 pack [text .tt -wrap word -font {helvetica 14 italic } -width 15 ] -side right -expand true -fill both

 .tt insert end "Le label à gauche est un faux label.

 Il s'agit d'un ''text'' qui refuse que l'utilisateur final le modifie,
 grace à l'option ''-state'' qui est mis à ''disabled''.

 Le label rouge et or est un vrai ''label''.

 Quant au faux label à droite, il s'agit d'un ''message'' classique ! "

 set texto "Un \n label \n ordinaire"

 pack [ label .l -wraplength 1 -width 3 -relief raise -bg red -fg yellow \
 -font {courier 16 bold italic} -text $texto] \
 -side right -expand true -fill y

 # _____________________

ulis Faisons dans le simple :

  set texte "vertical"
  label .vl -text [join [split $texte {}] \n]

:-)

Bien sur, ce n'est plus un package tout ficelé.


Catégorie Exemple | Catégorie Widget | Catégorie Interface utilisateur