ForunsBB

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        GetWindowCapture().Save("c:\Teste.bmp")
    End Sub

    Public Function GetWindowCapture() As Image

        SendKeys.SendWait("%{PRTSC}")

        Dim objClipboard As IDataObject = Clipboard.GetDataObject()
        Return objClipboard.GetData(DataFormats.Bitmap)
    End Function

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        GetWindowCapture1().Save("c:\Teste.bmp")
    End Sub
    Public Function GetWindowCapture1() As Image

        SendKeys.SendWait("^{PRTSC}")

        Dim objClipboard As IDataObject = Clipboard.GetDataObject()
        Return objClipboard.GetData(DataFormats.Bitmap)
    End Function

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub
End Class

'Escrito por whitehatg@gmail.com
             
    nomainwin
    WindowWidth = 350
    WindowHeight = 180
    UpperLeftX=int((DisplayWidth-WindowWidth)/2)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)

    button #main.button1,"Full window",[button1Click], UL,  30,  57,  96,  25
    button #main.button2,"Active window",[button2Click], UL, 215,  57,  96,  25

    open "Print screen" for window as #main
    print #main, "font ms_sans_serif 10"
    print #main, "trapclose [quit.main]"


[main.inputLoop]
    wait

[button1Click]

bmpfile$=lower$(bmpfile$)
if right$(bmpfile$,4)<>".bmp" then bmpfile$=bmpfile$+".bmp"

hscreen=GetDC(0)
hmem=CreateCompatibleDC(hscreen)
hbitmap=CreateCompatibleBitmap(hscreen,DisplayWidth,DisplayHeight)
oldobject=SelectObject(hmem,hbitmap)

call BitBlt hmem,0,0,DisplayWidth,DisplayHeight,hscreen,0,0
call ReleaseDC 0,hscreen
call DeleteDC hmem

loadbmp "demo",hbitmap
bmpsave "demo","full_window.bmp"

call DeleteObject hbitmap
wait

[button2Click]

    vKeyAlt = _VK_MENU
    vKeyPrintScreen = _VK_SNAPSHOT
    vKeyControl = _VK_CONTROL
    vKeyV = 86

    Calldll #user32, "keybd_event", _
        vKeyAlt as Long, _
        null as Long, _
        0 as Long, _
        result as void

    Calldll #user32, "keybd_event", _
        vKeyPrintScreen as Long, _
        null as Long, _
        0 as Long, _
        result as void

    Calldll #user32, "keybd_event", _
        vKeyPrintScreen as Long, _
        null as long, _
        2 as Long, _
        result as void

    Calldll #user32, "keybd_event", _
        vKeyAlt as Long, _
        null as long, _
        2 as Long, _
        result as void

    Timer 1000, [active_window]
    Wait

[active_window]

     CallDLL #user32, "OpenClipboard", _
        hMain as Ulong, _
        result as Long

    CallDLL #user32, "GetClipboardData", _
        _CF_BITMAP as Long, _
        hImage as Ulong

    loadbmp "demo1", hImage

    Bmpsave "demo1", "Active_window.bmp"

    wait

[quit.main]
unloadbmp "demo"
unloadbmp "demo1"
    close #main
    end

Sub BitBlt hDCdest,x,y,w,h,hDCsrc,x2,y2
    CallDLL #gdi32, "BitBlt",hDCdest As uLong,_
    x As Long,y As Long,w As Long,h As Long,_
    hDCsrc As uLong,x2 As Long,y2 As Long,_
    _SRCCOPY As Ulong,RESULT As Boolean
    End Sub

Function SelectObject(hDC,hObject)
    CallDLL #gdi32,"SelectObject",hDC As uLong,_
    hObject As uLong,SelectObject As uLong
    'returns previously selected object
    End Function

Sub DeleteObject hObject
    CallDLL #gdi32,"DeleteObject",hObject As uLong,r As Boolean
    End Sub

Function CreateCompatibleBitmap(hDC,w,h )
    CallDLL #gdi32, "CreateCompatibleBitmap", hDC As uLong,_
    w As Long,h As Long, CreateCompatibleBitmap As uLong
    End Function

Function GetDC(hWnd)
    CallDLL #user32, "GetDC",hWnd As uLong,GetDC As uLong
    End Function

Sub ReleaseDC hWnd, hDC
    CallDLL#user32,"ReleaseDC",hWnd As uLong,_
    hDC As uLong,result As Long
    End Sub

Function CreateCompatibleDC(hDC)
    CallDLL #gdi32,"CreateCompatibleDC",_
    hDC As uLong, CreateCompatibleDC As uLong
    End Function

Sub DeleteDC hDC
    CallDLL #gdi32, "DeleteDC",hDC As uLong, r As Boolean
    End Sub