Autor
|
Tema: [RESUELTO] Capturar imagen al hacer click (Leído 40,809 veces)
|
illuminat3d
|
Bueno quiero que cuando el raton haga click capture una imagen de su alrededor de 50x50, estoy intentando por ahora que al hacer click por lo menos capture y despues de varios intentos he llegado a la conclusion de que tengo que hacer hooks al raton, me puse a buscar ejemplos mas o menos del hook al raton pero no me sirvieron, la idea es por ahora que al hacer click capture la imagen de la ventana activa y ya luego el otro problema seria mostrando el puntero en la captura de 50x50 Esta sería la función que capturaría la ventana activa : Public Function cWindow() Num = Num + 1 keybd_event 44, 0, 0&, 0& DoEvents If Clipboard.GetFormat(vbCFBitmap) Then SavePicture Clipboard.GetData(vbCFBitmap), sIM & Num & ".bmp" End Function
Y lo que intento hacer es ahora con las siguientes declaraciones, es saber cuando se hizo click y llamar a la otra función : Public Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Public Const WH_MOUSE As Long = 7
Saludos!
|
|
« Última modificación: 11 Enero 2010, 16:12 pm por Sharki »
|
En línea
|
|
|
|
jackl007
Desconectado
Mensajes: 1.403
[UserRPL]
|
mira usa esta api GetKeyState para detectar cuando se hizo click al raton... colocas dentro de un timer con intervalo de 1 If GetAsyncKeyState(1) = -32767 Then 'TakeScreenshot End If
Para tomar la screenshot, usa esto: StretchBlt 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 'HDC hdcDest, // manipulador del contexto de dispositivo de destino 'int nXOriginDest, // coordenada x de la esquina superior izquierda del rectángulo de destino 'int nYOriginDest, // coordenada y de la esquina superior izquierda del rectángulo de destino 'int nWidthDest, // anchura del rectángulo de destino 'int nHeightDest, // altura del rectángulo de destino 'HDC hdcSrc, // manipulador del contexto de dispositivo de origen 'int nXOriginSrc, // coordenada x de la esquina superior izquierda del rectángulo de origen 'int nYOriginSrc, // coordenada y de la esquina superior izquierda del rectángulo de origen 'int nWidthSrc, // anchura del rectángulo de origen 'int nHeightSrc, // altura del rectángulo de origen 'DWORD dwRop // código de operación de rastreo
|
|
« Última modificación: 9 Febrero 2010, 05:02 am por jackl007 »
|
En línea
|
|
|
|
illuminat3d
|
jackl007 ツ muy completa tu respuesta, enseguida lo pruebo! =)
|
|
|
En línea
|
|
|
|
|
illuminat3d
|
Bueno estuve viendo este ejemplo tambien : http://www.freevbcode.com/ShowCode.asp?ID=1449Haber si voy bien : Declaraciones : Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Public Declare Function GetForegroundWindow Lib "user32" () As Long Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal sWndTitle As String, ByVal cLen As Long) As Long Public 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 Public Declare Function GetCursorPos Lib "user32" (lPointCoordinateoint As PointAPI) As Long Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Public Type PointAPI x As Long Y As Long End Type
Cuando detecta el click llamo a la función : Case 1: Call cWindow
La función me estoy liando un poco y no se si va bien, tendria que pasar la imagen del hdC al picturePublic Function cWindow() Num = Num + 1 File = FreeFile lActiveWnd = GetDC(hForegroundWnd) GetCursorPos PointCoordinate StretchBlt frmMain.imGc.hDC, 2, 2, 124, 60, hForegroundWnd, PointCoordinate.x - 30, PointCoordinate.Y - 12.5, 100, 100, &HCC0020 SavePicture frmMain.imGc.Picture, Environ("Temp") & "\imgKB" & Num & ".bmp" End Function
Saludos!
|
|
|
En línea
|
|
|
|
seba123neo
|
Hola, te arme este ejemplo "asi nomas" para ver si es lo que queres, lo que hace es mostrar en el formulario el area 50x50 donde pasa el mouse por la pantalla.lo unico que debes hacer es ponerle la api para detectar el click y que ahi capture, (o podes usar el hook del mouse, lo que vos quieras). Option Explicit Private Type PALETTEENTRY peRed As Byte peGreen As Byte peBlue As Byte peFlags As Byte End Type Private Type LOGPALETTE palVersion As Integer palNumEntries As Integer palPalEntry(255) As PALETTEENTRY End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Private Type PicBmp Size As Long Type As Long hBmp As Long hPal As Long Reserved As Long End Type Private Type POINTAPI X As Long Y As Long End Type Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "GDI32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long Private Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hDC As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long Private Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) As Long Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private 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 Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long Private Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As Long Private Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Declare Function GetDesktopWindow Lib "USER32" () As Long Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long Private Const RASTERCAPS As Long = 38 Private Const RC_PALETTE As Long = &H100 Private Const SIZEPALETTE As Long = 104 Private vMouse As POINTAPI Private Sub Form_Load() Timer1.Enabled = True Timer1.Interval = 50 End Sub Private Function CapturarAreaPantalla(ByVal X As Long, ByVal Y As Long, ByVal pAncho As Long, ByVal pAlto As Long) As Picture Dim hDCMemory As Long Dim hBmp As Long Dim hBmpPrev As Long Dim r As Long Dim hDCSrc As Long Dim hPal As Long Dim hPalPrev As Long Dim RasterCapsScrn As Long Dim HasPaletteScrn As Long Dim PaletteSizeScrn As Long Dim LogPal As LOGPALETTE Dim hWndScreen As Long hWndScreen = GetDesktopWindow() hDCSrc = GetWindowDC(hWndScreen) hDCMemory = CreateCompatibleDC(hDCSrc) hBmp = CreateCompatibleBitmap(hDCSrc, pAncho, pAlto) hBmpPrev = SelectObject(hDCMemory, hBmp) RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) HasPaletteScrn = RasterCapsScrn And RC_PALETTE PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) If HasPaletteScrn And (PaletteSizeScrn = 256) Then LogPal.palVersion = &H300 LogPal.palNumEntries = 256 r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0)) hPal = CreatePalette(LogPal) hPalPrev = SelectPalette(hDCMemory, hPal, 0) r = RealizePalette(hDCMemory) End If r = BitBlt(hDCMemory, 0, 0, pAncho, pAlto, hDCSrc, X, Y, vbSrcCopy) hBmp = SelectObject(hDCMemory, hBmpPrev) If HasPaletteScrn And (PaletteSizeScrn = 256) Then hPal = SelectPalette(hDCMemory, hPalPrev, 0) End If r = DeleteDC(hDCMemory) r = ReleaseDC(hWndScreen, hDCSrc) Set CapturarAreaPantalla = CreateBitmapPicture(hBmp, hPal) End Function Private Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture Dim r As Long Dim Pic As PicBmp Dim IPic As IPicture Dim IID_IDispatch As GUID With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With With Pic .Size = Len(Pic) .Type = vbPicTypeBitmap .hBmp = hBmp .hPal = hPal End With r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic) Set CreateBitmapPicture = IPic End Function Private Sub Timer1_Timer() Call GetCursorPos(vMouse) Me.Picture = CapturarAreaPantalla(vMouse.X, vMouse.Y, 50, 50) End Sub
saludos.
|
|
|
En línea
|
|
|
|
LeandroA
|
hola no se si es lo que yo entiendo vos queres hacer algo asi como un keyloger pero capturando las imagenes al hacer click en algun teclado virtual te pongo un ejemplo haciendo hook al mouse y guarda las capturas en .jpg la carpeta que le indiques dentro de un Modulo Bas Option Explicit '-------------------------------------------- 'Autor: Leandro Ascierto 'Web: www.leandroascierto.com.ar 'Date: 11/01/2010 '-------------------------------------------- Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GDIPlusStartupInput, Optional ByVal outputbuf As Long = 0) As Long Private Declare Function GdipLoadImageFromFile Lib "GdiPlus.dll" (ByVal mFilename As Long, ByRef mImage As Long) As Long Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, ByRef BITMAP As Long) As Long Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token 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 CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private 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 Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long Private Const ImageCodecJPG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}" Private Const EncoderQuality = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}" Private Const EncoderParameterValueTypeLong = 4 Private Const WH_MOUSE_LL As Long = 14 Private Const WM_LBUTTONUP As Long = &H202 Private Const CAPTUREBLT As Long = &H40000000 Private Const SRCCOPY As Long = &HCC0020 Private Type CWPSTRUCT lParam As Long wParam As Long message As Long hwnd 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 Type GDIPlusStartupInput GdiPlusVersion As Long DebugEventCallback As Long SuppressBackgroundThread As Long SuppressExternalCodecs As Long End Type Private hHook As Long Private m_Width As Long Private m_Height As Long Private m_DestPath As String Private lCounter As Long Private m_JpgQuality As Long Private lHdc As Long Private hBitmap As Long Private DeskDC As Long Public Function StartMouseCapture(DestPath As String, Optional JpgQuality As Long = 50, Optional Size As Long = 64) As Boolean m_DestPath = IIf(Right(DestPath, 1) <> "\", DestPath & "\", DestPath) If Size < 10 Then Size = 10 m_Width = Size m_Height = Size m_JpgQuality = JpgQuality If hHook Then Exit Function If IsGdiPlusInstaled() Then DeskDC = GetDC(GetDesktopWindow) lHdc = CreateCompatibleDC(DeskDC) hBitmap = CreateCompatibleBitmap(DeskDC, m_Width, m_Height) DeleteObject SelectObject(lHdc, hBitmap) hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProcedure, App.hInstance, 0) StartMouseCapture = True End If End Function Public Sub StopMouseCapture() UnhookWindowsHookEx hHook DeleteDC lHdc DeleteDC DeskDC DeleteObject hBitmap hHook = 0 End Sub Private Function SaveImageToJpg(ByVal SrchBitmap As Long, ByVal DestPath As String, Optional ByVal JPG_Quality As Long = 85) As Boolean On Error Resume Next Dim GDIsi As GDIPlusStartupInput, gToken As Long, hBitmap As Long Dim tEncoder As GUID Dim tParams As EncoderParameters If JPG_Quality > 100 Then JPG_Quality = 100 If JPG_Quality < 0 Then JPG_Quality = 0 CLSIDFromString StrPtr(ImageCodecJPG), tEncoder With tParams .Count = 1 .Parameter(0).NumberOfValues = 1 .Parameter(0).type = EncoderParameterValueTypeLong .Parameter(0).Value = VarPtr(JPG_Quality) CLSIDFromString StrPtr(EncoderQuality), .Parameter(0).GUID End With GDIsi.GdiPlusVersion = 1& GdiplusStartup gToken, GDIsi If gToken Then If GdipCreateBitmapFromHBITMAP(SrchBitmap, 0, hBitmap) = 0 Then If GdipSaveImageToFile(hBitmap, StrPtr(DestPath), tEncoder, tParams) = 0 Then SaveImageToJpg = True End If GdipDisposeImage hBitmap End If GdiplusShutdown gToken End If End Function Public Function IsGdiPlusInstaled() As Boolean Dim hLib As Long hLib = LoadLibrary("gdiplus.dll") If hLib Then If GetProcAddress(hLib, "GdiplusStartup") Then IsGdiPlusInstaled = True End If FreeLibrary hLib End If End Function Public Function MouseProcedure(ByVal idHook As Long, ByVal wParam As Long, lParam As CWPSTRUCT) As Long MouseProcedure = CallNextHookEx(hHook, idHook, wParam, ByVal lParam) If wParam = WM_LBUTTONUP Then BitBlt lHdc, 0, 0, m_Width, m_Height, DeskDC, lParam.lParam - (m_Width / 2), lParam.wParam - (m_Height / 2), SRCCOPY Or CAPTUREBLT SaveImageToJpg hBitmap, m_DestPath & lCounter & ".jpg", m_JpgQuality lCounter = lCounter + 1 End If End Function
y en un formulario para probar Private Sub Form_Load() StartMouseCapture "C:\", 20, 50 End Sub Private Sub Form_Unload(Cancel As Integer) StopMouseCapture End Sub
Saludos.
|
|
« Última modificación: 11 Enero 2010, 04:51 am por LeandroA »
|
En línea
|
|
|
|
illuminat3d
|
Impresionante los ejemplos, los veré detenidamente.
Gracias! =)
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
@LeandroA
mis respetos.
Dulces lunas!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
jackl007
Desconectado
Mensajes: 1.403
[UserRPL]
|
@Leandro tu modulo es mas eficiente que el mio.... jajaja muy bueno eh! yo estaba haciendo lo mismo pero de otra manera, mas largo... PD:creo que entonces queda solucionado tu problema sharki no? listo SALUDOS
|
|
|
En línea
|
|
|
|
|
Mensajes similares |
|
Asunto |
Iniciado por |
Respuestas |
Vistas |
Último mensaje |
|
|
[Resuelto] Tecla y click
Programación Visual Basic
|
Azghar
|
3
|
3,367
|
24 Enero 2011, 21:38 pm
por Azghar
|
|
|
Imagen en word al hacer click se agrande
Dudas Generales
|
Pablo Videla
|
2
|
3,281
|
7 Enero 2012, 00:56 am
por Pablo Videla
|
|
|
[Resuelto] mostrar un numero nuevo de telefono al hacer click
« 1 2 »
Desarrollo Web
|
tecasoft
|
13
|
8,252
|
17 Octubre 2015, 23:52 pm
por tecasoft
|
|
|
Capturar la posición del ratón al hacer click en cualquier parte de la pantalla
Programación Visual Basic
|
adla
|
0
|
1,595
|
24 Mayo 2019, 11:11 am
por adla
|
|
|
[Resuelto] Forma correcta de hacer esto? No referencia en funcion en click.
Desarrollo Web
|
@XSStringManolo
|
2
|
3,460
|
23 Febrero 2020, 00:38 am
por @XSStringManolo
|
|