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

解决方案 »

  1.   


    '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
      

  2.   


    '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
      

  3.   


    明白你的意思,但是一言难尽。我回头自己试一下吧,感谢回复。另外,我又开了一个帖子也是关于GDI+的,希望你能过去指导下。谢谢