Autor
|
Tema: alguien sabe como puedo capturar la pantalla, mas rapido o mejor??? (Leído 16,127 veces)
|
HaDeS, -
WarZone Master
Desconectado
Mensajes: 284
|
Bueno aca esta el codigo mas rapido, no es lo mejor pero ahi va 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
|
|
|
En línea
|
|
|
|
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 -->
|
|
|
En línea
|
|
|
|
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 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 '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
|
|
« Última modificación: 3 Septiembre 2007, 19:44 pm por LeandroA »
|
En línea
|
|
|
|
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
|
|
|
En línea
|
|
|
|
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.
|
|
|
En línea
|
|
|
|
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
|
|
|
En línea
|
|
|
|
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
|
|
|
En línea
|
|
|
|
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.
|
|
|
En línea
|
|
|
|
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.
|
|
|
En línea
|
|
|
|
LeandroA
|
bien aca esta mi ejemplo http://es.geocities.com/leandroascierto/Proyecto_Grupal.zipAl 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
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
Como Puedo Capturar la Ip y Puerto de mi maquina
Programación General
|
kripo32
|
0
|
1,559
|
29 Mayo 2013, 23:40 pm
por kripo32
|
|
|
[Source] Compresor mejor y mas rápido que FreeARC, en C.
Programación C/C++
|
sabeeee
|
0
|
1,371
|
25 Febrero 2015, 23:04 pm
por sabeeee
|
|
|
Lenguaje más rápido o mejor?
Programación General
|
andrecid
|
2
|
2,235
|
19 Julio 2015, 22:23 pm
por ivancea96
|
|
|
Alguien sabe por que me ha salido la pantalla azul?
« 1 2 »
Windows
|
Robocop8
|
11
|
7,032
|
14 Junio 2017, 18:41 pm
por bettu
|
|
|
Como puedo capturar el nombre mientras subo archivos al servidor
Desarrollo Web
|
yoelrodguez
|
1
|
2,521
|
22 Enero 2021, 01:14 am
por yoelrodguez
|
|