Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, ByVal lpRect As Any, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    Dim Pt As POINTAPI, mWnd As Long, WR As RECT, nDC As Long
    Dim TextSize As POINTAPI, CX As Long, CY As Long
    'Get the current cursor position
    GetCursorPos Pt
    'Get the window under the cursor
    mWnd = WindowFromPoint(Pt.X, Pt.Y)
    'Get the window's position
    GetWindowRect mWnd, WR
    'Get the window'zs device context
    nDC = GetWindowDC(mWnd)
    'Get the height and width of our text
    GetTextExtentPoint32 nDC, "Hello !", Len("Hello !"), TextSize
    For CX = 1 To WR.Right - WR.Left Step TextSize.X
        For CY = 1 To WR.Bottom - WR.Top Step TextSize.Y
            'Draw the text on the window
            ExtTextOut nDC, CX, CY, 0, ByVal 0&, "Hello !", Len("Hello !"), ByVal 0&
        Next
    Next
End Sub
Private Sub Form_Paint()
    Me.CurrentX = 0
    Me.CurrentY = 0
    Me.Print "Click on this form," + vbCrLf + "Hold the mouse button," + vbCrLf + "drag the mouse over another window," + vbCrLf + "release the mouse button" + vbCrLf + "and see what happens!"
End Sub

解决方案 »

  1.   

        函数功能:该函数计算指定的正文字符串的宽度和高度。    函数原型:BOOL GetTextExtentPoint(HDC hdc, LPCTSTR lpString, LPSIZE lpSize);    参数:    hdc:设备环境句柄。    lpString:指向正文字符串的指针,此字符串不必是以\0结束的,因为cbString指定了字符串的长度。    cbString:指定字符串里的字符个数    lpSize:指向SIZE结构的指针,字符串的范围返回在其中。    返回值:如果函数调用成功,返回值是非零值,如果函数调用失败,返回值是0。    Windows NT:若想获得更多错误信息,请调用GetLastError函数。    备注:GetTextExtentPoint用当前选择字体来计算字符串的范围、逻辑单位的高和宽,是不考虑任何裁剪的情况下计算的。    由于有的设备紧缩字符,一个字符串里字符的范围宽度之和或许并不等于字符串的范围宽度。    计算的字符串宽度考虑了由SetTextCharacterExtra设置的字符间隔。    Windows CE:GetTextExtentPoint与GetTextExtentPoint32相同。