VB.NET picturebox 內(nèi)繪圖完圖形放大縮小移動(dòng) 鼠標(biāo)控制 。比較笨看了VB的代碼不明白 求解

。net 不用api就行

南澗ssl適用于網(wǎng)站、小程序/APP、API接口等需要進(jìn)行數(shù)據(jù)傳輸應(yīng)用場(chǎng)景，ssl證書(shū)未來(lái)市場(chǎng)廣闊！成為創(chuàng)新互聯(lián)建站的ssl證書(shū)銷(xiāo)售渠道，可以享受市場(chǎng)價(jià)格4-6折優(yōu)惠！如果有意向歡迎電話聯(lián)系或者加微信：18982081108（備注：SSL證書(shū)合作）期待與您的合作！

縮放操作

Function 縮放(ByVal bitmap As Bitmap, ByVal 倍數(shù) As Single) As Bitmap

Dim w As Integer = bitmap.Width * 倍數(shù)

Dim h As Integer = bitmap.Height * 倍數(shù)

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

鼠標(biāo)滾輪事件 MouseWheel

MouseEventArgs.Delta 值可以判斷滾動(dòng)方向

vb鼠標(biāo)滾輪問(wèn)題

標(biāo)滾輪能給系統(tǒng)的使用帶來(lái)很大便利，如使用滾輪移動(dòng)選擇這項(xiàng)，但在VB中的一些常用控件（如：文件框、列表框等）中沒(méi)有提供鼠標(biāo)滾輪滾動(dòng)選擇的效果?，F(xiàn)將自己寫(xiě)的鼠標(biāo)滾輪特效實(shí)現(xiàn)代碼分享給大家： 本例子就是一個(gè)對(duì)Win32 API的調(diào)用，達(dá)到對(duì)ListBox、PictureBox等的鼠標(biāo)滾輪控制。首先，申明windows API調(diào)用，將其放在模塊modWheel中，以供用戶控件使用。原理很簡(jiǎn)單，通過(guò)鼠標(biāo)滾輪可以對(duì)如下白色的橫線進(jìn)行控制，效果圖如下：相關(guān)代碼如下： 鼠標(biāo)滾輪處理模塊(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，實(shí)現(xiàn)對(duì)相關(guān)控件鼠標(biāo)滾輪事件的處理。用戶控件（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窗體編程中，實(shí)現(xiàn)對(duì)鼠標(biāo)滾輪事件的監(jiān)聽(tīng)和處理，測(cè)試主窗體如下：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 鼠標(biāo)滾輪問(wèn)題

根據(jù)我的經(jīng)驗(yàn)，應(yīng)該是PICtureBox沒(méi)有獲取焦點(diǎn)，而win10下不知道什么原因能自動(dòng)獲取焦點(diǎn)，所以湊巧成功了，因此你應(yīng)該讓圖形框獲取焦點(diǎn)

如：picturebox1.focus（）

不知道是不是解決了你的問(wèn)題

vb.net panel的vscroll的滑輪事件

點(diǎn)擊panel時(shí)得到panel的焦點(diǎn)，就可以用鼠標(biāo)滾輪來(lái)控制滾動(dòng)條了！代碼如下：

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

Panel1.Focus()

End?Sub

求vb鼠標(biāo)滾輪簡(jiǎn)單代碼

默認(rèn)情況下的VB6.0代碼窗口不支持鼠標(biāo)滾動(dòng)，很不方便。最近在一本書(shū)上意外發(fā)現(xiàn)一個(gè)方法可以實(shí)現(xiàn)該功能，特此分享。

【步驟】

1、到微軟網(wǎng)站下載支持鼠標(biāo)滾動(dòng)的dll文件，網(wǎng)址為：

2、運(yùn)行該下載文件，解壓縮后將vb6idemousewheeladdin.dll文件復(fù)制到"C:\Windows\system32\"目錄下。（若系統(tǒng)安裝在其他盤(pán)符下，則應(yīng)修改為對(duì)應(yīng)的路徑）

3、在【運(yùn)行】對(duì)話框中輸入：regsvr32 vb6idemousewheeladdin.dll后確認(rèn)執(zhí)行。

4、啟動(dòng)VB6.0，依次選擇【外接程序】-【外接程序管理器】-選中列表框內(nèi)的“MouseWheel Fix”-在【加載行為】區(qū)域中勾選【在啟動(dòng)中加載】和【加載/卸載】-單擊【確定】。