Tcl/tk缩放Truetype字体时的精度问题

proczoominit{c{zfact{1.1}}}{

#savezoomstateinaglobalvariablewiththesamenameasthecanvashandle

upvar#0$cdata

setdata(zdepth)1.0

}

proczoom{cfact}{

upvar#0$cdata

#zoomatthecurrentmouseposition

setx[$ccanvasx[expr{[winfopointerx$c]-[winforootx$c]}]]

sety[$ccanvasy[expr{[winfopointery$c]-[winforooty$c]}]]

$cscaleall$x$y$fact$fact

#savenewzoomdepth

setdata(zdepth)[expr{$data(zdepth)*$fact}]

#zoomtextsincethe"canvasscaleall"commanddoesn'taccountfortextitems

zoomtext$c

puts"zoomfact:$data(zdepth)"

}

proczoomtext{c}{

upvar#0$cdata

#adjustfonts

foreach{i}[$cfindall]{

if{![stringequal[$ctype$i]text]}{continue}

setfontsize0

#getoriginalfontsizeandtextfromtagsiftheywerepreviouslyrecorded

foreach{tag}[$cgettags$i]{

scan$tag{_f%f}fontsize

scan$tag"_t%\[^\0\]"text

}

#ifnot,thenrecordcurrentfontsizeandtextandusethem

setfont[$citemcget$i-font]

if{!$fontsize}{

settext[$citemcget$i-text]

setfontsize[fontactual$font-size]

$caddtag_f$fontsizewithtag$i

$caddtag_t$textwithtag$i

}

#scalefont

setnewsize[expr{$fontsize*$data(zdepth)}]

setindex[lsearch-exact$font-size]

incrindex

setfont[lreplace$font$index$index$newsize]

$citemconfigure$i-font$font-text$text-anchorw

puts"font:$font"

}

#updatecanvasscrollregion

setbbox[$cbboxall]

if{[llength$bbox]}{

$cconfigure-scrollregion$bbox

}{

$cconfigure-scrollregion[list-4-4\

[expr{[winfowidth$c]-4}]\

[expr{[winfoheight$c]-4}]]

}

#movesrollbartotoprightinordertoeasilyobservewhetherthezoomedtext

#goesoutsideoftherectangle

$cxviewmoveto[winfowidth$c]

$cyviewmoveto0

}

#testcode

setc[canvas.c-width600-height500\

-xscrollcommand".shorizset"\

-yscrollcommand".svertset"]

#addx/yscrollbarforthecanvas

scrollbar.svert-orientv-command"$cyview"

scrollbar.shoriz-orienth-command"$cxview"

grid.c-row0-column0-columnspan3-stickynews

grid.svert-row0-column3-columnspan1-stickyns

grid.shoriz-row1-column0-columnspan3-stickyew

gridcolumnconfigure.0-weight1

gridcolumnconfigure.1-weight1

gridcolumnconfigure.2-weight1

gridrowconfigure.0-weight1

zoominit.c

button.zoomin-text"ZoomIn"-command"zoom$c1.25"

button.zoomout-text"ZoomOut"-command"zoom$c0.8"

grid.zoomin.zoomout

settext"Hello,World!Here'sasimpleprocedurecalledzoomthatmighthelptogetyoustarted."

#tfontisatruetypefontrenderingbyWindowsGDIAPIs(GDIfontengine)

settfont[fontactual"-familyArial-size8"]

#ofontisaoutlinefontrenderingbyfreetypefontenginetransplantedbyourself

setofont[fontactual"-family{OFHelvetica}-size8"]

.ccreatetext450-text$text-font$tfont-anchorw-tagtfont

#createarectanglewiththesamesizeofthebboxofthetext.zoomin/outthecanvasandwe

#canobservewhetherthetextiszoomedinthesameproportionastherectangle

.ccreaterect[.cbboxtfont]

.ccreatetext4100-text$text-font$ofont-anchorw-tagofont

.ccreaterect[.cbboxofont]

代码参考资源链接： 
Canvaszoomingusingmousewheel