label .l -text "Vertical\n\nLabel" -wraplength 1
pack .lMake 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... ;-)AMG: Or this, which is faster (1.0 microseconds versus 1.7 microseconds in my test):
label .l3 -text [string range [regsub -all {} "Vertical text" \n] 1 end]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
}
}
}
}Demopackage 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 ne "up"} { set side bottom }
label $w {*}$args
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 eq "bottom"} { set xx [expr {$width - $x - 1}] }
if {$side eq "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 leftKBK 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/
