网上搜索下来的图片放大代码,想改进一下,让控制鼠标只在图片上移动,如何实现?
时间:2011-09-15
来源:互联网
下面的代码是的网上搜索下来的,但我修改后,没有"让控制鼠标只在图片上移动"的目标,另外也不知道怎么去控件这个timer1事件终止,鼠标所指的都去放大了,无法控件?高手支个招,解决一下,谢谢!
Option Explicit
Private Type pointapi
x As Long
y As Long
End Type
'这里定义了一个pointapi类型的数据结构,
Const srccopy = &HCC0020
Const swp_nomove = &H2
Const swp_nosize = &H1
Const flags = swp_nomove Or swp_nosize
Const hwnd_topmost = -1
'并声明了相关的api函数信息,setwindowpos用来使窗口"总在最前",
'不能小写,小写了会不认识函数的,找不到接口
'' Private Declare Function setwindowpos Lib "user32" (ByVal hwnd As Long, ByVal hwndinsertafter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wflags As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'' Private Declare Function getcursorpos Lib "user32" (lppoint As pointapi) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
'getcursorpos确定鼠标在屏幕上的位置,
'' Private Declare Function getdc Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
'getdc根据窗口句柄获得设备描述表。
'' Private Declare Function stretchblt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nwidth As Long, ByVal height As Long, ByVal hsrcdc As Long, ByVal xsrc As Long, ByVal ysrc As Long, ByVal nsrcwidth As Long, ByVal nsrcheight As Long, ByVal dwrop As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
'' Dim pos As pointapi
Dim pos As pointapi
Private Sub form_load()
SetWindowPos hWnd, hwnd_topmost, 0, 0, 0, 0, flags
Timer1.Interval = 8
'(ByVal hwnd As Long, ByVal hwndinsertafter As Long,
'ByVal x As Long,
'ByVal y As Long,
'ByVal cx As Long,
'ByVal cy As Long,
'ByVal wflags As Long
End Sub
Private Sub start()
Dim sx As Integer
Dim sy As Integer
GetCursorPos pos
'下面的坐标是控制好坐标值的.'即在840-50象标之间的图像取值.
sx = IIf(pos.x < 50 Or pos.x > 840, IIf(pos.x < 50, 0, 840), pos.x - 50)
sy = IIf(pos.y < 50 Or pos.y > 680, IIf(pos.y < 50, 0, 680), pos.y - 50)
Caption = sx & "," & sy
StretchBlt hdc, 0, 0, 200, 200, GetDC(0), sx, sy, 100, 100, srccopy 'srccopy)方式复制
'stretchblt(目标,x,y,目标宽,目标高,源设备,xsrc,ysrc,源宽,源高,绘制方式)
End Sub
'这里用getdc(0)取得屏幕的设备描述表,将鼠标所指点周围50个像素的面积(即100×100)放大4倍,你可以根据需要调整放大的部分及倍数。
Private Sub timer1_timer()
start
End Sub
Option Explicit
Private Type pointapi
x As Long
y As Long
End Type
'这里定义了一个pointapi类型的数据结构,
Const srccopy = &HCC0020
Const swp_nomove = &H2
Const swp_nosize = &H1
Const flags = swp_nomove Or swp_nosize
Const hwnd_topmost = -1
'并声明了相关的api函数信息,setwindowpos用来使窗口"总在最前",
'不能小写,小写了会不认识函数的,找不到接口
'' Private Declare Function setwindowpos Lib "user32" (ByVal hwnd As Long, ByVal hwndinsertafter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wflags As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'' Private Declare Function getcursorpos Lib "user32" (lppoint As pointapi) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
'getcursorpos确定鼠标在屏幕上的位置,
'' Private Declare Function getdc Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
'getdc根据窗口句柄获得设备描述表。
'' Private Declare Function stretchblt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nwidth As Long, ByVal height As Long, ByVal hsrcdc As Long, ByVal xsrc As Long, ByVal ysrc As Long, ByVal nsrcwidth As Long, ByVal nsrcheight As Long, ByVal dwrop As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
'' Dim pos As pointapi
Dim pos As pointapi
Private Sub form_load()
SetWindowPos hWnd, hwnd_topmost, 0, 0, 0, 0, flags
Timer1.Interval = 8
'(ByVal hwnd As Long, ByVal hwndinsertafter As Long,
'ByVal x As Long,
'ByVal y As Long,
'ByVal cx As Long,
'ByVal cy As Long,
'ByVal wflags As Long
End Sub
Private Sub start()
Dim sx As Integer
Dim sy As Integer
GetCursorPos pos
'下面的坐标是控制好坐标值的.'即在840-50象标之间的图像取值.
sx = IIf(pos.x < 50 Or pos.x > 840, IIf(pos.x < 50, 0, 840), pos.x - 50)
sy = IIf(pos.y < 50 Or pos.y > 680, IIf(pos.y < 50, 0, 680), pos.y - 50)
Caption = sx & "," & sy
StretchBlt hdc, 0, 0, 200, 200, GetDC(0), sx, sy, 100, 100, srccopy 'srccopy)方式复制
'stretchblt(目标,x,y,目标宽,目标高,源设备,xsrc,ysrc,源宽,源高,绘制方式)
End Sub
'这里用getdc(0)取得屏幕的设备描述表,将鼠标所指点周围50个像素的面积(即100×100)放大4倍,你可以根据需要调整放大的部分及倍数。
Private Sub timer1_timer()
start
End Sub
作者: yiyaozjk 发布时间: 2011-09-15
没有人愿意回贴
作者: yiyaozjk 发布时间: 2011-09-19
"让控制鼠标只在图片上移动",是什么意思?
作者: 6742 发布时间: 2011-09-19
相关阅读 更多
热门阅读
-
office 2019专业增强版最新2021版激活秘钥/序列号/激活码推荐 附激活工具
阅读:74
-
如何安装mysql8.0
阅读:31
-
Word快速设置标题样式步骤详解
阅读:28
-
20+道必知必会的Vue面试题(附答案解析)
阅读:37
-
HTML如何制作表单
阅读:22
-
百词斩可以改天数吗?当然可以,4个步骤轻松修改天数!
阅读:31
-
ET文件格式和XLS格式文件之间如何转化?
阅读:24
-
react和vue的区别及优缺点是什么
阅读:121
-
支付宝人脸识别如何关闭?
阅读:21
-
腾讯微云怎么修改照片或视频备份路径?
阅读:28