|
-
Nov 3rd, 2024, 04:06 AM
#34
Re: RC6 cCairoSurface: Implementing a "biggest font size available" logic
 Originally Posted by tmighty2
I have augmented the code by adding the single line option back in.
There is one situation where the text renders offscreen (left: < 0), and "MaxDxNeeded" is 0:
Dim lRet&
lRet = CC.DrawText(uLeft, uLeft, lEffectiveAvailableWidth, lEffectiveAvailableHeight, uText, uSingleline, uHAlign, 0, lVAlign, dtNormal, 1, , dblWidthNeeded)
Would anybody be willing to take a look where I made a math error?
I don't manage to resolve it. I would appreciate any help very much!
Thank you.
I have hardcoded the width and height in the sample project to show you the problem.
With your now "forced" SingleLine-behaviour via Parameter from the outside -
you can re-use an already existing codeblock in the function...
(the one which starts with the Words-Array-Split)
The only difference now in your "Words-Array" should be, that the Words-Array has only one Member, your whole String:
Code:
'If Not uSingleLine Then is not needed anymore...
Dim Words() As String
If uSingleline Then
ReDim Words(0 To 0)
Words(0) = Replace(s, vbCrLf, " ") ' Replace line breaks with spaces
Else
Words = Split(Replace(s, vbCrLf, " "), " ") 'split the string into individual words
End If
' Initialize the maximum width extent to zero
Dim dblMaxWExt As Double
dblMaxWExt = 0
' Loop through each word to determine the maximum extent
Dim i&
For i = 0 To UBound(Words)
' Get the text extent for the current word
Dim dblWExt As Double
dblWExt = CC.GetTextExtents(Words(i))
' Update the maximum width extent if the current word's extent is larger
If dblMaxWExt < dblWExt Then
dblMaxWExt = dblWExt
End If
Next
' Calculate the allowable width limit based on the inner space
Dim dblWidthLimit As Double
dblWidthLimit = w - 2 * uInnerSpace
' Check if the maximum width extent exceeds the allowed width
If dblMaxWExt > dblWidthLimit Then
' Adjust the font size based on the maximum width extent and width limit
' Calculate the sum of minimum and current font sizes
Dim dblFontSum As Double
dblFontSum = minFontSize + currentFontSize
' Calculate the ratio of font sum to the maximum word extent
Dim dblFontSizeRatio As Double
dblFontSizeRatio = dblFontSum / dblMaxWExt
' Calculate the adjusted width limit
Dim dblAdjustedWidthLimit As Double
dblAdjustedWidthLimit = dblWidthLimit * 0.92
' Calculate the adjusted font size based on the ratio and adjusted width limit
Dim dblAdjustedFontSize As Double
dblAdjustedFontSize = dblFontSizeRatio * dblAdjustedWidthLimit
' Apply the adjusted font size
CC.SelectFont uFontName, dblAdjustedFontSize, uColor, uBold, uItalic, uUnderline
' Recalculate the text rows information with the updated font size
CC.CalcTextRowsInfo s, dblWidthLimit, bMultiLine, bOnlyOnLineBreaks, RowsCharCount, RowsCharOffset, RowCount, MaxRowExtents
' Recalculate the total text height based on the row count and font height
textHeight = RowCount * CC.GetFontHeight
End If
If uMaxFontSize > 0 Then
Debug.Assert currentFontSize <= uMaxFontSize
End If
SetOptimalFSForTextRect = textHeight ' Return the last determined textHeight
End Function
Olaf
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|