Ciao a tutti sotto xp ho utilizzato il seguente codice per catturare uno screenshot dal controllo wmp, non capisco perchè sotto il 7 non funziona, non ottengo niente se no una schermata nera, provando a fare stamprsist con da tastiera funziona, però a me serve solo quel rettangolo e no tutto il monitor, vi riporto il codice che in fase di compilazione non da errore xò poi una volta eseguito da un risultato diverso in base all'OS![]()
![]()
MODULO
codice:Public Type GUID data1 As Long data2 As Integer data3 As Integer data4(7) As Byte End Type Public Type PicBmp Size As Long Type As Long hBmp As Long hpal As Long Reserved As Long End Type Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type ''''''''' 'Windows API Declarations ''''''''' Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Public Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Public Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Public Declare Function OleCreatePictureIndirect Lib "olepro32" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPIC As IPicture) As Long Public Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long Public Function GetScreenshot(WndHandle As Long, SavePath As String, Optional BringFront As Integer = 1) As Long ' ' Function to create screeenshot of specified window and store at specified path ' On Error GoTo ErrorHandler Dim hDCSrc As Long Dim hDCMemory As Long Dim hBmp As Long Dim hBmpPrev As Long Dim WidthSrc As Long Dim HeightSrc As Long Dim Pic As PicBmp Dim IPIC As IPicture Dim IID_IDispatch As GUID Dim rc As RECT Dim pictr As PictureBox 'Bring window on top of all windows if specified If BringFront = 1 Then BringWindowToTop WndHandle 'Get Window Size GetWindowRect WndHandle, rc WidthSrc = rc.Right - rc.Left HeightSrc = rc.Bottom - rc.Top 'Get Window device context hDCSrc = GetWindowDC(WndHandle) 'create a memory device context hDCMemory = CreateCompatibleDC(hDCSrc) 'create a bitmap compatible with window hdc hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc) 'copy newly created bitmap into memory device context hBmpPrev = SelectObject(hDCMemory, hBmp) 'copy window window hdc to memory hdc Call BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, _ hDCSrc, 0, 0, vbSrcCopy) 'Get Bmp from memory Dc hBmp = SelectObject(hDCMemory, hBmpPrev) 'release the created objects and free memory Call DeleteDC(hDCMemory) Call ReleaseDC(WndHandle, hDCSrc) 'fill in OLE IDispatch Interface ID With IID_IDispatch .data1 = &H20400 .data4(0) = &HC0 .data4(7) = &H46 End With 'fill Pic with necessary parts With Pic .Size = Len(Pic) 'Length of structure .Type = vbPicTypeBitmap 'Type of Picture (bitmap) .hBmp = hBmp 'Handle to bitmap .hpal = 0& 'Handle to palette (may be null) End With 'create OLE Picture object Call OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPIC) 'return the new Picture object SavePicture IPIC, SavePath GetScreenshot = 1 Exit Function ErrorHandler: GetScreenshot = 0 End Function

Rispondi quotando
