Public Function DrawNormalText(ByVal strFontName As String, ByVal lngFontColor As Long, _
ByVal StringAlignMode As StringAlignment, _
ByVal sngFontSize As Single, ByVal lngFontStyle As Long, _
ByVal DrawUnit As GpUnit, ByVal TextRenderMode As TextRenderingHint, _
ByVal lngLeft As Long, ByVal lngTop As Long, _
ByVal lngWidth As Long, ByVal lngHeight As Long, ByVal strText As String) As Boolean
Dim gpP As String ' GpStatus
Dim lngCurFont As Long
Dim rclayout As RECTF
Dim lngFontFamily As Long
Dim lngStringFormat As Long
Dim lngSolidBrush As Long
Dim lngGraphics As Long
Call InitGDIPlus
'On Error GoTo errFun
gpP = gpP & "," & GdipCreateFromHDC(Me.hdc, lngGraphics)
gpP = gpP & "," & GdipCreateFontFamilyFromName(StrConv(strFontName, vbUnicode), 0, lngFontFamily)
gpP = gpP & "," & GdipCreateStringFormat(0, 0, lngStringFormat)
gpP = gpP & "," & GdipCreateSolidFill("&HFFFF0000", lngSolidBrush)
gpP = gpP & "," & GdipSetStringFormatAlign(lngStringFormat, StringAlignMode)
gpP = gpP & "," & GdipCreateFont(lngFontFamily, sngFontSize, lngFontStyle, DrawUnit, lngCurFont)
gpP = gpP & "," & GdipSetTextRenderingHint(lngGraphics, TextRenderMode)
With rclayout
.Left = lngLeft
.Top = lngTop
.Right = .Left + lngWidth
.Bottom = .Top + lngHeight
End With
gpP = gpP & "," & GdipDrawString(lngGraphics, StrConv(strText, vbUnicode), -1, lngCurFont, rclayout, lngStringFormat, lngSolidBrush)
gpP = gpP & "," & GdipDeleteFontFamily(lngFontFamily)
gpP = gpP & "," & GdipDeleteStringFormat(lngStringFormat)
gpP = gpP & "," & GdipDeleteFont(lngCurFont)
gpP = gpP & "," & GdipDeleteBrush(lngSolidBrush)
If Replace(gpP, ",0", "") <> "" Then
MsgBox gpP
End If
lngSolidBrush = 0
lngFontFamily = 0
If IsNull(gpP) Then
DrawNormalText = False
Else
DrawNormalText = True
End If
Call TerminateGDIPlus
Exit Function
errFun:
DrawNormalText = False
Call TerminateGDIPlus
End Function
Private Sub Command1_Click()
Me.Cls
DrawNormalText "宋体", vbRed, StringAlignmentCenter, 28, 1, UnitPixel, TextRenderingHintAntiAlias, 10, 10, 200, 200, Text1.Text
Me.Refresh
End Sub