Hola
Pon en un Form un PictureBox y un Timer, pega este código en declaraciones y ejecútalo.
Te mostrará con efecto de zoom la zona donde se encuentra el ratón
Option Explicit
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 GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Const SRCCOPY = &HCC0020
Private Const VelocidadRefrescoMilliSegundos = 100
Private Type POINTAPI
X As Long
Y As Long
End Type
Private FactorZoom As Single, UltimaPos As POINTAPI, DimensionAlto As Long, DimensionAncho As Long
Private Sub TakeShot(CenterX As Long, CenterY As Long)
Dim Top As Long, Left As Long, nAlto As Long, nAncho As Long, ScreenDC As Long
nAlto = DimensionAlto * (1 / FactorZoom)
nAncho = DimensionAncho * (1 / FactorZoom)
ScreenDC = GetDC(GetDesktopWindow)
Top = CenterY - (DimensionAlto / (2 * FactorZoom))
Left = CenterX - (DimensionAncho / (2 * FactorZoom))
Call StretchBlt(Picture1.hdc, 0, 0, DimensionAncho, DimensionAlto, ScreenDC, Left, Top, nAncho, nAlto, SRCCOPY)
End Sub
Private Sub Form_Load()
DimensionAlto = 200
DimensionAncho = 300
Picture1.Height = DimensionAlto * Screen.TwipsPerPixelY
Picture1.Width = DimensionAncho * Screen.TwipsPerPixelX
FactorZoom = 2 'Valor inicial de factor de zoom
Timer1.Interval = VelocidadRefrescoMilliSegundos
End Sub
Private Sub Timer1_Timer()
'Solo refresca la imagen si se ha modificado la
'posición del mouse, así consume menos recursos
'y corre más
Dim NuevaPos As POINTAPI, Changed As Boolean
Changed = False
Call GetCursorPos(NuevaPos)
If NuevaPos.X <> UltimaPos.X Then Changed = True
If NuevaPos.Y <> UltimaPos.Y Then Changed = True
If Changed = True Then
UltimaPos = NuevaPos
Call TakeShot(UltimaPos.X, UltimaPos.Y)
End If
End Sub
Saludos.
