GDI+绘制文字的有关问题

2012-12-17

GDI+绘制文字的问题最近在写个小程序，用到了点GDI+，但是在绘制文字的时候遇到了问题。比如我要输出一段文

GDI+绘制文字的问题
最近在写个小程序，用到了点GDI+，但是在绘制文字的时候遇到了问题。
比如我要输出一段文字，但是输出的区域可能已经存在文字了，我该怎么做才能将之前的文字覆盖，而不是重叠
原来GDI的TextOut好像没问题，但是GdipDrawString会有重叠的现象，不知道该怎么解决~
请教各位，谢谢！
[最优解释]
先把原来的清除掉再绘制不就OK了？
[其他解释]

'1、在网上下载一个GDIPlus.tlb，下载地址：http://download.csdn.net/detail/veron_04/4237285
'2、使用Gdiplus.tlb，将其放到system32中，然后添加对其的引用
'3、手动设置Form的AutoRedraw＝True，ScaleMode=Pixels
Option Explicit
Dim lngGraphics As Long
Dim gpP As GpStatus
Dim lngPen1 As Long
Dim lngToken As Long
Dim lngSolidBrush As Long
Dim GpInput As GdiplusStartupInput
Private lngFontFamily As Long               '字体类型
Private lngStringFormat As Long             '字符串格式

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'设置字体大小为图片框的显示宽度：Picture1.ScaleHeight
'设置显示的区域高度为：Picture1.ScaleHeight
'设置显示的区域高度为：Picture1.ScaleWidth
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub Command1_Click()
    Dim intP As Integer
    Dim bolP As Boolean
    Picture1.Cls
    gpP = GdipCreateFromHDC(Picture1.hDC, lngGraphics)
    bolP = DrawNormalText("宋体", &H80FF00FF, StringAlignmentCenter, 50, FontStyle.FontStyleBold, UnitPixel, TextRenderingHintAntiAlias, 5, 5, 80, 80, "中")
    Picture1.Refresh

End Sub

Private Sub Form_Load()
    Dim bolP As Boolean

    With Me
        .Caption = "GDIPlus范例"
        .Width = 960 * 15
        .Height = 720 * 15
        .Left = (Screen.Width - .Width) * 0.5
        .Top = (Screen.Height - .Height) * 0.5
    End With
    '以下两个属性最好手动设置
    Picture1.AutoRedraw = True
    Picture1.ScaleMode = 3
    Picture1.Width = Picture1.Height    '使图片框的长宽一致

    GpInput.GdiplusVersion = 1
    If lngToken = 0 Then bolP = (GdiplusStartup(lngToken, GpInput) = Ok)
    bolP = SetSmoothingMode(SmoothingModeAntiAlias)

End Sub
'************************************************************************************************************************
'函数功能：按照一定的格式书写文字，正常排列（不包括：旋转、描边等）
'参数说明：strFontName：字体名称
'        ：lngFontColor：文字颜色
'        ：stringAlignMode：对齐方式
'        ：sngFontSize：字体大小
'        ：lngFontStyle：字体样式（粗体、斜体..）
'        ：DrawUnit：绘图单元
'        ：TextRenderMode：文本渲染模式

'        ：lngLeft：绘制文本区域    Left
'        ：lngTop：绘制文本区域     Top
'        ：lngWidth：绘制文本区域   Width
'        ：lngHeight：绘制文本区域  Height
'        ：strText：要书写的文本
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Private 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 GpStatus
    Dim lngCurFont As Long
    Dim rclayout As RECTF
On Error GoTo errFun
    gpP = GdipCreateFontFamilyFromName(strFontName, 0, lngFontFamily)
    gpP = GdipCreateStringFormat(0, 0, lngStringFormat)
    gpP = GdipCreateSolidFill(lngFontColor, lngSolidBrush)
    gpP = GdipSetStringFormatAlign(lngStringFormat, StringAlignMode)
    gpP = GdipCreateFont(lngFontFamily, sngFontSize, lngFontStyle, DrawUnit, lngCurFont)
    gpP = GdipSetTextRenderingHint(lngGraphics, TextRenderMode)
    With rclayout
        .Left = lngLeft
        .Top = lngTop
        .Width = lngWidth
        .Height = lngHeight
    End With
    gpP = GdipDrawString(lngGraphics, strText, -1, lngCurFont, rclayout, lngStringFormat, lngSolidBrush)
    gpP = GdipDeleteFontFamily(lngFontFamily)
    gpP = GdipDeleteStringFormat(lngStringFormat)
    gpP = GdipDeleteFont(lngCurFont)
    gpP = GdipDeleteBrush(lngSolidBrush)
    lngSolidBrush = 0
    lngFontFamily = 0

    If IsNull(gpP) Then

        DrawNormalText = False
    Else
        DrawNormalText = True
    End If

    Exit Function
errFun:
    DrawNormalText = False
End Function
'************************************************************************************************************************
'函数功能：按照一定的格式书写文字，特殊格式包括：旋转、描边等
'参数说明：strFontName：字体名称
'        ：lngBrushColor：文字颜色
'        ：stringAlignMode：对齐方式
'        ：lngFontStyle：字体样式（粗体、斜体..）
'        ：lngLineColor：边框颜色
'        ：sngLineWidth：边框宽度
'        ：DrawLineUnit：边框绘制单位
'        ：sngFontSize：字体大小
'        ：lngLeft：绘制文本区域    Left
'        ：lngTop：绘制文本区域     Top
'        ：lngWidth：绘制文本区域   Width
'        ：lngHeight：绘制文本区域  Height
'        ：strText：要书写的文本
'        ：dblAngle：字符串和X轴正方向的夹角（0～2*Pi）
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Private Function DrawSpecialText(ByVal strFontName As String, ByVal lngBrushColor As Long, _
                         ByVal StringAlignMode As StringAlignment, ByVal lngFontStyle As Long, _
                         ByVal lngLineColor As Long, ByVal sngLineWidth As Single, _
                         ByVal DrawLineUnit As GpUnit, ByVal BrushMode As FillMode, _
                         ByVal sngFontSize As Single, ByVal lngLeft As Long, _
                         ByVal lngTop As Long, ByVal lngWidth As Long, _
                         ByVal lngHeight As Long, ByVal strText As String, _
                         ByVal dblAngle As Double) As Boolean
    Dim gpP As GpStatus
    Dim lngStringPath As Long
    Dim rclayout As RECTL
On Error GoTo errFun
    gpP = GdipCreateFontFamilyFromName(strFontName, 0, lngFontFamily)       '创建字体类型

    gpP = GdipCreateStringFormat(0, 0, lngStringFormat)                     '创建字符串格式
    gpP = GdipSetStringFormatAlign(lngStringFormat, StringAlignMode)        '设置字符串格式
    gpP = GdipCreateSolidFill(lngBrushColor, lngSolidBrush)                  '创建一个实心刷子
    gpP = GdipCreatePen1(lngLineColor, sngLineWidth, DrawLineUnit, lngPen1)

    With rclayout
        .Left = lngLeft
        .Top = lngTop
        .Width = lngWidth
        .Height = lngHeight
    End With
    gpP = GdipCreatePath(BrushMode, lngStringPath)
    gpP = GdipAddPathStringI(lngStringPath, strText, -1, lngFontFamily, _
                             lngFontStyle, sngFontSize, rclayout, lngStringFormat)
    gpP = GdipFillPath(lngGraphics, lngSolidBrush, lngStringPath)
    gpP = GdipDrawPath(lngGraphics, lngPen1, lngStringPath)
    If IsNull(gpP) Then
        DrawSpecialText = False
    Else
        DrawSpecialText = True
    End If

    gpP = GdipDeleteFontFamily(lngFontFamily)
    gpP = GdipDeleteStringFormat(lngStringFormat)
    gpP = GdipDeletePath(lngStringPath)
    gpP = GdipDeleteBrush(lngSolidBrush)
    gpP = GdipDeletePen(lngPen1)
    lngSolidBrush = 0
    lngFontFamily = 0
    lngPen1 = 0



    Exit Function
errFun:
    DrawSpecialText = False
End Function
'************************************************************************************************************************
'函数功能：
'参数说明：X：矩形左上角的X坐标
'        ：Y：矩形左上角的Y坐标
'        ：W：矩形的宽
'        ：H：矩形的高
'        ：lngLineColor：线段颜色，带透明的RGB颜色
'        ：sngLineWidth：线粗
'        ：PenUnit：绘图基本单元
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Public Function DrawRectangleI(ByVal X As Long, ByVal Y As Long, _
                                      ByVal W As Long, ByVal H As Long, _

                                      ByVal lngLineColor As Long, ByVal sngLineWidth As Long, _
                                      ByVal PenUnit As GpUnit) As Boolean
    Dim gpP As GpStatus
On Error GoTo errFun
    GdipCreatePen1 lngLineColor, sngLineWidth, PenUnit, lngPen1
    gpP = GdipDrawRectangleI(lngGraphics, lngPen1, X, Y, W, H)
    gpP = GdipDeletePen(lngPen1)
    lngPen1 = 0
    If IsNull(gpP) Then
        DrawRectangleI = False
    Else
        DrawRectangleI = True
    End If
    Exit Function
errFun:
    DrawRectangleI = False
End Function
'************************************************************************************************************************
'函数功能：绘制一条实直线段
'参数说明：X1：直线段起点的X坐标
'        ：Y1：直线段起点的Y坐标
'        ：X2：直线段终点的X坐标
'        ：Y2：直线段终点的Y坐标
'        ：lngLineColor：线段颜色，带透明的RGB颜色
'        ：sngLineWidth：线粗
'        ：intPenUnit：绘图基本单元
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Public Function DrawLineI(ByVal X1 As Long, ByVal Y1 As Long, _
                                ByVal X2 As Long, ByVal Y2 As Long, _
                                ByVal lngLineColor As Long, ByVal sngLineWidth As Long, _
                                ByVal intPenUnit As GpUnit) As Boolean
    Dim gpP As GpStatus
On Error GoTo errFun
    GdipCreatePen1 lngLineColor, sngLineWidth, intPenUnit, lngPen1
    gpP = GdipDrawLineI(lngGraphics, lngPen1, X1, Y1, X2, Y2)
    gpP = GdipDeletePen(lngPen1)
    lngPen1 = 0
    If IsNull(gpP) Then
        DrawLineI = False
    Else
        DrawLineI = True
    End If
    Exit Function

errFun:
    DrawLineI = False
End Function
'************************************************************************************************************************
'函数功能：设置绘图设备场景的抗锯齿属性
'参数说明：stmP：SmoothingMode类型，抗锯齿属性值
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Public Function SetSmoothingMode(ByVal stmP As SmoothingMode) As Boolean
    Dim gpP As GpStatus
On Error GoTo errFun
    If lngGraphics = 0 Then Exit Function
    gpP = GdipSetSmoothingMode(lngGraphics, stmP)
    If IsNull(gpP) Then
        SetSmoothingMode = False
    Else
        SetSmoothingMode = True
    End If
    Exit Function
errFun:
    SetSmoothingMode = False
End Function

[其他解释]

    GpInput.GdiplusVersion = 1
    If lngToken = 0 Then bolP = (GdiplusStartup(lngToken, GpInput) = Ok)
    bolP = SetSmoothingMode(SmoothingModeAntiAlias)

End Sub
'************************************************************************************************************************
'函数功能：按照一定的格式书写文字，正常排列（不包括：旋转、描边等）
'参数说明：strFontName：字体名称
'        ：lngFontColor：文字颜色
'        ：stringAlignMode：对齐方式
'        ：sngFontSize：字体大小
'        ：lngFontStyle：字体样式（粗体、斜体..）
'        ：DrawUnit：绘图单元
'        ：TextRenderMode：文本渲染模式
'        ：lngLeft：绘制文本区域    Left
'        ：lngTop：绘制文本区域     Top
'        ：lngWidth：绘制文本区域   Width
'        ：lngHeight：绘制文本区域  Height
'        ：strText：要书写的文本
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Private 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 GpStatus
    Dim lngCurFont As Long
    Dim rclayout As RECTF
On Error GoTo errFun
    gpP = GdipCreateFontFamilyFromName(strFontName, 0, lngFontFamily)
    gpP = GdipCreateStringFormat(0, 0, lngStringFormat)
    gpP = GdipCreateSolidFill(lngFontColor, lngSolidBrush)
    gpP = GdipSetStringFormatAlign(lngStringFormat, StringAlignMode)
    gpP = GdipCreateFont(lngFontFamily, sngFontSize, lngFontStyle, DrawUnit, lngCurFont)
    gpP = GdipSetTextRenderingHint(lngGraphics, TextRenderMode)
    With rclayout
        .Left = lngLeft

        .Top = lngTop
        .Width = lngWidth
        .Height = lngHeight
    End With
    gpP = GdipDrawString(lngGraphics, strText, -1, lngCurFont, rclayout, lngStringFormat, lngSolidBrush)
    gpP = GdipDeleteFontFamily(lngFontFamily)
    gpP = GdipDeleteStringFormat(lngStringFormat)
    gpP = GdipDeleteFont(lngCurFont)
    gpP = GdipDeleteBrush(lngSolidBrush)
    lngSolidBrush = 0
    lngFontFamily = 0

    If IsNull(gpP) Then
        DrawNormalText = False
    Else
        DrawNormalText = True
    End If

    Exit Function
errFun:
    DrawNormalText = False
End Function
'************************************************************************************************************************
'函数功能：按照一定的格式书写文字，特殊格式包括：旋转、描边等
'参数说明：strFontName：字体名称
'        ：lngBrushColor：文字颜色
'        ：stringAlignMode：对齐方式
'        ：lngFontStyle：字体样式（粗体、斜体..）
'        ：lngLineColor：边框颜色
'        ：sngLineWidth：边框宽度
'        ：DrawLineUnit：边框绘制单位
'        ：sngFontSize：字体大小
'        ：lngLeft：绘制文本区域    Left
'        ：lngTop：绘制文本区域     Top
'        ：lngWidth：绘制文本区域   Width
'        ：lngHeight：绘制文本区域  Height
'        ：strText：要书写的文本
'        ：dblAngle：字符串和X轴正方向的夹角（0～2*Pi）
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Private Function DrawSpecialText(ByVal strFontName As String, ByVal lngBrushColor As Long, _
                         ByVal StringAlignMode As StringAlignment, ByVal lngFontStyle As Long, _
                         ByVal lngLineColor As Long, ByVal sngLineWidth As Single, _
                         ByVal DrawLineUnit As GpUnit, ByVal BrushMode As FillMode, _
                         ByVal sngFontSize As Single, ByVal lngLeft As Long, _
                         ByVal lngTop As Long, ByVal lngWidth As Long, _

                         ByVal lngHeight As Long, ByVal strText As String, _
                         ByVal dblAngle As Double) As Boolean
    Dim gpP As GpStatus
    Dim lngStringPath As Long
    Dim rclayout As RECTL
On Error GoTo errFun
    gpP = GdipCreateFontFamilyFromName(strFontName, 0, lngFontFamily)       '创建字体类型
    gpP = GdipCreateStringFormat(0, 0, lngStringFormat)                     '创建字符串格式
    gpP = GdipSetStringFormatAlign(lngStringFormat, StringAlignMode)        '设置字符串格式
    gpP = GdipCreateSolidFill(lngBrushColor, lngSolidBrush)                  '创建一个实心刷子
    gpP = GdipCreatePen1(lngLineColor, sngLineWidth, DrawLineUnit, lngPen1)

    With rclayout
        .Left = lngLeft
        .Top = lngTop
        .Width = lngWidth
        .Height = lngHeight
    End With
    gpP = GdipCreatePath(BrushMode, lngStringPath)
    gpP = GdipAddPathStringI(lngStringPath, strText, -1, lngFontFamily, _
                             lngFontStyle, sngFontSize, rclayout, lngStringFormat)
    gpP = GdipFillPath(lngGraphics, lngSolidBrush, lngStringPath)
    gpP = GdipDrawPath(lngGraphics, lngPen1, lngStringPath)
    If IsNull(gpP) Then
        DrawSpecialText = False
    Else
        DrawSpecialText = True
    End If

    gpP = GdipDeleteFontFamily(lngFontFamily)
    gpP = GdipDeleteStringFormat(lngStringFormat)
    gpP = GdipDeletePath(lngStringPath)
    gpP = GdipDeleteBrush(lngSolidBrush)
    gpP = GdipDeletePen(lngPen1)
    lngSolidBrush = 0
    lngFontFamily = 0
    lngPen1 = 0



    Exit Function
errFun:
    DrawSpecialText = False
End Function
'************************************************************************************************************************
'函数功能：
'参数说明：X：矩形左上角的X坐标
'        ：Y：矩形左上角的Y坐标

'        ：W：矩形的宽
'        ：H：矩形的高
'        ：lngLineColor：线段颜色，带透明的RGB颜色
'        ：sngLineWidth：线粗
'        ：PenUnit：绘图基本单元
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Public Function DrawRectangleI(ByVal X As Long, ByVal Y As Long, _
                                      ByVal W As Long, ByVal H As Long, _
                                      ByVal lngLineColor As Long, ByVal sngLineWidth As Long, _
                                      ByVal PenUnit As GpUnit) As Boolean
    Dim gpP As GpStatus
On Error GoTo errFun
    GdipCreatePen1 lngLineColor, sngLineWidth, PenUnit, lngPen1
    gpP = GdipDrawRectangleI(lngGraphics, lngPen1, X, Y, W, H)
    gpP = GdipDeletePen(lngPen1)
    lngPen1 = 0
    If IsNull(gpP) Then
        DrawRectangleI = False
    Else
        DrawRectangleI = True
    End If
    Exit Function
errFun:
    DrawRectangleI = False
End Function
'************************************************************************************************************************
'函数功能：绘制一条实直线段
'参数说明：X1：直线段起点的X坐标
'        ：Y1：直线段起点的Y坐标
'        ：X2：直线段终点的X坐标
'        ：Y2：直线段终点的Y坐标
'        ：lngLineColor：线段颜色，带透明的RGB颜色
'        ：sngLineWidth：线粗
'        ：intPenUnit：绘图基本单元
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Public Function DrawLineI(ByVal X1 As Long, ByVal Y1 As Long, _
                                ByVal X2 As Long, ByVal Y2 As Long, _
                                ByVal lngLineColor As Long, ByVal sngLineWidth As Long, _
                                ByVal intPenUnit As GpUnit) As Boolean

    Dim gpP As GpStatus
On Error GoTo errFun
    GdipCreatePen1 lngLineColor, sngLineWidth, intPenUnit, lngPen1
    gpP = GdipDrawLineI(lngGraphics, lngPen1, X1, Y1, X2, Y2)
    gpP = GdipDeletePen(lngPen1)
    lngPen1 = 0
    If IsNull(gpP) Then
        DrawLineI = False
    Else
        DrawLineI = True
    End If
    Exit Function
errFun:
    DrawLineI = False
End Function
'************************************************************************************************************************
'函数功能：设置绘图设备场景的抗锯齿属性
'参数说明：stmP：SmoothingMode类型，抗锯齿属性值
'返回说明：成功：True   失败：False
'************************************************************************************************************************
Public Function SetSmoothingMode(ByVal stmP As SmoothingMode) As Boolean
    Dim gpP As GpStatus
On Error GoTo errFun
    If lngGraphics = 0 Then Exit Function
    gpP = GdipSetSmoothingMode(lngGraphics, stmP)
    If IsNull(gpP) Then
        SetSmoothingMode = False
    Else
        SetSmoothingMode = True
    End If
    Exit Function
errFun:
    SetSmoothingMode = False
End Function

[其他解释]

引用:

先把原来的清除掉再绘制不就OK了？

明白你的意思，但是一言难尽。我回头自己试一下吧，感谢回复。

另外，我又开了一个帖子也是关于GDI+的，希望你能过去指导下。谢谢

热点排行

VB

GDI+绘制文字的有关问题