[JOB] 17-12-12: Based on [Quick photo rotation], a code snippet from [RS], I created a small utility package for the incredible [tablelist] widget brought to us by [Csaba Nemethi]. Please also note that tablelist 6.0 is out now and offers even more enrichments (tablelist header subcommands and more!). The embeddedWindows.tcl demo gives a glance of what's new. With the following text2rotatedimage package you can create vertical aligned header text, which might be quite useful to decrease the overall width of a tablelist widget. [WikiDBImage text2rotatedimage_tabelist_test.png] Of course you can also create buttons or labes with vertical text: [WikiDBImage text2rotatedimage_button_with_vertical_text.png] Down below is the source code of the package. It is flagged as experimental, so please feel free to place any comments or improvements. * pkgIndex.tcl ====== package ifneeded text2rotatedimage 0.1 [list source [file join $dir text2rotatedimage.tcl]] ====== * text2rotatedimage.tcl ====== # ------------------------------------------------------------------------- # text2rotatedimage.tcl # ------------------------------------------------------------------------- # (c) 2016, Johann Oberdorfer - Engineering Support | CAD | Software # johann.oberdorfer [at] googlemail.com # www.johann-oberdorfer.eu # ------------------------------------------------------------------------- # This source file is distributed under the BSD license. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. # See the BSD License for more details. # # Credits: # Many thanks to Richard Suchenwirth for his ideas and the # source code published on the tcler's wiki: http://wiki.tcl.tk/12545 # # Description: # # Create an image file (*.png) out from a given text string. # - The image file name is the same as the text # - and unless otherwise specified, # the image is stored in the temp directory. # - If an image file already exists, it wont'b be generated. # # The reason for this was basicly to generate vertical text for # tablelist header items (by overriding the header label images). # The implemented solution is pretty slow but simple and # serves the purpose. # # ------------------------------------------------------------------------- # Change History: # 17-12-09: Initial release, Johann Oberdorfer # ------------------------------------------------------------------------- package require Img package require fileutil package provide text2rotatedimage 0.1 namespace eval text2rotatedimage { namespace export text2imagefile rotateheadertext proc imgrot90 {img {clockwise 0}} { set w [image width $img] set h [image height $img] set matrix [string repeat "{[string repeat {0 } $h]} " $w] if $clockwise { set x0 0; set y [expr {$h-1}]; set dx 1; set dy -1 } else { set x0 [expr {$w-1}]; set y 0; set dx -1; set dy 1 } foreach row [$img data] { set x $x0 foreach pixel $row { lset matrix $x $y $pixel incr x $dx } incr y $dy } set im2 [image create photo -width $h -height $w] $im2 put $matrix return $im2 } # arguments: # dir: specifies the directory, where to write the file, # do nothing, if the file already exists, # text: to be converted to a rotated image, # args: additional arguments to manipulate font # (same as for the label widget), see demo code # proc text2imagefile {dir text args} { # fall back solution, in case the directory does not exist # if { ![file isdirectory $dir] } { set dir [fileutil::tempdir] } set fname [file join $dir "${text}.png"] # puts ">> Processing $fname ..." if { ![file exists $fname] } { set t [toplevel .temp] wm geometry $t "+5+5" wm attributes . -alpha 1 -topmost 1 raise $t pack [eval [list label $t.l -text $text] $args] update ;# idletasks # need to hold on for a while, to make sure # label creation is finished (got some strange behavior # when running this code within a starkit executable under windows) # note: "tkwait visibility $t" is not working under windows at all (!) # after 300 "set [namespace current]::_continue_ 1" tkwait variable "[namespace current]::_continue_" set i0 [image create photo -data $t.l] destroy $t set img [imgrot90 $i0] $img write $fname -format PNG } return $fname } # rotates the header text of a given tablelist # note: run this function after a tablelist widget has been already # initialized with data. this way, the user is not forced to wait # for too long... # proc rotateheadertext {dir tbl ctrl_list} { if { ![info exists tbl] || ![winfo exists $tbl] } { return } set tbl_labels [$tbl labels] if { [llength $tbl_labels] == 0 } { return } # read header information... set cnt 0 set empty_titles {} foreach lpath $tbl_labels { set ltext [$lpath cget -text] if { [lindex $ctrl_list $cnt] == 1 } { # the following command sequence also returns # each individual label widget path # set lpath [$tbl labelpath $cnt] # puts ">> Processing: $ltext ..." set fname [text2imagefile $dir $ltext] if { [file exists $fname] } { update set img [image create photo -file $fname] $lpath configure -image $img update idletasks } lappend empty_titles {} } else { lappend empty_titles $ltext } incr cnt } # reset column titles, otherwise they are still shown and # will mess up with the already declared images :=( ... $tbl configure -columntitles $empty_titles -labelpady 4 } } ====== * text2rotatedimage_test.tcl ====== set dir [file dirname [info script]] lappend auto_path [file join $dir "."] package require Img package require text2rotatedimage namespace import text2rotatedimage::* set tempdir [file join $dir "temp"] file mkdir $tempdir # --Testing demo, usage example: wm withdraw . set cnt 0 foreach txt {Hello-world example} { if {$cnt == 0} { text2imagefile $tempdir $txt -fg red -font {Courier 11} } else { text2imagefile $tempdir $txt } incr cnt } set t [toplevel .test] raise $t ttk::button $t.l \ -image [image create photo -file [file join $tempdir "Hello-world.png"]] pack $t.l ====== * text2rotatedimage_tabelist_test.tcl In order to get the code running, please copy over the checked.gif and unchecked.gif images from the tablelist package. ====== # specify, where to find support packages: set cdir [file dirname [info script]] lappend auto_path [file join $cdir "."] lappend auto_path [file join $cdir "../../lib"] package require Img package require tablelist_tile 6.0 package require text2rotatedimage # --Testing demo, usage example: catch {console show} # ---- BEGIN: copied over from tablelist's demo ---- wm title . "Tablelist test..." set f [ttk::frame .f] set tbl $f.tbl tablelist::tablelist $tbl \ -columns {0 "No." right 0 "Available" center 0 "Name" left 0 "Baud Rate" right 0 "Data Bits" center 0 "Parity" left 0 "Stop Bits" center 0 "Handshake" left 0 "Activation Date" center 0 "Activation Time" center 0 "Cable Color" center} \ -height 0 -width 0 # -editstartcommand editStartCmd -editendcommand editEndCmd set btn [ttk::button $f.btn -text "Close" -command exit] # # Manage the widgets # pack $btn -side bottom -pady 10 pack $tbl -side top -expand yes -fill both pack $f -expand yes -fill both $tbl columnconfigure 0 -sortmode integer $tbl columnconfigure 1 -name available -editable yes \ -editwindow ttk::checkbutton -formatcommand emptyStr $tbl columnconfigure 2 -name lineName -editable yes -editwindow ttk::entry \ -sortmode dictionary $tbl columnconfigure 3 -name baudRate -editable yes -editwindow ttk::combobox \ -sortmode integer if {[info commands ttk::spinbox] eq ""} { $tbl columnconfigure 4 -name dataBits -editable yes -editwindow spinbox } else { $tbl columnconfigure 4 -name dataBits -editable yes -editwindow ttk::spinbox } $tbl columnconfigure 5 -name parity -editable yes -editwindow ttk::combobox $tbl columnconfigure 6 -name stopBits -editable yes -editwindow ttk::combobox $tbl columnconfigure 7 -name handshake -editable yes -editwindow ttk::combobox $tbl columnconfigure 8 -name actDate -editable yes -editwindow ttk::entry \ -formatcommand formatDate -sortmode integer $tbl columnconfigure 9 -name actTime -editable yes -editwindow ttk::entry \ -formatcommand formatTime -sortmode integer $tbl columnconfigure 10 -name color -editable yes \ -editwindow ttk::menubutton -formatcommand emptyStr proc emptyStr val { return "" } proc formatDate val { return [clock format $val -format "%Y-%m-%d"] } proc formatTime val { return [clock format $val -format "%H:%M:%S"] } # # Create two images, to be displayed in tablelist cells with boolean values # image create photo checkedImg -file [file join $cdir checked.gif] image create photo uncheckedImg -file [file join $cdir unchecked.gif] # # Create 16 images representing different colors # set colorNames { "red" "green" "blue" "magenta" "yellow" "cyan" "light gray" "white" "dark red" "dark green" "dark blue" "dark magenta" "dark yellow" "dark cyan" "dark gray" "black" } set colorValues { #FF0000 #00FF00 #0000FF #FF00FF #FFFF00 #00FFFF #C0C0C0 #FFFFFF #800000 #008000 #000080 #800080 #808000 #008080 #808080 #000000 } foreach name $colorNames value $colorValues { set colors($name) $value } foreach value $colorValues { image create photo img$value -height 13 -width 13 img$value put gray50 -to 0 0 13 1 ;# top edge img$value put gray50 -to 0 1 1 12 ;# left edge img$value put gray75 -to 0 12 13 13 ;# bottom edge img$value put gray75 -to 12 1 13 12 ;# right edge img$value put $value -to 1 1 12 12 } set clock [expr {[clock seconds] + 600}] for {set i 0; set n 1} {$i < 16} {set i $n; incr n} { $tbl insert end [list $n [expr {$i < 8}] "Line $n" 9600 8 None 1 XON/XOFF \ $clock $clock [lindex $colorNames $i]] set availImg [expr {($i < 8) ? "checkedImg" : "uncheckedImg"}] $tbl cellconfigure end,available -image $availImg $tbl cellconfigure end,color -image img[lindex $colorValues $i] } # ---- END: copied over from tablelist's demo ---- set tempdir [file join $cdir "temp"] file mkdir $tempdir set ctrl_list {1 1 0 1 1 1 1 0 0 0 1} # set ctrl_list {}; foreach dummy [$tbl labels] { lappend ctrl_list 1 } # finally: # ---------------------------------------------------------- text2rotatedimage::rotateheadertext $tempdir $tbl $ctrl_list # ---------------------------------------------------------- ====== <> Package | Widget