XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
ScreenShots erstellen
REM FRAGE:      Wie mache ich ein Screenshot?
REM AUTOR:      cnesm
REM HOMEPAGE:   www.cnesm.de.vu
REM HINWEISS:   Testen und Nutzen der Quelltexte auf eigene Gefahr
REM HINWINGUNG: Freie Nutzung der Quelltexte [freiwillige Erwähnung des Autors]
REM ANMERKUNG:
REM Alle Screenshots werden in die Zwischenablage kopiert
REM Kopiert den gesamten Bildschirm in die Zwischenablage
SendString(%hwnd,{PRTSC})
REM Kopiert den gesamten Bildschirm in die Zwischenablage [Sebastian König]
Def GetDC(1) !USER32,GetDC
Def CreateCompatibleDC(1) !GDI32,CreateCompatibleDC
Def CreateCompatibleBitmap(3) !GDI32,CreateCompatibleBitmap
Def SelectObject(2) !GDI32,SelectObject
Def BitBlt(9) !GDI32,BitBlt
Def GetCurrentObject(2) !GDI32,GetCurrentObject
Def OpenClipboard(1) !USER32,OpenClipboard
Def EmptyClipboard(0) !USER32,EmptyClipboard
Def SetClipboardData(2) !USER32,SetClipboardData
Def CloseClipboard(0) !USER32,CloseClipboard
Def DeleteObject(1) GDI32,DeleteObject
Def DeleteDC(1) !GDI32,DeleteDC
Def ReleaseDC(2) !USER32,ReleaseDC

Proc Screenshot

    Declare Hdc&
    Declare Hmdc&
    Declare Hbitmap&
    Declare maxX%, maxY%
    maxX%=%maxX
    maxY%=%maxY
    Hdc&=GetDC(0)
    Hmdc&=CreateCompatibleDC(hdc&)
    Hbitmap&=CreateCompatibleBitmap(hdc&,maxX%,maxY%)
    SelectObject(hmdc&,hbitmap&)
    BitBlt(hmdc&,0,0,maxX%,maxY%,hdc&,0,0,$0CC0020)
    Hbitmap&=GetCurrentObject(hmdc&,7)
    OpenClipboard(0)
    EmptyClipboard()
    SetClipboardData(2, hbitmap&)
    CloseClipboard()
    DeleteObject(hbitmap&)
    DeleteDC(hmdc&)
    ReleaseDC(0,hdc&)

Endproc

Window 0,0-400,300
Screenshot
Waitkey
REM Kopiert nur den Fensterbereich 0,0-400,300
Window 0,0-400,300
SendString(%Hwnd,{PRTSC})
Waitkey
REM Kopiert bestimmte Fensterelemte im Fenster [Sebastian König]
Def GetWindowDC(1) !USER32,GetWindowDC
Def CreateCompatibleDC(1) !GDI32,CreateCompatibleDC
Def CreateCompatibleBitmap(3) !GDI32,CreateCompatibleBitmap
Def SelectObject(2) !GDI32,SelectObject
Def BitBlt(9) !GDI32,BitBlt
Def OpenClipboard(1) !USER32,OpenClipboard
Def EmptyClipboard(0) !USER32,EmptyClipboard
Def SetClipboardData(2) !USER32,SetClipboardData
Def CloseClipboard(0) !USER32,CloseClipboard
Def DeleteObject(1) GDI32,DeleteObject
Def DeleteDC(1) !GDI32,DeleteDC
Def ReleaseDC(2) !USER32,ReleaseDC
Def GetWindowRect(2) !USER32,GetWindowRect
Declare RECT#
Declare test&

Proc ObjScreenshot

    Parameters target&
    Dim RECT#,16
    Declare Hdc&
    Declare Hmdc&
    Declare Hbitmap&
    Declare SizeX%
    Declare SizeY%
    GetWindowRect(target&,RECT#)
    sizeX%=@sub(@long(RECT#,8),@long(RECT#,0))
    sizeY%=@sub(@long(RECT#,12),@long(RECT#,4))
    Hdc&=GetWindowDC(target&)
    Hmdc&=CreateCompatibleDC(hdc&)
    Hbitmap&=CreateCompatibleBitmap(Hdc&,SizeX%,SizeY%)
    SelectObject(Hmdc&,Hbitmap&)
    BitBlt(Hmdc&,0,0,SizeX%,SizeY%,Hdc&,0,0,$0CC0020)
    OpenClipboard(0)
    EmptyClipboard()
    SetClipboardData(2, hbitmap&)
    CloseClipboard()
    DeleteObject(hbitmap&)
    DeleteDC(hmdc&)
    ReleaseDC(0,hdc&)
    Dispose RECT#

Endproc

Window 0,0-400,300
Test&=CreateButton(%hwnd,Test,100,100,100,50)
Waitkey

windowstyle 2048
cls
//Screenshot speichern
startPaint 0
saveBmp "screenshot.bmp",0,0 - %maxx,%maxy
endPain

windowstyle 2048
cls
//Screenshot speichern
startPaint 0
saveBmpToClip 0,0 - %maxx,%maxy
endPaint