I apologize for the delay in replying. I thought someone else had
written something similar to what you're asking about, and it took a
while to determine that there wasn't any such thing.
takanobu maekawa [EMAIL PROTECTED] writes:
I have found DisplayContext class and wonder I can somehow do this
with it... :-D
Yes, I think DisplayContext.get-string-advance-width corresponds
(roughly) to Graphics.MeasureString in VB.
There are a number of different problems that you might be trying to
solve. I'm including an applet that solves one of them. You might be
able to adapt it to your needs. If it doesn't do what you need, let
me know and maybe I can write something that fits better.
--deh!
{curl 4.0 applet}
{define-class public ShrinkingText {inherits Graphic}
field private constant ideal-font-size:Distance
field private constant min-font-size:Distance
field private contents:String =
field private font:Font = {Font sans-serif, 12pt} ||
{constructor public {default
ideal-font-size:Distance = 12pt,
min-font-size:Distance = 4pt,
...
}
set self.ideal-font-size = ideal-font-size
set self.min-font-size = min-font-size
{construct-super ...}
}
{method public {non-keyword-init-arg a:any}:void
{type-switch a
case a:String do
set self.contents = a
else
{super.non-keyword-init-arg a}
}
}
{method private {get-font size:Distance}:Font
{return
{Font
self.font-family,
size,
weight = self.font-weight,
style = self.font-style
}
}
}
{method private {get-font-values
dc:DisplayContext,
size:Distance
}:(font:Font,
width:Distance,
ascent:Distance,
descent:Distance)
let constant font:Font = {self.get-font size}
let constant width:Distance =
{dc.get-string-advance-width font, self.contents}
let constant ascent:Distance = {dc.get-font-ascent font}
let constant descent:Distance = {dc.get-font-descent font}
{return font, width, ascent, descent}
}
{method public {get-width-preference lc:LayoutContext}:Dimension
let constant dc:DisplayContext = lc.layout-display-context
let constant font:Font = {self.get-font self.ideal-font-size}
let constant width:Distance =
{dc.get-string-advance-width font, self.contents}
let constant stretchiness:double =
{if width 0m then
(width / 1pt)
else
.0001
}
let constant elastic:Elastic =
{make-elastic
minimum-size = width,
preferred-size = width,
compressibility = stretchiness,
compress-order = rigid-compress-order,
stretchiness = stretchiness,
stretch-order = rigid-stretch-order
}
{return elastic}
}
{method public {get-height-preference lc:LayoutContext}:Dimension
let constant dc:DisplayContext = lc.layout-display-context
let constant font:Font = {self.get-font self.ideal-font-size}
let constant ascent:Distance = {dc.get-font-ascent font}
let constant descent:Distance = {dc.get-font-descent font}
let constant ascent-stretch-order:int = rigid-stretch-order - 2
let constant oe:OriginElastic =
{make-origin-elastic
first={make-elastic
minimum-size = ascent,
preferred-size = ascent,
stretch-order = ascent-stretch-order
},
last={make-elastic
minimum-size = descent,
preferred-size = descent,
stretch-order = rigid-stretch-order,
compress-order = rigid-compress-order
}
}
{return oe}
}
{method public {set-size lc:LayoutContext, bounds:GRect}:void
let constant dc:DisplayContext = lc.layout-display-context
let constant contents:String = self.contents
let constant max-width:Distance = bounds.rextent
let constant max-ascent:Distance = bounds.ascent
let constant max-descent:Distance = bounds.descent
let constant min-font-size:Distance = self.min-font-size
let current-font-size:Distance = self.ideal-font-size
let (font:Font, width:Distance, ascent:Distance, descent:Distance) =
{self.get-font-values dc, current-font-size}
{while
width max-width or
ascent max-ascent or
descent max-descent
do
{dump width, current-font-size}
{dec current-font-size, 1pt}
set (font, width, ascent, descent) =
{self.get-font-values dc, current-font-size}
{if current-font-size = min-font-size then
{break}
}
}
set self.font = font
}
{method public {draw
