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

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل

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
العمر : 26
تاريخ التسجيل : 19/10/2006

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

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

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة


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