Filling a picture box with best-fit font size
- From: "Desertphile" <desertphile@xxxxxxxxxxx>
- Date: 31 Jan 2006 11:02:22 -0800
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
.
- Prev by Date: Re: Calculating Rhumb line, example
- Next by Date: Re: minor annoyance number 1
- Previous by thread: vbmthmtx.dll link is dead Anybody have a copy I could have
- Next by thread: Visual Basic In Your Face - BACK IN PRINT
- Index(es):
Relevant Pages
|