🚀 go-pugleaf

hij bedoelde toch wel CODE denk ik, en geen utility

voor VB kan ik je onderstaande Sub geven ; zet alles in een module

CaptureScreen 0,0,800,600
zet de huidige scherminhoud in het klembord


--------------------------------------------------------------------

Option Explicit

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const SRCCOPY = &HCC0020 ' (DWORD) destination = source

Private Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Long
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type

'API
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, _
ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As
Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As
Long, _
ByVal hMem As Long) As Long
'if you have problems with this function add the Alias "SetClipboardDataA"
Private Declare Function CloseClipboard Lib "user32" () 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 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 CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal
lpDriverName _
 As String, ByVal lpDeviceName As String, ByVal lpOutput As String,
lpInitData As_
DEVMODE) 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

'Screen Capture Procedure, coordinates are expressed in pixels
Public Sub CaptureScreen(Left As Long, Top As Long, Width As Long, Height As
Long)
    Dim srcDC As Long
    Dim trgDC As Long
    Dim BMPHandle As Long
    Dim dm As DEVMODE

    srcDC = CreateDC("DISPLAY", "", "", dm)
    trgDC = CreateCompatibleDC(srcDC)
    BMPHandle = CreateCompatibleBitmap(srcDC, Width, Height)
    SelectObject trgDC, BMPHandle
    BitBlt trgDC, 0, 0, Width, Height, srcDC, Left, Top, SRCCOPY
    OpenClipboard Screen.ActiveForm.hWnd
    EmptyClipboard
    SetClipboardData 2, BMPHandle
    CloseClipboard
    DeleteDC trgDC
    ReleaseDC BMPHandle, srcDC
End Sub