VB实现桌面放大镜

Option Explicit

Private Type POINTAPI

x As Long

y As Long

End Type

Const Srccopy = &HCC0020

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function GetDC Lib "user32" (ByVal hWnd 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

Private Sub Form_Load()

Dim usew&, useh&

usew& = Me.Width / Screen.TwipsPerPixelX

useh& = Me.Height / Screen.TwipsPerPixelY

End Sub

Private Sub start()

Dim sx As Integer

Dim sy As Integer

GetCursorPos pos

sx = IIf(pos.x < 50 Or pos.x > 925, IIf(pos.x < 50, 0, 925), 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

End Sub

Private Sub Timer1_Timer()

start

End Sub

Private Sub Form_DblClick()

Unload Me

End Sub