Private Declare Function PrintWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As Long

Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function IsIconic Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function UpdateWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function PrintWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
 
Private Const WM_SYSCOMMAND As Long = &H112
Private Const SC_RESTORE As Long = &HF120&
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type GDIPlusStartupInput
    GdiPlusVersion           As Long
    DebugEventCallback       As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs   As Long
End Type
 
Private Type GUID
    Data1           As Long
    Data2           As Integer
    Data3           As Integer
    Data4(0 To 7)   As Byte
End Type
 
Private Type EncoderParameter
    GUID            As GUID
    NumberOfValues  As Long
    Type            As Long
    Value           As Long
End Type
 
Private Type EncoderParameters
    Count           As Long
    Parameter(15)   As EncoderParameter
End Type
 
Private Const ImageCodecJPG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Private Const EncoderQuality = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GDIPlusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GdiPlus.dll" (ByVal mHbm As Long, ByVal mhPal As Long, ByRef mBitmap As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal FileName As Long, ByRef clsidEncoder As GUID, ByRef encoderParams As Any) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, Id As GUID) As Long
 
 
Private Sub Form_Load()
    Shell "calc.exe" 'esto es solo un ejemplo
End Sub
 
Private Sub Command1_Click()
    Dim hWnd As Long
    Dim DestPath As String
 
    DestPath = "C:\Captura1.jpg" 'Destino donde se guardara la imagen
    hWnd = FindWindow(vbNullString, "Calculadora") ' handle de la ventana mediante su caption.
 
    If (hWnd <> 0) And (LenB(DestPath) > 0) Then
        If CaptureWindow(hWnd, DestPath) Then ' funcion para capturar y guardar la ventana como una imagen.jpg
            Me.Picture = LoadPicture(DestPath) ' leemos la image para mostrar el resultado.
        End If
    End If
End Sub
 
Private Function CaptureWindow(hWnd As Long, ByVal DestPath As String) As Boolean
 
    Dim tRECT As RECT
    Dim lWidth As Long, lHeight As Long
    Dim DC              As Long
    Dim hDCMemory       As Long
    Dim hBmp            As Long
    Dim OldhBmp         As Long
 
    'Si la ventana esta minimizada la restaura
    If IsIconic(hWnd) Then
        SendMessage hWnd, WM_SYSCOMMAND, SC_RESTORE, ByVal 0&
        DoEvents
    End If
 
    'le peta una refrescada
    UpdateWindow hWnd
 
    'obtiene las medidas
    GetWindowRect hWnd, tRECT
 
    lWidth = tRECT.Right - tRECT.Left
    lHeight = tRECT.Bottom - tRECT.Top
 
    'creamos un bitmap y un hdc
    DC = GetDC(hWnd)
    hDCMemory = CreateCompatibleDC(0)
    hBmp = CreateCompatibleBitmap(DC, lWidth, lHeight)
    SelectObject hDCMemory, hBmp
    ReleaseDC hWnd, hdc
 
    'imprimimos la ventana en el hdc
    PrintWindow hWnd, hDCMemory, 0
 
 
 
    '---------- Rutina para guardar el bmp como un jpg mediante GDI Plus
    Dim gToken As Long
    Dim gdiSI As GDIPlusStartupInput
    Dim hImage As Long
    Dim tEncoder  As GUID
    Dim tParams     As EncoderParameters
    Dim JPG_Quality As Long
 
    JPG_Quality = 80
 
    gdiSI.GdiPlusVersion = &H1
    GdiplusStartup gToken, gdiSI
 
 
    If gToken Then
        If GdipCreateBitmapFromHBITMAP(hBmp, 0&, hImage) = 0 Then
            CLSIDFromString StrPtr(ImageCodecJPG), tEncoder
            With tParams
                .Count = 1
                .Parameter(0).NumberOfValues = 1&
                .Parameter(0).Type = 4&
                .Parameter(0).Value = VarPtr(JPG_Quality)
                CLSIDFromString StrPtr(EncoderQuality), .Parameter(0).GUID
            End With
            If GdipSaveImageToFile(hImage, StrPtr(DestPath), tEncoder, ByVal tParams) = 0 Then
                CaptureWindow = True
            End If
            GdipDisposeImage hImage
        End If
        GdiplusShutdown gToken
    End If
'-----------
 
    'Liberamos los objetos GDI
    DeleteObject SelectObject(hDCMemory, OldhBmp)
    DeleteDC hDCMemory
 
 
End Function