XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Bildschirmfoto (Screenshot) erstellen
Lauffähig ab Profan-Version 5.0
+----------------------------------------------------------+
| screenshot.prf                                           |
| Autor: Sebastian König                                   |
| email: koenig.hil@t-online.de                            |
| Homepage: http://www.sekoenig.mysite.de                  |
| Erstellen eines echten Screenshots mit Profan. Wirkt   |
| wie ein Druck auf die [PRINT]-Taste. Der Screenshot wird |
| als Bitmap in die Zwischenablage kopiert.                |
+----------------------------------------------------------+
--Benötigte API-Funktionen
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

    --Deklarationen
    declare hdc&, hmdc&, hbitmap&
    declare maxX%, maxY%
    let maxX% = %maxX
    let maxY% = %maxY
    let hdc& = GetDC(0)
    let hmdc& = CreateCompatibleDC(hdc&)
    let hbitmap& = CreateCompatibleBitmap(hdc&,maxX%,maxY%)
    SelectObject(hmdc&, hbitmap&)
    BitBlt(hmdc&, 0, 0, maxX%, maxY%, hdc&, 0, 0, $0CC0020)
    let hbitmap& = GetCurrentObject(hmdc&, 7)
    OpenClipboard(0)
    EmptyClipboard()
    SetClipboardData(2, hbitmap&)
    CloseClipboard()
    DeleteObject(hbitmap&)
    DeleteDC(hmdc&)
    ReleaseDC(0,hdc&)

endproc

Screenshot
Messagebox(Fertig,Screenshot,0)
end