Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function StretchBlt Lib "gdi32.dll" (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 Const SRCCOPY As Long = &HCC0020
Private Sub ShowZoom(lpPoint As POINTAPI)
Dim hDC As Long
Dim hwnd As Long
Dim nTmp As Long
Dim x As Long
Dim Y As Long
Dim nWidth As Long
Dim nHeight As Long
Dim xSrc As Long
Dim ySrc As Long
Dim nSrcWidth As Long
Dim nSrcHeight As Long
Const nZoomLevel As Long = 1 ' 1 = 100%, 2 = 200%, 3 = 300% and so on...
hwnd = GetDesktopWindow()
hDC = GetDC(hwnd)
With Picture1
.Cls
x = 0
Y = 0
nWidth = .ScaleWidth
nHeight = .ScaleHeight
End With
xSrc = (nWidth / 2) / nZoomLevel
xSrc = lpPoint.x - xSrc
ySrc = (nHeight / 2) / nZoomLevel
ySrc = lpPoint.Y - ySrc
nSrcWidth = nWidth / nZoomLevel
nSrcHeight = nHeight / nZoomLevel
nTmp = nSrcWidth * nZoomLevel
If (nTmp > nWidth) Then
nWidth = nTmp
ElseIf (nTmp < nWidth) Then
nSrcWidth = nSrcWidth + 1
nWidth = nTmp + nZoomLevel
End If
nTmp = nSrcHeight * nZoomLevel
If (nTmp > nHeight) Then
nHeight = nTmp
ElseIf (nTmp < nHeight) Then
nSrcHeight = nSrcHeight + 1
nHeight = nTmp + nZoomLevel
End If
Call StretchBlt(Picture1.hDC, _
x, _
Y, _
nWidth, _
nHeight, _
hDC, _
xSrc, _
ySrc, _
nSrcWidth, _
nSrcHeight, _
SRCCOPY)
Call ReleaseDC(hwnd, hDC)
End Sub
Private Sub Timer1_Timer()
Static lpPoint As POINTAPI
If (GetCursorPos(lpPoint)) Then
Call ShowZoom(lpPoint) ' Show zoom from cursor position
End If
End Sub
عضو جديد
ضوابط المشاركة
