| Roger Niva 2006-03-29, 4:08 am |
| mdn wrote:
> Hi,
>
> As you saw the label on the tab is just text on a canvas, not a label
> widget, so changing notebook.tcl to incorporate an -underline option
> would probably be a bit of work. Below you find an add hoc solution that
> is perhaps good enough for what you want, but perhaps not. By the way,
> if you want a version of notebook.tcl that supports tab-navigation (the
> tabs can get the focus and then the left and right arrow keys raise the
> page to the left/right, it looks ugly though) drop me a mail, cause that
> is what I use, so you can get it from me.
>
> Cheers,
> Michiel
>
> package require BWidget
>
> proc makeNotebookUnderline {path page underline {ulength 5}} {
> set txt [${path}.c itemcget ${page}:text -text]
> set fnt [$path.c itemcget $page:text -font]
> set partText [string range $txt 0 $underline]
> foreach {xtext ytext tmp2 yuline} [$path.c bbox $page:text] { break }
> incr yuline -1
> if {$partText ne ""} {
> $path.c create text $xtext $ytext -text $partText -font $fnt \
> -anchor nw -tags tmpText2GetLocation
> set xuline [lindex [$path.c bbox tmpText2GetLocation] 2]
> set xuline [expr int($xuline - 0.5*$ulength)]
> incr xuline -1
> $path.c delete tmpText2GetLocation
> } else {
> return
> }
> $path.c create line [expr $xuline - 0.5*$ulength] $yuline \
> [expr $xuline + 0.5*$ulength] $yuline -tag p:$page
> return
> }
>
> NoteBook .nb
> .nb insert end pag1 -text "first page"
> .nb insert end pag2 -text "second page"
> pack .nb -fill both -expand yes
> makeNotebookUnderline .nb pag1 0
> makeNotebookUnderline .nb pag2 2
Thanks a bunch! I had been looking at creating a new underlined character and
placing it ontop of the character that should be underlined, but for some
reason or other it didn't go so well.
This saved me a lot of time(and grief, probably).
I made a few changes to the proc because the underline was slightly off in my
setup. A font measure seemed to fix it nicely.
proc makeNotebookUnderline { path page underline } {
set txt [${path}.c itemcget ${page}:text -text]
set fnt [$path.c itemcget $page:text -font]
set partText [string range $txt 0 $underline]
if {$partText eq ""} { return }
set xUnderline [font measure $fnt -displayof $path [string range $txt
$underline $underline]]
foreach {xtext ytext tmp2 yuline} [$path.c bbox $page:text] { break }
$path.c create text $xtext $ytext -text $partText -font $fnt \
-anchor nw -tags tmpText2GetLocation
set bbox [$path.c bbox tmpText2GetLocation]
$path.c delete tmpText2GetLocation
foreach {x1 y1 x2 y2} $bbox { break }
$path.c create line [expr {$x2-$xUnderline}] $y2 $x2 $y2 -tag p:$page -width 3
}
--
Roger
|