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