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

作者: dnawo

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

内容: 在界面上添加一个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 0.047 ms

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

你没有权限发表评论

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

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 0.047 ms

暂无评论

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

木子屋

PJBlog3 v3.2.9.518 Inside.

Processed In 0.047 ms