alguien sabe como puedo capturar la pantalla, mas rapido o mejor???

[HaDeS, -]

Bueno aca esta el codigo mas rapido, no es lo mejor pero ahi va

Código (vb) [Seleccionar] Expandir


Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim ImagenJpg As cJpeg
Dim Calidad%, Milimetros!, Antes&, Despues&

Private Sub Command1_Click()
keybd_event vbKeySnapshot, 0, 0, 0
End Sub

Private Sub Command2_Click()
Form1.WindowState = 2
DoEvents
Image1.Picture = Clipboard.GetData
Picture1.PaintPicture Image1.Picture, 0, 0, 800, 600
ImagenJpg.Quality = Calidad
ImagenJpg.SetSamplingFrequencies 1, 1, 1, 1, 1, 1
Antes = GetTickCount
If ImagenJpg.SampleHDC(Picture1.hDC, Picture1.ScaleWidth, Picture1.ScaleHeight) = 0 Then
DeNuevo:
    If Dir$("c:\prueba.jpg") <> "" Then
        Kill "c:\prueba.jpg"
        GoTo DeNuevo
    Else
        ImagenJpg.SaveFile ("c:\prueba.jpg")
    End If
End If
Despues = GetTickCount
MsgBox "Tiempo total: " & Despues - Antes & " milisegundos"
End Sub

Private Sub Form_Load()
Set ImagenJpg = New cJpeg
Calidad = 50
If Calidad < 1 Then Calidad = 1
If Calidad > 100 Then Calidad = 100
Form1.ScaleMode = 3
Picture1.ScaleMode = vbPixels
Picture1.Width = 800
Picture1.Height = 600
End Sub

En este es necesario, 1 picture, 1 image, y dos commandbutton.

Pruebas y tiempos:

Modulo CJpeg:
Sin Compilar: 2.218 milisegundos
Compilado: 0.5 milisegundos

Modulo CJpegI:
Sin Compilar: 1.906 milisegundos
Compilado: 0.375 milisegundos

Se puede notar la diferencia, ya que pasamos de una resolucion de 1200 x 800 pixeles, a una de 800 x 600.

Saludos

[Slaz]

En mi portatil viene incluida la tecla "Prt Sc" (print screen), la pulsas y luego te vas al paint o cualquier editor de imagenes y le das a pegar. Luego guardar como... y eliges formato en un plis plas <-- N00b Comment, but works --> 

[LeandroA]

Si lo que se quiere hacer es algo asi como un escritorio remoto, es decir enviar toma tras toma, la mejor y diria unica forma es tal como dice cobein, mandar primero la imagen entera y despues mandar las modificaciones que ayan, fijencen en como trabajan los Escritorios remotos profecionales , envian la primera toma(claro en distintas calidades y despues la van mejorando) , y luego parten la pantala en varios trosos iguales, y si alguno de esos trosos cambia los envia, entonces asi se acelera mucho mas la cosa. (si quieren podemos intentar hacer uno yo me engancho). claro esta no es nada facil.

Este es el ejemplo utilizando GDI Plus de capturar y guardar la imagen en formato .png

En un formulario con un picture1 y un Command1

Código [Seleccionar] Expandir


Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
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 GetTickCount Lib "kernel32" () As Long

Private Sub Command1_Click()
Dim Antes As Long
Antes = GetTickCount

Picture1.ScaleMode = vbPixels
Picture1.AutoRedraw = True
Picture1.Move 0, 0, Screen.Width, Screen.Height
StretchBlt Picture1.hdc, 0, 0, Screen.Width, Screen.Height, GetDC(0), 0, 0, Screen.Width, Screen.Height, vbSrcCopy
If GdipInitialized Then SavePictureAsPNG Picture1.image, "C:\Pruevas.png"

MsgBox "Tiempo: " & GetTickCount - Antes
End Sub

Private Sub Form_Load()
   
    GdipInitialized = False
   
    ' GDI+ initialisieren
    If Execute(StartUpGDIPlus(GdiPlusVersion)) = OK Then
        GdipInitialized = True
    Else
        MsgBox "GDI+ not inizialized.", vbOKOnly, "GDI Error"
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
   
    ' ist GDI+ Initialisiert
    If GdipInitialized = True Then
       
        ' GDI+ beenden
        Call Execute(ShutDownGDIPlus)
    End If
End Sub



y en un modulo bas

Código [Seleccionar] Expandir


'Dieser Source stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

Option Explicit

' ----==== GDI+ Konstanten ====----
Public Const GdiPlusVersion As Long = 1
Private Const mimePNG As String = "image/png"

' ----==== Sonstige Typen ====----
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type IID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7)  As Byte
End Type

Private Type PICTDESC
    cbSizeOfStruct As Long
    picType As Long
    hgdiObj As Long
    hPalOrXYExt As Long
End Type

' ----==== GDI+ Typen ====----
Private Type ImageCodecInfo
    Clsid As GUID
    FormatID As GUID
    CodecNamePtr As Long
    DllNamePtr As Long
    FormatDescriptionPtr As Long
    FilenameExtensionPtr As Long
    MimeTypePtr As Long
    flags As Long
    Version As Long
    SigCount As Long
    SigSize As Long
    SigPatternPtr As Long
    SigMaskPtr As Long
End Type

Private Type GdiplusStartupOutput
    NotificationHook As Long
    NotificationUnhook As Long
End Type

Private Type GDIPlusStartupInput
    GdiPlusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

' ----==== GDI+ Enumerationen ====----
' GDI+ Status
Public Enum Status
    OK = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
    ProfileNotFound = 21
End Enum

' ----==== GDI+ API Deklarationen ====----
Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _
    (ByVal FileName As Long, ByRef Bitmap As Long) As Status

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _
    (ByVal hbm As Long, ByVal hPal As Long, _
    ByRef Bitmap As Long) As Status

Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _
    (ByVal Bitmap As Long, ByRef hbmReturn As Long, _
    ByVal background As Long) As Status

Private Declare Function GdipDisposeImage Lib "gdiplus" _
    (ByVal image As Long) As Status

Private Declare Function GdipGetImageEncoders Lib "gdiplus" _
    (ByVal numEncoders As Long, ByVal Size As Long, _
    ByRef Encoders As Any) As Status

Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" _
    (ByRef numEncoders As Long, ByRef Size As Long) As Status

Private Declare Function GdiplusShutdown Lib "gdiplus" _
    (ByVal token As Long) As Status

Private Declare Function GdiplusStartup Lib "gdiplus" _
    (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, _
    Optional ByRef lpOutput As Any) As Status

Private Declare Function GdipSaveImageToFile Lib "gdiplus" _
    (ByVal image As Long, ByVal FileName As Long, _
    ByRef clsidEncoder As GUID, _
    ByRef encoderParams As Any) As Status

' ----==== OLE API Deklarationen ====----
Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" _
    (lpPictDesc As PICTDESC, riid As IID, _
    ByVal fOwn As Boolean, lplpvObj As Object)

' ----==== Kernel API Deklarationen ====----
Private Declare Function lstrcpyW Lib "kernel32" _
    (lpString1 As Any, lpString2 As Any) As Long

Private Declare Function lstrlenW Lib "kernel32" _
    (lpString As Any) As Long

' ----==== Variablen ====----
Dim GdipToken As Long
Public GdipInitialized As Boolean

'------------------------------------------------------
' Funktion     : Execute
' Beschreibung : Gibt im Fehlerfall die entsprechende
'                GDI+ Fehlermeldung aus
' Übergabewert : GDI+ Status
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Public Function Execute(ByVal lReturn As Status) As Status
    Dim lCurErr As Status
    If lReturn = Status.OK Then
        lCurErr = Status.OK
    Else
        lCurErr = lReturn
        MsgBox GdiErrorString(lReturn) & " GDI+ Error:" _
        & lReturn, vbOKOnly, "GDI Error"
    End If
    Execute = lCurErr
End Function

'------------------------------------------------------
' Funktion     : GdiErrorString
' Beschreibung : Umwandlung der GDI+ Statuscodes in Stringcodes
' Übergabewert : GDI+ Status
' Rückgabewert : Fehlercode als String
'------------------------------------------------------
Private Function GdiErrorString(ByVal lError As Status) As String
    Dim s As String
   
    Select Case lError
    Case GenericError:              s = "Generic Error."
    Case InvalidParameter:          s = "Invalid Parameter."
    Case OutOfMemory:               s = "Out Of Memory."
    Case ObjectBusy:                s = "Object Busy."
    Case InsufficientBuffer:        s = "Insufficient Buffer."
    Case NotImplemented:            s = "Not Implemented."
    Case Win32Error:                s = "Win32 Error."
    Case WrongState:                s = "Wrong State."
    Case Aborted:                   s = "Aborted."
    Case FileNotFound:              s = "File Not Found."
    Case ValueOverflow:             s = "Value Overflow."
    Case AccessDenied:              s = "Access Denied."
    Case UnknownImageFormat:        s = "Unknown Image Format."
    Case FontFamilyNotFound:        s = "FontFamily Not Found."
    Case FontStyleNotFound:         s = "FontStyle Not Found."
    Case NotTrueTypeFont:           s = "Not TrueType Font."
    Case UnsupportedGdiplusVersion: s = "Unsupported Gdiplus Version."
    Case GdiplusNotInitialized:     s = "Gdiplus Not Initialized."
    Case PropertyNotFound:          s = "Property Not Found."
    Case PropertyNotSupported:      s = "Property Not Supported."
    Case Else:                      s = "Unknown GDI+ Error."
    End Select
   
    GdiErrorString = s
End Function

'------------------------------------------------------
' Funktion     : GetEncoderClsid
' Beschreibung : Ermittelt die Clsid des Encoders
' Übergabewert : mimeType = mimeType des Encoders
'                pClsid = CLSID des Encoders (in/out)
' Rückgabewert : True = Ermitteln erfolgreich
'                False = Ermitteln fehlgeschlagen
'------------------------------------------------------
Private Function GetEncoderClsid(mimeType As String, _
    pClsid As GUID) As Boolean
   
    Dim Num As Long
    Dim Size As Long
    Dim pImageCodecInfo() As ImageCodecInfo
    Dim j As Long
    Dim buffer As String
   
    Call GdipGetImageEncodersSize(Num, Size)
    If (Size = 0) Then
        ' fehlgeschlagen
        GetEncoderClsid = False
        Exit Function
    End If
   
    ReDim pImageCodecInfo(0 To Size \ Len(pImageCodecInfo(0)) - 1)
   
    Call GdipGetImageEncoders(Num, Size, pImageCodecInfo(0))
   
    For j = 0 To Num - 1
       
        buffer = _
        Space$(lstrlenW(ByVal pImageCodecInfo(j).MimeTypePtr))
       
        Call lstrcpyW(ByVal StrPtr(buffer), _
        ByVal pImageCodecInfo(j).MimeTypePtr)
       
        If (StrComp(buffer, mimeType, vbTextCompare) = 0) Then
            pClsid = pImageCodecInfo(j).Clsid
            Erase pImageCodecInfo
            ' erfolgreich
            GetEncoderClsid = True
            Exit Function
        End If
    Next j
   
    Erase pImageCodecInfo
    ' fehlgeschlagen
    GetEncoderClsid = False
End Function

'------------------------------------------------------
' Funktion     : HandleToPicture
' Beschreibung : Umwandeln eines Bitmap Handle
'                in ein StdPicture Objekt
' Übergabewert : hGDIHandle = Bitmap Handle
'                ObjectType = Bitmaptyp
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Private Function HandleToPicture(ByVal hGDIHandle As Long, _
    ByVal ObjectType As PictureTypeConstants, _
    Optional ByVal hPal As Long = 0) As StdPicture
   
    Dim tPictDesc As PICTDESC
    Dim IID_IPicture As IID
    Dim oPicture As IPicture
   
    ' Initialisiert die PICTDESC Structur
    With tPictDesc
        .cbSizeOfStruct = Len(tPictDesc)
        .picType = ObjectType
        .hgdiObj = hGDIHandle
        .hPalOrXYExt = hPal
    End With
   
    ' Initialisiert das IPicture Interface ID
    With IID_IPicture
        .Data1 = &H7BF80981
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(3) = &HAA
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
   
    ' Erzeugen des Objekts
    OleCreatePictureIndirect tPictDesc, IID_IPicture, _
    True, oPicture
   
    ' Rückgabe des Pictureobjekts
    Set HandleToPicture = oPicture
   
End Function

'------------------------------------------------------
' Funktion     : LoadPicturePlus
' Beschreibung : Lädt ein Bilddatei per GDI+
' Übergabewert : Pfad\Dateiname der Bilddatei
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Public Function LoadPicturePlus( _
    ByVal sFileName As String) As StdPicture
   
    Dim lBitmap As Long
    Dim hBitmap As Long
   
    ' Öffnet die Bilddatei in lBitmap
    If Execute(GdipCreateBitmapFromFile(StrPtr(sFileName), _
    lBitmap)) = OK Then
       
        ' Handle der Bitmap ermitteln lBitmap -> hBitmap
        If Execute(GdipCreateHBITMAPFromBitmap(lBitmap, _
        hBitmap, 0)) = OK Then
           
            ' Erzeugen des StdPicture Objekts von hBitmap
            Set LoadPicturePlus = HandleToPicture(hBitmap, _
            vbPicTypeBitmap)
        End If
       
        ' Lösche lBitmap
        Call Execute(GdipDisposeImage(lBitmap))
       
    End If
End Function

'------------------------------------------------------
' Funktion     : SavePictureAsPNG
' Beschreibung : Speichert ein StdPicture Objekt
'                per GDI+ als PNG
' Übergabewert : Pic = StdPicture Objekt
'                FileName = Pfad\Dateiname.png
' Rückgabewert : True = speichern erfolgreich
'                False = speichern fehlgeschlagen
'------------------------------------------------------
Public Function SavePictureAsPNG(ByVal Pic As StdPicture, _
    ByVal sFileName As String) As Boolean
   
    Dim lBitmap As Long
    Dim tPicEncoder As GUID
   
    ' Erzeugt eine GDI+ Bitmap vom
    ' StdPicture Handle -> lBitmap
    If Execute(GdipCreateBitmapFromHBITMAP( _
    Pic.Handle, 0, lBitmap)) = OK Then
       
        ' Ermitteln der CLSID vom mimeType Encoder
        If GetEncoderClsid(mimePNG, tPicEncoder) = True Then
           
            ' Speichert lBitmap als PNG
            If Execute(GdipSaveImageToFile(lBitmap, _
            StrPtr(sFileName), tPicEncoder, ByVal 0)) = OK Then
               
                ' speichern erfolgreich
                SavePictureAsPNG = True
            Else
                ' speichern nicht erfolgreich
                SavePictureAsPNG = False
            End If
        Else
            ' speichern nicht erfolgreich
            SavePictureAsPNG = False
            MsgBox "Konnte keinen passenden Encoder ermitteln.", _
            vbOKOnly, "Encoder Error"
        End If
       
        ' Lösche lBitmap
        Call Execute(GdipDisposeImage(lBitmap))
       
    End If
End Function

'------------------------------------------------------
' Funktion     : StartUpGDIPlus
' Beschreibung : Initialisiert GDI+ Instanz
' Übergabewert : GDI+ Version
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Public Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status
    ' Initialisieren der GDI+ Instanz
    Dim tGdipStartupInput As GDIPlusStartupInput
    Dim tGdipStartupOutput As GdiplusStartupOutput
   
    tGdipStartupInput.GdiPlusVersion = GdipVersion
    StartUpGDIPlus = GdiplusStartup(GdipToken, _
    tGdipStartupInput, tGdipStartupOutput)
End Function

'------------------------------------------------------
' Funktion     : ShutDownGDIPlus
' Beschreibung : Beendet die GDI+ Instanz
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Public Function ShutDownGDIPlus() As Status
    ' Beendet GDI+ Instanz
    ShutDownGDIPlus = GdiplusShutdown(GdipToken)
    GdipInitialized = False
End Function




la velocidad es practicamente inotable, y el peso de la captura final es aproximadamente de 80.000 bytes un poco mas que la de jpg, pero con mayor calidad (casi sin perdidas) y mas velocidad

Saludos

[cobein]

Bueno les voy a contar una historia, todo esto de comprimir en jpg y mandar la imagen y todo lo hice hace bastante tiempo para un proyecto en el que estaba trabando, los resultados fueron que basicamente me aburri de intentar cosas sin ningun buen resultado y termine usando una linea de comandos.

Usando la clase para guardar el jpg, y mandando una imagen completa de la pantalla, una tras otra y en lan, no pude pasar de 1.5 o 2 seg por cuadro y la maquina servidor estaba a mil con el consumo de procesador.
Teniendo en cuenta que algo optimo serian unos 24 FPS como para ver todo completamente fluido, los resultados que tube fueron una cagada.

Tambien intente lo de mandar solamente los cambios, pero mis conocimientos eran muy basicos y eso me sobrepaso.

Si quieren y si les interesa entre todos podemos hacerlo funcionar.

Aca les dejo unas cosas que me parece habria que solucionar primero antes de poder hacerlo.

1- determinar en cuantos fragmentos hay que dividir la pantalla para obtener el mejor tiempo en la transferencia y la mejor compresion, supongo que fragmentos muy chicos no van a tener buena compresion por la poca cantidad de informacion.

2- encontrar la mejor manera de coprimir la imagen sin tener que guardarla en el disco. (con la clase cJpegI, se puede modificar y obtener los bytes directamente, pero dudo que sea lo mas rapido)

3- encontrar una manera rapida de poder comparar las imagenes para determinar si hay cambios,  algo que me parece se puede hacer es comparar como un "ta-te-ti" o "tic-tac-toe" o como le llamen, en vez de comparar todos los pixeles, eso puede determinar cambios de mas de 1 pixel y aumentria la velocidad de manera considerable, o la otra idea que no se si es mejor es directamente comprimir los fragmentos y comparar los byte arrays que me parece va a funcionar mejor.

Bueno si les interesa podemos hacerlo funcionar.

Saludos

[LeandroA]

Perfecto,yo por mi parte voy a intentar comparar los cuadros, creo que en un principio para no complicar la cosa seria mejor tomar como referencia un monitor de 17 pulgadas que creo si no me equivoco deve ser lo mas estandar. por lo que voy a dividir este monitor en 8 partes  el ancho y en 6 el alto, por lo tanto seria un total de 48 cuadros a comparar, una ves que tenga esto posteo el codigo.

Saludos

PD: para comprimir creo que seria mejor usar un modulo de stos en lo que estuvimos ablando aca, lo de las lineas de comando no creo que sea buena idea por el tema que no sabriamos cuando la imagen fue comprimida ya que visual basic no recive retornos.

[cobein]

Con respecto a lo de la linea de comandos si se puede hacer un pipe al Stdio pero eria complicar mucho la cosa.

Bueno pense en toda esta cosa y algo que me parece habria que hacer para comparar los cuadros es usar Crypto API y algun hash MD5 o lo que sea de esa manera solo tendriamos que guardar como dijiste vos en este caso los 48 hash para compararlos despues con los nuevos y nos ahorrariamos un monton de consumo de memoria o el tema de escribir y leer del disco, aparte Crypto API es muy rapido y al obtener el hash podemos ver hasta 1 pixel de diferencia.

Opiniones ideas?

un saludo

[LeandroA]

No entiendo mucho como decis vos, pero ya casi lo tengo listo, no abria que guarad las imagenes para compararlas y es rapido, pero bueno un poco por falta de experiencia tengo que pintar cada cuadro en un picture para poder obtener los bits, que si obiamente tomara esto desde la pantalla misma seria un paso menos y por lo tanto menos procesador, pero bueno para arrancar va a tirar bien, dentro un rato lo termino

[cobein]

Ok, voy a tratar de hacer lo que dije asi lo ven, la verdad soy muy malo explicando pero ahora veo si lo hago.

[cobein]

Ok aca esta la prueba y aparentemente es bastante rapido mas de lo que pensaba, importante el ejemplo solo esta checkeando 1/4 de la pantalla asi que la velocidad posiblemente disminuya en 1/4 en fullscreen pero la verdad la velocidad es muy buena http://www.filefactory.com/mupc/8f999d/, antes de que digan cualquier cosa esta checkeando el cuarto superion izquierdo, asi que les sugiero poner la ventana de prueva en la derecha de la pantalla y arrastrar cualquier otra ventana en el rincon de prueba, ops no le puse nombre a los botones, El 1 es para arrancar y el 2 para frenar.

Bueno espero opiniones, tengan en cuenta que esto es de prueba y se puede mejorar muchisimo.

[LeandroA]

bien aca esta mi ejemplo

http://es.geocities.com/leandroascierto/Proyecto_Grupal.zip

Al final la pantalla la dividi en 8 de ancho y 8 de alto

En mi computador las modificaciones se producen sobre la hora donde hay un icono en el sistray que va cambiando y otro justo donde esta el check que cambia

la comparacion la hace cada 1 segundo y recorre 64 cuadros (que serian 8 * 8)

Que opinion tienen?

Cobein estuve mirando un poco el ejemplo y masomenos ronda en algo parecido a lo mio, lo uncio que veo es que para comparar la matriz() utilizas md5 para convertira en string, yo aca lo hice mas sencillo, despues lo voy a seguir testeando aver si puedo sacar alguna mejora para lo que hice yo , o bien terminar el tuyo, o si vos ya tenes otra cosa ponela si vamos viendo que seria lo mejor

Saludos