كود كاميرا تصور سطح المكتب بفيجوال بيسك

هذا البرنامج عبارة عن كاميرا تصور سطح المكتب

و يعتمد بشكل رئيسي على API ويندوز

و يحوي طريقة تصغير الصورة ;-)

مشكور يااخوي على هذا الكود
تصدق اول مرة اعرف انه في الفيجوال هذا الخاصية
بس ممكن توضح كيف عملت هذا الكود ؟

مشكور اخوي وفا على الكود الرائع الله يعطيك الف عافية

الجيار المحترف
good

السلام عليكم

في طريقة اخرى لجعل البرنامج اسرع في العرض

اقتباس:

---

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

---

المؤقت سرعته 20

رمضان كريم