欢迎光临

木子屋

标题: VB6.0实现放大镜效果

作者: dnawo

日期: 2010-10-13 03:03 PM

分类: Win编程

内容: 在界面上添加一个PictureBox控件(Picture1)和一个Timer控件(Timer1)，然后添加如下代码：
复制内容到剪贴板 程序代码'Win32 Api
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 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
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Const HWND_TOPMOST = -1 '窗口置顶
Private Const HWND_NOTOPMOST = -2 '正常窗口
Private Const SWP_NOSIZE = &H1 '窗口保持原大小
Private Const SWP_NOMOVE = &H2 '窗口保持原位置
Private Type POINTAPI
x As Long
y As Long
End Type
Private Sub Form_Load()
'窗口置顶
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE
'定时器设置
Timer1.Enabled = True
Timer1.Interval = 50
'设置Picture大小,长宽单位:Twip,1 Pixel=15 Twip
Picture1.Width = 1500
Picture1.Height = 1500
Picture1.BackColor = &H0
End Sub
'定时捕捉
Private Sub Timer1_Timer()
Dim result As Long
Dim point As POINTAPI
result = GetCursorPos(point)
If result <> 0 Then
If point.x < 5 or point.x > Screen.Width - 5 or point.y < 5 or point.y > Screen.Height - 5 Then
Picture1.Cls '只在需要时清除,以免PictureBox一直闪动
End If
'放大100倍,坐标单位:Pixel
StretchBlt Picture1.hdc, 0, 0, 100, 100, GetDC(0), point.x - 5, point.y - 5, 10, 10, &HCC0020
End If
End Sub

+ 查看当前日志评论 (0)

登录

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 2.582 ms

返回

标题: VB6.0实现放大镜效果

你没有权限发表评论

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 2.582 ms

返回

暂无评论

返回

────────────

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 2.629 ms

返回