هل تريد معالجة أحداث عجلة الفأرة في مشروعك

اذهب الى الأسفل

default هل تريد معالجة أحداث عجلة الفأرة في مشروعك

مُساهمة من طرف iemad في الثلاثاء أكتوبر 24, 2006 12:12 am

هل تريد معالجة أحداث عجلة الفأرة في مشروعك
أولا كود API

الكود:
API Declarations
'==============inside a MODULE
Option Explicit
'************************************************************
'API
'************************************************************

Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
    ByVal lpPrevWndFunc As Long, _
    ByVal hWnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long

'************************************************************
'Constants
'************************************************************

Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
 

ضع الكود التالي داخل Modul

الكود:
Module
'************************************************************
'Variables
'************************************************************

Private hControl As Long
Private lPrevWndProc As Long

'*************************************************************
'WindowProc
'*************************************************************


Private Function WindowProc(ByVal lWnd As Long, ByVal lMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

    Dim fwKeys As Long
    Dim zDelta As Long
    Dim xPos As Long
    Dim yPos As Long

      If lMsg = WM_MOUSEWHEEL Then
        fwKeys = wParam And 65535
        zDelta = wParam / 65536
        xPos = lParam And 65535
        yPos = lParam / 65536
   
        Form1.MouseWheel fwKeys, zDelta, xPos, yPos
    End If
 
    WindowProc = CallWindowProc(lPrevWndProc, lWnd, lMsg, wParam, lParam)
End Function

'*************************************************************
'Hook
'*************************************************************
Public Sub Hook(ByVal hControl_ As Long)
    hControl = hControl_
lPrevWndProc = SetWindowLong(hControl, GWL_WNDPROC, AddressOf WindowProc)
End Sub

'*************************************************************
'UnHook
'*************************************************************
Public Sub UnHook()
    Call SetWindowLong(hControl, GWL_WNDPROC, lPrevWndProc)
End Sub
 

أما طريقة الأستعمال كالتالي :

الكود:
Usage
'Create a Form with a label
Option Explicit

'===========inside a form
'*************************
'USAGE
'*************************

Private Sub Form_Load()
    Hook Form1.hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHook
End Sub

نداء عجلة الفأرة عند التحرك

Public Sub MouseWheel(ByVal fwKeys As Long, ByVal zDelta As Long, ByVal xPos As Long, _
    ByVal yPos As Long)

    Beep
    Label1.Caption = "Keys=" & fwKeys & " Delta=" & zDelta & " xPos=" & xPos & " yPos=" & yPos
End Sub
 

iemad
مراقب عام
مراقب عام

عدد الرسائل : 20
تاريخ التسجيل : 23/10/2006

معاينة صفحة البيانات الشخصي للعضو

الرجوع الى أعلى الصفحة اذهب الى الأسفل

default مشكور اخي iemad

مُساهمة من طرف bigboss_quraan في الثلاثاء أكتوبر 24, 2006 6:11 pm

مشكور اخي iemad
على تفاعلك في المنتدى
واتمنى لك دوام التقدم و النجاح

_________________




avatar
bigboss_quraan
مشرف عام
مشرف عام

عدد الرسائل : 136
العمر : 27
تاريخ التسجيل : 19/10/2006

معاينة صفحة البيانات الشخصي للعضو http://jad4vb.lightbb.com

الرجوع الى أعلى الصفحة اذهب الى الأسفل

الرجوع الى أعلى الصفحة


 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى