vb.net鼠标滚轮图片 vba鼠标滚动事件

vb.net 鼠标滚轮放大PictureBox,怎么使picturebox的Graphics画布一起放大?

,图片框显示了以下类型的图片:

创新互联是专业的太平网站建设公司,太平接单;提供做网站、网站建设,网页设计,网站设计,建网站,PHP网站建设等专业做网站服务;采用PHP框架,可快速的进行太平网站开发网页制作和功能扩展;专业做搜索引擎喜爱的网站,专业的做网站团队,希望更多企业前来合作!

位图(*。BMP,DIB)

GIF图像(*。GIF)

JPEG图像(*。JPG)

图元文件(WMF *。EMF)

图标(*。ICO,*。姜黄素)

二,PictureBox的输出为BMP图像。

如果你想保存为其他类型的图像,你必须完成相关的API函数。

请教:用vb编程如何实现用鼠标滚轮扩大和缩小窗体上的图片?

添加一个模块,输入以下代码:

Public 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

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Public Const GWL_WNDPROC = -4

Public Const WM_MOUSEWHEEL = H20A

Public Type POINTAPI

x As Long

y As Long

End Type

Public OldWindowProc As Long

Public ohwnd As Long

Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

On Error Resume Next

If Msg = WM_MOUSEWHEEL Then

Dim CurPoint As POINTAPI, hwndUnderCursor As Long

GetCursorPos CurPoint

hwndUnderCursor = WindowFromPoint(CurPoint.x, CurPoint.y)

If hwndUnderCursor = ohwnd Then

If wParam = -7864320 Then

If Form1.Picture1.Width Form1.ScaleWidth Then Form1.Picture1.Width = Form1.Picture1.Width + 300

If Form1.Picture1.Height Form1.ScaleHeight Then Form1.Picture1.Height = Form1.Picture1.Height + 240

ElseIf wParam = 7864320 Then

If Form1.Picture1.Width 600 Then Form1.Picture1.Width = Form1.Picture1.Width - 300

If Form1.Picture1.Height 480 Then Form1.Picture1.Height = Form1.Picture1.Height - 240

End If

End If

Else

NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)

End If

End Function

在Form1中放入一个Picture1控件,然后输入以下代码:

Private Sub Form_Load()

Picture1.AutoRedraw = True

Picture1.Picture = LoadPicture("e:\tmp\cd1.gif") '图片文件名,自己改

Picture1.Move 0, 0, 6000, 4800

ohwnd = Picture1.hwnd

OldWindowProc = GetWindowLong(Picture1.hwnd, GWL_WNDPROC)

Call SetWindowLong(Picture1.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)

End Sub

Private Sub Picture1_Resize()

Picture1.PaintPicture Picture1.Picture, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight

End Sub

vb.net 鼠标滚轮问题

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

如:picturebox1.focus()

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

vb.net当鼠标移入pictureBox时,单独显示一个放大的图片?

缩放操作

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.net鼠标滚轮图片 vba鼠标滚动事件
分享URL:http://scyanting.com/article/ddcossi.html