Contoh Penggunaan Fungsi API SetCapture and WindowFromPoint

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINT
    X As Long
    Y As Long
End Type

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetCapture Lib "user32" () As Long
Private Declare Sub ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINT)
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex&) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Boolean
Private Declare Function WindowFromPoint Lib "user32" (ByVal ptY As Long, ByVal ptX As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex&) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle&, ByVal nWidth&, ByVal crColor&) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject&) As Long
Private Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&) As Long
Private Declare Sub InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Any, ByVal bErase As Long)
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance&, ByVal lpCursor&) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Const IDC_UPARROW = 32516&

Public mlngHwndCaptured As Long

Private Sub Form_MouseDown(Button%, Shift%, X As Single, Y As Single)
    If SetCapture(hwnd) Then MousePointer = vbUpArrow
End Sub

Private Sub Form_MouseMove(Button%, Shift%, X As Single, Y As Single)
    Dim pt As POINT
    Static hWndLast As Long

    If GetCapture() Then

        pt.X = CLng(X)
        pt.Y = CLng(Y)
        ClientToScreen Me.hwnd, pt

        mlngHwndCaptured = WindowFromPoint(pt.X, pt.Y)

        If hWndLast <> mlngHwndCaptured Then
            If hWndLast Then InvertTracker hWndLast
            InvertTracker mlngHwndCaptured
            hWndLast = mlngHwndCaptured
        End If
    End If
End Sub

Private Sub Form_MouseUp(Button%, Shift%, X As Single, Y As Single)
    Dim strCaption$

    If mlngHwndCaptured Then

        strCaption = Space(1000)
        Caption = Left(strCaption, GetWindowText(mlngHwndCaptured, strCaption, Len(strCaption)))

        InvalidateRect 0, 0, True

        mlngHwndCaptured = False
        MousePointer = vbNormal
    End If
End Sub

Private Sub InvertTracker(hwndDest As Long)
    Dim hdcDest&, hPen&, hOldPen&, hOldBrush&
    Dim cxBorder&, cxFrame&, cyFrame&, cxScreen&, cyScreen&
    Dim rc As RECT, cr As Long
    Const NULL_BRUSH = 5
    Const R2_NOT = 6
    Const PS_INSIDEFRAME = 6

    cxScreen = GetSystemMetrics(0)
    cyScreen = GetSystemMetrics(1)
    cxBorder = GetSystemMetrics(5)
    cxFrame = GetSystemMetrics(32)
    cyFrame = GetSystemMetrics(33)

    GetWindowRect hwndDest, rc

    hdcDest = GetWindowDC(hwndDest)

    SetROP2 hdcDest, R2_NOT
    cr = RGB(0, 0, 0)
    hPen = CreatePen(PS_INSIDEFRAME, 3 * cxBorder, cr)

    hOldPen = SelectObject(hdcDest, hPen)
    hOldBrush = SelectObject(hdcDest, GetStockObject(NULL_BRUSH))
    Rectangle hdcDest, 0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top
    SelectObject hdcDest, hOldBrush
    SelectObject hdcDest, hOldPen

    ReleaseDC hwndDest, hdcDest
    DeleteObject hPen
End Sub

Private Sub Form_Load()

    Move 0, 0, 250 * Screen.TwipsPerPixelX, 75 * Screen.TwipsPerPixelY
    Caption = "Click & drag the arrow!"

    ScaleMode = vbPixels
    AutoRedraw = True

    DrawIcon hdc, (ScaleWidth / 2), 9, LoadCursor(0, IDC_UPARROW)
End Sub