diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | tests/canvText.test | 57 | ||||
| -rw-r--r-- | win/tkWinFont.c | 4 |
3 files changed, 68 insertions, 3 deletions
@@ -1,3 +1,13 @@ +2004-08-09 Mo DeJong <mdejong@users.sourceforge.net> + + * tests/canvText.test: + * win/tkWinFont.c (Tk_MeasureChars): Fix for text + wrapping problem that appeared using canvas text + under Win32. A long wrapping string that had + leading spaces was being incorrectly wrapped. + This change makes the Win32 implementation behave + the same as the Unix implementation. [Patch 1006286] + 2004-08-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> * library/clrpick.tcl (BuildDialog): diff --git a/tests/canvText.test b/tests/canvText.test index 4578ff0..d8482b9 100644 --- a/tests/canvText.test +++ b/tests/canvText.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: canvText.test,v 1.14 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: canvText.test,v 1.15 2004/08/09 23:45:57 mdejong Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -513,6 +513,61 @@ test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} { .c find enclosed 99 99 [expr $x2 + $i] [expr $y2 + 1] } 1 +test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} { + catch {destroy .c} + set c [canvas .c -bg black -width 964] + pack $c + $c delete all + after 1000 "set done 1" ; vwait done + + set f {Arial 28 bold} + + set s1 { Yeah-ah-ah-ah-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-oh-Yow} + set s2 { Yeah ah ah ah oh oh oh oh oh oh oh oh oh oh oh oh oh oh oh oh Yow} + + $c create text 21 18 \ + -font $f \ + -text $s1 \ + -fill white \ + -width 922 \ + -anchor nw \ + -tags tbox1 + eval {$c create rect} [$c bbox tbox1] -outline red + + $c create text 21 160 \ + -font $f \ + -text $s2 \ + -fill white \ + -width 922 \ + -anchor nw \ + -tags tbox2 + eval {$c create rect} [$c bbox tbox2] -outline red + + after 1000 "set done 1" ; vwait done + + set results [list] + + $c select from tbox2 4 + $c select to tbox2 8 + lappend results [selection get] + + $c select from tbox1 4 + $c select to tbox1 8 + lappend results [selection get] + + array set metrics [font metrics $f] + set x [expr {21 + [font measure $f " "] \ + + ([font measure {Arial 28 bold} "Y"] / 2)}] + set y1 [expr {18 + ($metrics(-linespace) / 2)}] + set y2 [expr {160 + ($metrics(-linespace) / 2)}] + + lappend results [$c index tbox1 @$x,$y1] + lappend results [$c index tbox2 @$x,$y2] + + set results +} {{Yeah } Yeah- 4 4} + + # cleanup cleanupTests return diff --git a/win/tkWinFont.c b/win/tkWinFont.c index c5ee0da..98b24eb 100644 --- a/win/tkWinFont.c +++ b/win/tkWinFont.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinFont.c,v 1.24 2004/05/05 16:49:53 hobbs Exp $ + * RCS: @(#) $Id: tkWinFont.c,v 1.25 2004/08/09 23:45:58 mdejong Exp $ */ #include "tkWinInt.h" @@ -764,7 +764,7 @@ Tk_MeasureChars( end = p; p = source; - ch = 0; + ch = ' '; while (p < end) { next = p + Tcl_UtfToUniChar(p, &ch2); if ((ch != ' ') && (ch2 == ' ')) { |