Version 20 of vertical labels

Updated 2013-09-25 00:45:47 by RLE

MGS - Here's a nasty-ish hack to make labels with vertical text. Not rotated text, just with the letters stacked on top of each other. For spaces, you need to insert two newlines.

     label .l -text "Vertical\n\nLabel" -wraplength 1
     pack  .l

Make sure the label is packed/gridded so as not to expand or fill horizontally.

RS Another way is:

     label .l2 -text [join [split "Vertical text" ""] \n]

This way is slower and alters the actual text contained in the label rather than just how it wraps, though. -FW - RS: Well, it processes a copy of the text, which is perfectly normal in Tcl - but needs no workaround for spaces... ;-)

Mike Tuxford thinks both of those are clever and would come in handy for use with Animated Vertical Tabs

ulis, 2003-01-23. Torsten in c.l.t. asked for a vertical label package. Here it is.

http://perso.wanadoo.fr/maurice.ulis/tcl/vlabel.png

Vlabel 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
        }
      }
    }
  }

Demo

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

ulis, 2004-01-24. The request was a little more: a rotated text that doesn't cost any time or memory. I can't do that in pure Tcl but here is a proc that does the trick, wasting time and memory (and needing Img).

http://perso.wanadoo.fr/maurice.ulis/tcl/rlabel.png

The proc

  package require Img
  
  proc rlabel {w side args} {
    if {$side != "up"} { set side bottom }
    eval [linsert $args 0 label $w]
    pack $w
    update
    image create photo photo -format window -data $w
    destroy $w
    set width [image width photo]
    set height [image height photo]
    set data [photo data]
    image create photo photo2
    for {set x 0} {$x < $width} {incr x} {
      for {set y 0} {$y < $height} {incr y} {
        set xx $x
        set yy $y
        if {$side == "bottom"} { set xx [expr {$width - $x - 1}] }
        if {$side == "up"} { set yy [expr {$height - $y - 1}] }
        photo2 put [lindex $data $yy $xx] -to $y $x
      }
    }
    label $w -image photo2
    return $w
  }

A test

  set font {Helvetica -16 bold}
  pack [rlabel .vl up -text "a rlabel" -fg navy -bg azure -font $font] -side left

See also

escargo 23 Jan 2004 - Wrapped some example code with if 0 { so that I could use wish-reaper to collect and test out the code.

KBK 2008-11-03 Another possibility is to do rotated text in a canvas as line drawing primitives. A version of this is in the Half Bakery at http://wiki.tcl.tk/_repo/hershey/

Mark G. SayeCategory GUICategory Widget