重庆分公司,新征程启航

为企业提供网站建设、域名注册、服务器等服务

鼠标滚轮编号vb.net,鼠标滚轮型号

VB.NET picturebox 内绘图完图形放大缩小移动 鼠标控制 。比较笨看了VB的代码不明白 求解

。net 不用api就行

南涧ssl适用于网站、小程序/APP、API接口等需要进行数据传输应用场景,ssl证书未来市场广阔!成为创新互联建站的ssl证书销售渠道,可以享受市场价格4-6折优惠!如果有意向欢迎电话联系或者加微信:18982081108(备注:SSL证书合作)期待与您的合作!

缩放操作

Function 缩放(ByVal bitmap As Bitmap, ByVal 倍数 As Single) As Bitmap

Dim w As Integer = bitmap.Width * 倍数

Dim h As Integer = bitmap.Height * 倍数

Dim tem As New Bitmap(w, h)

Dim g As Graphics = Graphics.FromImage(tem)

g.DrawImage(bitmap, New Rectangle(0, 0, w, h), New Rectangle(0, 0, bitmap.Width, bitmap.Height), GraphicsUnit.Pixel)

g.Dispose()

Return tem

End Function

鼠标滚轮事件 MouseWheel

MouseEventArgs.Delta 值可以判断滚动方向

vb鼠标滚轮问题

标滚轮能给系统的使用带来很大便利,如使用滚轮移动选择这项,但在VB中的一些常用控件(如:文件框、列表框等)中没有提供鼠标滚轮滚动选择的效果。现将自己写的鼠标滚轮特效实现代码分享给大家: 本例子就是一个对Win32 API的调用,达到对ListBox、PictureBox等的鼠标滚轮控制。首先,申明windows API调用,将其放在模块modWheel中,以供用户控件使用。原理很简单,通过鼠标滚轮可以对如下白色的横线进行控制,效果图如下:相关代码如下: 鼠标滚轮处理模块(modWheel)

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

(pDest As Any, pSource As Any, ByVal ByteLen As Long)

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _

(ByVal hWnd As Long, ByVal nIndex As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _

(ByVal hWnd As Long, ByVal nIndex As Long, _

ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)

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

Declare Function SetProp Lib "user32" Alias "SetPropA" _

(ByVal hWnd As Long, ByVal lpString As String, _

ByVal hData As Long) As Long

Declare Function GetProp Lib "user32" Alias "GetPropA" _

(ByVal hWnd As Long, ByVal lpString As String) As Long

Declare Function RemoveProp Lib "user32" Alias "RemovePropA" _

(ByVal hWnd As Long, ByVal lpString As String) As Long

Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long

Public Const WM_MOUSEWHEEL = H20A

Public Const WM_MOUSELAST = H20A

Public Const WHEEL_DELTA = 120

Public Function HIWORD(LongIn As Long) As Integer

HIWORD = (LongIn And HFFFF0000) \ H10000

End Function

Public Function MWheelProc(ByVal hWnd As Long, _

ByVal wMsg As Long, ByVal wParam As Long, _

ByVal lParam As Long) As Long

Dim OldProc As Long

Dim CtlWnd As Long

Dim CtlPtr As Long

Dim IntObj As Object

Dim MWObject As MWheel

CtlWnd = GetProp(hWnd, "WheelWnd")

CtlPtr = GetProp(CtlWnd, "WheelPtr")

OldProc = GetProp(CtlWnd, "OldWheelProc")

If wMsg = WM_MOUSEWHEEL Then

CopyMemory IntObj, CtlPtr, 4

Set MWObject = IntObj

MWObject.WndProc hWnd, wMsg, wParam, lParam

Set MWObject = Nothing

CopyMemory IntObj, 0, 4

Exit Function

End If

MWheelProc = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)

End Function

Public Sub Subclass(MWCtl As MWheel, ParentWnd As Long)

If GetProp(MWCtl.hWnd, "OldWheelProc") 0 Then

Exit Sub

End If

SetProp MWCtl.hWnd, "OldWheelProc", _

GetWindowLong(ParentWnd, GWL_WNDPROC)

SetProp MWCtl.hWnd, "WheelPtr", ObjPtr(MWCtl)

SetProp ParentWnd, "WheelWnd", MWCtl.hWnd

SetWindowLong ParentWnd, GWL_WNDPROC, AddressOf MWheelProc

End Sub

Public Sub UnSubclass(MWCtl As MWheel, ParentWnd As Long)

Dim OldProc As Long

OldProc = GetProp(MWCtl.hWnd, "OldWheelProc")

If OldProc = 0 Then Exit Sub

SetWindowLong ParentWnd, GWL_WNDPROC, OldProc

RemoveProp ParentWnd, "WheelWnd"

RemoveProp MWCtl.hWnd, "WheelPtr"

RemoveProp MWCtl.hWnd, "OldWheelProc"

End Sub

然后,定义用户控件MWheel,实现对相关控件鼠标滚轮事件的处理。用户控件(MWheel)代码

Option Explicit

Dim m_CapWnd As Long

Dim m_Subclassed As Boolean

Event WheelScroll(Shift As Integer, zDelta As Integer, _

X As Single, Y As Single)

Private Sub UserControl_Resize()

Size 32 * Screen.TwipsPerPixelX, 32 * Screen.TwipsPerPixelY

End Sub

Public Sub DisableWheel()

If m_CapWnd = 0 Then Exit Sub

If m_Subclassed = False Then Exit Sub

UnSubclass Me, m_CapWnd

m_Subclassed = False

End Sub

Public Sub EnableWheel()

If m_CapWnd = 0 Then Exit Sub

m_Subclassed = True

Subclass Me, m_CapWnd

End Sub

Friend Property Get hWnd() As Long

hWnd = UserControl.hWnd

End Property

Public Property Get hWndCapture() As Long

hWndCapture = m_CapWnd

End Property

Public Property Let hWndCapture(ByVal vNewValue As Long)

m_CapWnd = vNewValue

End Property

Friend Sub WndProc(ByVal hWnd As Long, _

ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

Dim wShift As Integer

Dim wzDelta As Integer

Dim wX As Single, wY As Single

wzDelta = HIWORD(wParam)

wY = HIWORD(lParam)

RaiseEvent WheelScroll(wShift, wzDelta, wX, wY)

End Sub最后,就可以将定义的用户控件用在vb窗体编程中,实现对鼠标滚轮事件的监听和处理,测试主窗体如下:Option Explicit

Dim KAs As Long

Dim KA1 As Long

Dim KA2 As Long

Private Sub Picture1_Click()

MWheel1.hWndCapture = Picture1.hWnd

MWheel1.EnableWheel

End Sub

Private Sub List1_Click()

MWheel2.hWndCapture = List1.hWnd

MWheel2.EnableWheel

KA1 = List1.ListCount

End Sub

Private Sub File1_Click()

MWheel3.hWndCapture = File1.hWnd

MWheel3.EnableWheel

KA1 = File1.ListCount

End Sub

Private Sub MWheel2_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)

If KAs 0 Then

If zDelta = 120 Then

KAs = KAs - 1

List1.ListIndex = KAs

End If

End If

If KAs KA1 - 1 Then

If zDelta = -120 Then

KAs = KAs + 1

List1.ListIndex = KAs

End If

End If

End Sub

Private Sub MWheel1_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)

If zDelta = 120 Then

KA2 = KA2 - 5

Line1.Y1 = KA2

Line1.Y2 = KA2

End If

If zDelta = -120 Then

KA2 = KA2 + 5

Line1.Y1 = KA2

Line1.Y2 = KA2

End If

End Sub

Private Sub MWheel3_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)

If KAs 0 Then

If zDelta = 120 Then

KAs = KAs - 1

File1.ListIndex = KAs

End If

End If

If KAs KA1 - 1 Then

If zDelta = -120 Then

KAs = KAs + 1

File1.ListIndex = KAs

End If

End If

End Sub/SPAN

vb.net 鼠标滚轮问题

根据我的经验,应该是PICtureBox没有获取焦点,而win10下不知道什么原因能自动获取焦点,所以凑巧成功了,因此你应该让图形框获取焦点

如:picturebox1.focus()

不知道是不是解决了你的问题

vb.net panel的vscroll的滑轮事件

点击panel时得到panel的焦点,就可以用鼠标滚轮来控制滚动条了!代码如下:

Private Sub Panel1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Panel1.Click

Panel1.Focus()

End Sub

求vb鼠标滚轮简单代码

默认情况下的VB6.0代码窗口不支持鼠标滚动,很不方便。最近在一本书上意外发现一个方法可以实现该功能,特此分享。

【步骤】

1、到微软网站下载支持鼠标滚动的dll文件,网址为:

2、运行该下载文件,解压缩后将vb6idemousewheeladdin.dll文件复制到"C:\Windows\system32\"目录下。(若系统安装在其他盘符下,则应修改为对应的路径)

3、在【运行】对话框中输入:regsvr32 vb6idemousewheeladdin.dll后确认执行。

4、启动VB6.0,依次选择【外接程序】-【外接程序管理器】-选中列表框内的“MouseWheel Fix”-在【加载行为】区域中勾选【在启动中加载】和【加载/卸载】-单击【确定】。


文章题目:鼠标滚轮编号vb.net,鼠标滚轮型号
本文路径:http://cqcxhl.cn/article/dscjhse.html

其他资讯

在线咨询
服务热线
服务热线:028-86922220
TOP