[es] - screen capture ?

Charli

Član broj: 28921
Poruke: 25
*.crnagora.net

Profil

^{27.06.2004. u 20:17 - pre 241 meseci}

ok evo sourca za to
Ovo zalijepi u modul:

Code:

Option Explicit

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const SRCCOPY = &HCC0020

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

Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (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.dll" 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.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long

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

A ovo zalijepi u formu
Private Sub Command1_Click()
    Form1.Visible = False
    CaptureScreen 0, 0, 800, 600
    Form1.Visible = True
    Picture1 = Clipboard.GetData()
End Sub

Private Sub Command1_Click()
    Form1.Visible = False
    CaptureScreen 0, 0, 800, 600
    Form1.Visible = True
    Picture1 = Clipboard.GetData()
End Sub

i samo da si se malo potrudio nasao bi ga na net-u. Stay Cool

Charli

Odgovor na temu