Quote Originally Posted by tmighty2 View Post
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