Título: Capturar pantalla error :s
Publicado por: usuario oculto en 26 Julio 2011, 13:51 pm
Este código capura la imagen al hacer click izquierdo y funciona bien, pero cuando estoy en otra aplicación mientras que está abierta, no lo capura bien, me da error. También lo dejo el proyecto: http://anyhub.net/file/3GZy-proyecto.rar ¿Me pueden me ayuda a solucionarlo? please :p Option Explicit Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer '''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Declare Sub keybd_event _ Lib "user32" ( _ ByVal bVk As Byte, _ ByVal bScan As Byte, _ ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long) Private Sub Form_Load() Timer1.Interval = 50 End Sub Private Sub Capturar_Guardar(Path As String) ' borra el portapapeles Clipboard.Clear ' Manda la pulsación de teclas para capturar la imagen de la pantalla Call keybd_event(44, 2, 0, 0) DoEvents ' Si el formato del clipboard es un bitmap If Clipboard.GetFormat(vbCFBitmap) Then 'Guardamos la imagen en disco SavePicture Clipboard.GetData(vbCFBitmap), Path MsgBox " Captura generada en: " & Path, vbInformation Picture1.Picture = Clipboard.GetData(vbCFBitmap) Else MsgBox " Error ", vbCritical End If End Sub Private Sub Timer1_Timer() If GetAsyncKeyState(1) = -32767 Then Call Capturar_Guardar("c:\windows\pantalla.bmp") End If End Sub
Título: Re: Capturar pantalla error :s
Publicado por: ŞCØRPIØN-X3 en 26 Julio 2011, 20:16 pm
Hola Manzan[a] mira probalo asi y fijate si te sirve Option Explicit Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer '''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Declare Sub keybd_event _ Lib "user32" ( _ ByVal bVk As Byte, _ ByVal bScan As Byte, _ ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long) Private Sub Form_Load() Timer1.Interval = 50 End Sub Private Sub Capturar_Guardar(Path As String) ' borra el portapapeles Clipboard.Clear ' Manda la pulsación de teclas para capturar la imagen de la pantalla Call keybd_event(44, 2, 0, 0) DoEvents ' Si el formato del clipboard es un bitmap If Clipboard.GetFormat(vbCFBitmap) Then 'Guardamos la imagen en disco Picture1.Picture = Clipboard.GetData(vbCFBitmap) SavePicture Picture1.Picture, Path End If End Sub Private Sub Timer1_Timer() If GetAsyncKeyState(1) = -32767 Then Call Capturar_Guardar("c:\pantalla.bmp") End If End Sub
Título: Re: Capturar pantalla error :s
Publicado por: raul338 en 26 Julio 2011, 21:23 pm
Soy yo o el código de @ŞCØRPIØN-X3 y @mansan[a] son iguales :xD
En lugar de usar un timer. Porque no usas un hook al mouse? Así capturas la pantalla cada vez que hace click ?
Título: Re: Capturar pantalla error :s
Publicado por: ŞCØRPIØN-X3 en 27 Julio 2011, 00:11 am
no, no son iguales xD, le saque el "else" de la comprobacion de de formato y que guarde el archivo desde el picture (esto es lo mismo xD) pero bueno yo le brinde una solucion para ese code, porque sino puedo poner otro xD, pero el quiere solucionar el problema de su code :P
me tome el trabajo de hacerte un ejemplo con hook xD espero que te sirva :P En un Form (Form1):Private Sub Form_Load() MouseHook True End Sub Sub MouseHook(ByVal ONOFF As Boolean) Select Case ONOFF Case "1" IdProc = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, App.hInstance, 0) Case "0" If IdProc <> 0 Then Call UnhookWindowsHookEx(IdProc) IdProc = 0 End If End Select End Sub Private Sub Form_Unload(Cancel As Integer) MouseHook False End Sub
En un Modulo:Option Explicit Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Public Const WH_MOUSE_LL = 14 Public IdProc As Long Public Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If GetAsyncKeyState(1) = -32767 Then Call Capturar_Guardar("c:\imagen.bmp") End If End Function Public Sub Capturar_Guardar(Path As String) Clipboard.Clear Call keybd_event(44, 2, 0, 0) DoEvents If Clipboard.GetFormat(vbCFBitmap) Then Form1.Picture1.Picture = Clipboard.GetData(vbCFBitmap) SavePicture Form1.Picture1.Picture, Path End If End Sub
Bueno lo trate de hacer lo mas compacto y sencillo posible, si hay algo mal o tiene una mejor idea me dice xD Suerte! ::)
Título: Re: Capturar pantalla error :s
Publicado por: raul338 en 27 Julio 2011, 02:15 am
@ŞCØRPIØN-X3 Aunque no uses todos los parámetros de LowLevelMouseProc (http://msdn.microsoft.com/en-us/library/ms644986%28v=vs.85%29.aspx) deberías ponerlo en la función. No vaya a ser que en algún momento se corrompa la memoria :xD
Título: Re: Capturar pantalla error :s
Publicado por: ŞCØRPIØN-X3 en 27 Julio 2011, 02:28 am
oks gracias raul338 por la correccion xD ahora lo edito :P ----------------------- Bueno creo que hay quedo bien xD jeje :P
Título: Re: Capturar pantalla error :s
Publicado por: usuario oculto en 27 Julio 2011, 02:55 am
mañana los pruebo, gracias a todos :P
|