VB6使用TEXTOUT或者DRAWTEXT在屏幕上指定位置写文本输出如何擦除

Question

VB6使用TEXTOUT或者DRAWTEXT在屏幕上指定位置写文本输出如何擦除？我在用VB6 API TEXTOUT或者DRAWTEXT在屏幕上指定位置写文本后如何把这些文本清除显示其背景？另外，我写一个10个字符的文本后再写一个 8 个字符的文本，原来10个字符的文本后2位并没有被擦掉，该如何擦掉让其显示后面的背景？请给出具体的代码，谢谢.

Answer 1

我是用GETDC(0)在屏幕上直接输出文字的。

Answer 2

看来要创建一个和桌面兼容的DC先把桌面存入其中，当需要恢复时把它BitBlt过去。

Answer 3

http://topic.csdn.net/u/20101018/13/09E4FAF7-983D-478B-9336-4D5E833E1803.html
我查了好多地方，都是只有类似的提示，但是如何实现呢？能够告知具体代码或者链接

Answer 4

以下是我的代码Private Declare Function SetBkColor Lib "gdi32 " (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32 " (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32 " (ByVal hObject As Long) As Long
Private Type RECT
        Left   As Long
        Top   As Long
        Right   As Long
        Bottom   As Long
End Type'Long，指定窗口的设备场景句柄，出错则为0
Private Declare Function GetDC Lib "user32.dll " ( _
          ByVal hwnd As Long) As Long
          
Private Declare Function ReleaseDC Lib "user32.dll " ( _
          ByVal hwnd As Long, _
          ByVal hdc As Long) As Long
          
'Private Declare Function DrawText Lib "user32.dll " Alias "DrawTextA " ( _
'          ByVal hdc As Long, _
'          ByVal lpstr As String, _
'          ByVal nCount As Long, _
'          lpRect As RECT, _
'          ByVal wFormat As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpstr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Declare Function SetTextColor Lib "gdi32 " (ByVal hdc As Long, ByVal crColor As Long) As Long
        Dim holdpen     As Long
        Dim holdbkcolor     As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As LongPrivate Sub Command1_Click()
        Dim lngDC     As Long
        Dim rt     As RECT
        Dim strText     As String
      strText = "Hello   ! "
      strText = Me.txtText1.Text
        Dim holdpen     As Long
        '屏幕左上角
        With rt
                .Left = 0
                .Top = 0
                .Right = 600
                .Bottom = 600
        End With
        
        lngDC = GetDC(0)
        hbkcolor = SetBkColor(lngDC, RGB(0, 255, 0))               '背景颜色的值
        holdbkcolor = SelectObject(lngDC, hbkcolor)
        hcolor = SetTextColor(lngDC, RGB(255, 0, 0))             '字体颜色值
        holdpen = SelectObject(lngDC, hcolor)
        DrawText lngDC, strText, Len(strText), rt, 0
        Debug.Print rt.Right
        '不成功，没效果，字仍然都在
        ReleaseDC 0, lngDC
        'Sleep 2000
        '不成功，没效果，字仍然都在
        RedrawWindow lngDC, rt, 0, 0
        '不成功，没效果，字仍然都在
        DeleteObject holdpen           '恢复初始状态
    DeleteObject holdbkcolor
End SubPrivate Sub Command2_Click()
Unload Me
End SubPrivate Sub cmdCommand1_Click()
Command1_Click
End SubPrivate Sub Form_Unload(Cancel As Integer)
'不成功，没效果
DeleteObject holdpen           '恢复初始状态
DeleteObject holdbkcolor
End Sub
 

Answer 5

Option Explicit
Private Declare Function SetBkColor Lib "gdi32 " (ByVal hDc As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32 " (ByVal hDc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32 " (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
'Long，指定窗口的设备场景句柄，出错则为0
Private Declare Function GetDC Lib "user32.dll " (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll " (ByVal hwnd As Long, ByVal hDc As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDc As Long, ByVal lpstr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetTextColor Lib "gdi32 " (ByVal hDc As Long, ByVal crColor As Long) As LongPrivate Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End TypeDim holdpen As Long
Dim holdbkcolor As Long
Dim lngDC As Long
Dim rt As RECT
Dim strText As String
Dim hbkcolor As Long
Dim hcolor As Long
'Dim holdpen As Long
Dim hMemdc As Long
Dim hBitmap As Long
Private Sub Command1_Click()
    Dim lngP As Long
    strText = "Hello ! "
    strText = Text1.Text
    
    lngDC = GetDC(0)
    lngP = BitBlt(hMemdc, 0, 0, rt.Right / 15, rt.Bottom / 15, lngDC, 0, 0, vbSrcCopy)
    hbkcolor = SetBkColor(lngDC, RGB(0, 255, 0)) '背景颜色的值
    holdbkcolor = SelectObject(lngDC, hbkcolor)
    hcolor = SetTextColor(lngDC, RGB(255, 0, 0)) '字体颜色值
    lngP = SelectObject(lngDC, hcolor)
    DrawText lngDC, strText, Len(strText), rt, 0
'    Debug.Print rt.Right
'    '不成功，没效果，字仍然都在
'    ReleaseDC 0, lngDC
'    'Sleep 2000
'    '不成功，没效果，字仍然都在
'    RedrawWindow lngDC, rt, 0, 0
'    '不成功，没效果，字仍然都在
'    DeleteObject holdpen '恢复初始状态
'    DeleteObject holdbkcolor
End SubPrivate Sub Command2_Click()
    Dim lngP As Long
    '不成功，没效果
    DeleteObject holdpen '恢复初始状态
    DeleteObject holdbkcolor
    lngP = BitBlt(lngDC, 0, 0, rt.Right / 15, rt.Bottom / 15, hMemdc, 0, 0, vbSrcCopy)
    
End SubPrivate Sub Command3_Click()
    Command1_Click
End SubPrivate Sub Form_Load()
    Dim lngP As Long
    '屏幕左上角
    With rt
        .Left = 0
        .Top = 0
        .Right = 600
        .Bottom = 600
    End With
    hMemdc = CreateCompatibleDC(hDc)
    hBitmap = CreateCompatibleBitmap(hDc, rt.Right / 15, rt.Bottom / 15)
    lngP = SelectObject(hMemdc, hBitmap)
End Sub