13518219792
。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中的一些常用控件（如：文件框、列表框等）中没有提供鼠标滚轮滚动选择的效果。现将自己写的鼠标滚轮特效实现代码分享给大家： 本例子就是一个对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
根据我的经验，应该是PICtureBox没有获取焦点，而win10下不知道什么原因能自动获取焦点，所以凑巧成功了，因此你应该让图形框获取焦点
如：picturebox1.focus（）
不知道是不是解决了你的问题
点击panel时得到panel的焦点，就可以用鼠标滚轮来控制滚动条了！代码如下：
Private Sub Panel1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Panel1.Click
Panel1.Focus()
End Sub
默认情况下的VB6.0代码窗口不支持鼠标滚动，很不方便。最近在一本书上意外发现一个方法可以实现该功能，特此分享。
【步骤】
1、到微软网站下载支持鼠标滚动的dll文件，网址为：
2、运行该下载文件，解压缩后将vb6idemousewheeladdin.dll文件复制到"C:\Windows\system32\"目录下。（若系统安装在其他盘符下，则应修改为对应的路径）
3、在【运行】对话框中输入：regsvr32 vb6idemousewheeladdin.dll后确认执行。
4、启动VB6.0，依次选择【外接程序】-【外接程序管理器】-选中列表框内的“MouseWheel Fix”-在【加载行为】区域中勾选【在启动中加载】和【加载/卸载】-单击【确定】。
