VB6.0实现放大镜效果

'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