Version 15 of vertical labels

Updated 2004-01-24 22:49:19

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.

 if 0 {
     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:

 if 0 {
     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.

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).

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

• Rotate text and images using img extension

---

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.

---

Category GUI

Category Widget