Filling a picture box with best-fit font size



This works fairly good. It ought to work just as well for user controls
and whatnot. My previous technique was to use an invisible lable
control with the autosize set to "true" and examine the label's height
and width as the label control's font size incremented.


=================================

Option Explicit

Private Declare Function GetTextExtentPoint32 Lib "gdi32" _
Alias "GetTextExtentPoint32A" _
(ByVal hDC As Long, _
ByVal lpString As String, _
ByVal cbString As Long, _
lpSize As SIZE) As Long

Private Declare Function GetClientRect Lib "user32" _
(ByVal hWnd As Long, _
lpRect As RECT) As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type SIZE
cx As Long
cy As Long
End Type

Dim rc As RECT, sz As SIZE, RetVal As Long, sText As String, sLen As
Integer

Private Sub Form_Resize()
Picture1.Width = Me.Width - 200
Picture1.Height = Me.Height - 200
Picture1.Cls

sText = "Hello World"
sLen = Len(sText)

RetVal = GetClientRect(Picture1.hWnd, rc)

Do
RetVal = GetTextExtentPoint32(Picture1.hDC, sText, sLen, sz)

If sz.cx < rc.Right And sz.cy < rc.Bottom Then
Picture1.FontSize = Picture1.FontSize + 1
Else
Picture1.FontSize = Picture1.FontSize - 1
Exit Do
End If
Loop

Picture1.CurrentX = 0
Picture1.CurrentY = 0
Picture1.Print sText;
End Sub

.



Relevant Pages