Rabu, 30 Juni 2010


[VB] Track Mouse Event Dengan Fungsi APi

  • Rabu, 30 Juni 2010
  • Nurkholish Ardi Firdaus
  • Share

  • Deklarasi:
    1 Form
    1 Module

    'In a form (Form1)
    Private Sub Form_Click()
    'initialize structure
    ET.cbSize = Len(ET)
    ET.hwndTrack = Me.hWnd
    ET.dwFlags = TME_LEAVE
    'start the tracking
    TrackMouseEvent ET
    'show a message to the user
    Me.Print "Move the mouse cursor outside the form" + vbCrLf + "to generate a WM_MOUSELEAVE event"
    End Sub
    Private Sub Form_Load()
    'show a warning message
    MsgBox "WARNING: This sample uses subclassing." + vbCrLf + "To end this program, always use the X button of the form." + vbCrLf + "Do not use VB's Stop button and do not use the 'End' keyword in your VB code." + vbCrLf + vbCrLf + "For more information about subclassing, check out" + vbCrLf + "our subclassing tutorial at http://www.allapi.net/", vbExclamation
    'set the graphics mode to persistent
    Me.AutoRedraw = True
    Me.Print "Click the form to begin"
    'start subclassing this form
    HookForm Me
    End Sub
    Private Sub Form_Unload(Cancel As Integer)
    'stop subclassing this form
    UnHookForm Me
    End Sub

    'In a module
    Public Const TME_CANCEL = &H80000000
    Public Const TME_HOVER = &H1&
    Public Const TME_LEAVE = &H2&
    Public Const TME_NONCLIENT = &H10&
    Public Const TME_QUERY = &H40000000
    Public Const WM_MOUSELEAVE = &H2A3&
    cbSize As Long
    dwFlags As Long
    hwndTrack As Long
    dwHoverTime As Long
    End Type

    Public Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
    Public Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long
    'Subclassing is explained in our subclassing tutorial at http://www.allapi.net/
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Public Const GWL_WNDPROC = (-4)
    Public PrevProc As Long
    Public Sub HookForm(F As Form)
    PrevProc = SetWindowLong(F.hWnd, GWL_WNDPROC, AddressOf WindowProc)
    End Sub
    Public Sub UnHookForm(F As Form)
    SetWindowLong F.hWnd, GWL_WNDPROC, PrevProc
    End Sub
    Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_MOUSELEAVE Then
    'if we receive a WM_MOUSELEAVE message, show it
    Form1.Print "The mouse left the form!"
    End If
    WindowProc = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
    End Function

    Jangan Lupa Komentar Yaa..
    Related Posts Plugin for WordPress, Blogger...

    1 Komentar Untuk “[VB] Track Mouse Event Dengan Fungsi APi”

    Blogger mengatakan...
    Jumat, 04 Agustus 2017 23.06.00 WIB Reply To This Comment

    If you want your ex-girlfriend or ex-boyfriend to come crawling back to you on their knees (even if they're dating somebody else now) you must watch this video
    right away...

    (VIDEO) Want your ex CRAWLING back to you...?

    Posting Komentar

    Berikan komentar positif tentang artikel yang sederhana ini niscaya sobat akan mendapatkan balasannya. Hehehe