Wheel Ascii Code VB6

[eeyk]

weet iemand de ASCII code voor De wheel van je muis

dus


if Ascii = "" then

 

[That Guy]

ha ha ha ha ha
een ASCII waarde bestaat alleen voor je toetsenbord... voor je muis moet je de muiscodes hebben...
Hier is mijn mouse.bas (module) waarmee je wat kan veranderen en dan dus kan kijken of iemand zijn middelste muis knopje pookt.

'MOUSE.BAS
'Vergras (argonhian@gmail.com)
'*All* mouse functions.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Happy coding =D

'
Option Explicit
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As MouseState) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_MOVE = &H1
Public Type POINTAPI
    x As Long
    y As Long
End Type
Public Type MouseState
    Position As POINTAPI
    lbutton As Boolean
    mbutton As Boolean
    rbutton As Boolean
End Type
Dim Pos As MouseState
'Get mouse coordinates
Public Function McX()
GetCursorPos Pos
McX = Pos.Position.x
End Function
Public Function McY()
GetCursorPos Pos
McY = Pos.Position.y
End Function
'Set mouse cooridanates
Public Function MsX(xCoor As Integer)
McY
SetCursorPos xCoor, McY
End Function
Public Function MsY(yCoor As Integer)
McX
SetCursorPos McX, yCoor
End Function
Public Function MsC(xCoor As Integer, yCoor As Integer)
SetCursorPos xCoor, yCoor
End Function
'Check if mouse is clicked
Public Function MbL()
GetCursorPos Pos
Pos.lbutton = CBool(GetAsyncKeyState(vbLeftButton))
MbL = Pos.lbutton
End Function
Public Function MbM()
GetCursorPos Pos
Pos.mbutton = CBool(GetAsyncKeyState(vbMiddleButton))
MbM = Pos.mbutton
End Function
Public Function MbR()
GetCursorPos Pos
Pos.rbutton = CBool(GetAsyncKeyState(vbRightButton))
MbR = Pos.rbutton
End Function
'Mouse click events
Public Function McL(DbleClick As Boolean)
GetCursorPos Pos
    If DbleClick = True Then
        mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    Else
        mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    End If
End Function
Public Function McM(DbleClick As Boolean)
GetCursorPos Pos
    If DbleClick = True Then
        mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
    Else
        mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
End If
End Function
Public Function McR(DbleClick As Boolean)
GetCursorPos Pos
    If DbleClick = True Then
        mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
    Else
        mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
        mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
    End If
End Function
'Hide/show mouse cursor
Public Function McV(show As Boolean)
    If show = True Then
        ShowCursor True
    Else
        ShowCursor False
    End If
End Function
'set cursor to top, ect.
Public Function MsE(Where As String)
Dim iWidth As Integer
Dim iHeight As Integer
iWidth = Screen.Width / Screen.TwipsPerPixelX
iHeight = Screen.Height / Screen.TwipsPerPixelY
    Select Case Where
        Case "Top"
            MsY (0)
        Case "Left"
            MsX (0)
        Case "Bottom"
            MsY (iWidth)
        Case "Right"
            MsX (iHeight + iHeight / 2)
        Case "mid"
            MsY (iHeight \ 2)
            MsX (iWidth \ 2)
    End Select
End Function

 

[eeyk]

ja maar bedoeling is het is voor webbrowser

als je ie 7 heb en je druk met de Wheel op een url opent er een nieuwen tab dat probeer ik ook te maken

 

[That Guy]

Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer


If (GetKeyState(vbKeyMButton) And KEY_DOWN) Then
        msgbox "Middle Button Clicked"
end if

(http://www.vbexplorer.com/VBExplorer/userinput.asp) - GOOGLE