QB64 Phoenix Edition
Is there a way to delete the Alt+PrtScr image from Windows? - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Help Me! (https://staging.qb64phoenix.com/forumdisplay.php?fid=10)
+---- Thread: Is there a way to delete the Alt+PrtScr image from Windows? (/showthread.php?tid=527)



Is there a way to delete the Alt+PrtScr image from Windows? - Pete - 06-06-2022

For instance, with _CLIPBOARD$ you just use: _CLIPBOARD$ = "" but not so with _CLIPBOARDIMAGE. For example, _CLIPBOARDIMAGE = 0 doesn't clear it, it just takes a snap shot of the current window. What I was looking for is a way to use Alt + PrtScr to copy the active window to the clipboard, save it to a file, and then remove it from the Windows clipboard.

Without being able to remove it from the Windows clipboard so I can poll for the next Alt + PrtScr instance, I need the extra

click back on the Qb64 app step, as seen in the example code, below. Caution, it will add a file to your local directory labeled as: screenshot(1).bmp.

To try it out...

1) Run the app.
2) Click the window you want to screen shot to make it active.
3) Press Alt + PrtScr
4) Click in the window of the Qb64 app.
5) Look for the screenshot in your local folder.

Code: (Select All)
REM This utility will make store screen shots in the local directory.
SCREEN _NEWIMAGE(370, 90, 32)
_SCREENMOVE 0, 0

DO
    CLS
    PRINT " Alt+PrtScr on active window then clcik here."

    DO
        _LIMIT 30
        WHILE _MOUSEINPUT: WEND
        IF _MOUSEBUTTON(1) THEN EXIT DO
        IF INKEY$ = CHR$(27) THEN SYSTEM
    LOOP
    CLS: PRINT " Working..."

    img& = _CLIPBOARDIMAGE
    IF img& < -1 THEN
        ' Find the next sequential available screenshot number.
        DO
            num = num + 1
            num$ = LTRIM$(STR$(num))
            IF _FILEEXISTS("screenshot(" + num$ + ").bmp") = 0 THEN EXIT DO
        LOOP
        screenshot$ = "screenshot(" + num$ + ")"

        SaveImage img&, screenshot$

        IF img& < -1 THEN _FREEIMAGE img&

        DO
            i = i + 1
            IF _FILEEXISTS("screenshot(" + num$ + ").bmp") THEN
                PRINT: PRINT " Image saved..."
                _DELAY 1
                EXIT DO
            ELSE
                IF i = 10 THEN
                    PRINT: PRINT "Unable to capture screen image."
                    END
                END IF
            END IF
        LOOP

    END IF
LOOP

SUB SaveImage (image AS LONG, filename AS STRING)
    ' Subroutine code by Rob, AKA Galleon Dragon available in QB64 Phoenix Wiki.
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB

My thanks to Rob for making the screenshot sub available.

Pete


RE: Is there a way to delete the Alt+PrtScr image from Windows? - RhoSigma - 06-06-2022

Did you try _CLIPBOARDIMAGE = -1 ??

Just a thought, but as -1 usually designates an invalid image handle in QB64, it might either work or blow up your clipboard  Big Grin


RE: Is there a way to delete the Alt+PrtScr image from Windows? - Pete - 06-06-2022

I just figured out a windows API work-around...

Code: (Select All)
REM This utility will make store screen shots in the local directory.
DECLARE DYNAMIC LIBRARY "user32"
    FUNCTION FindWindowA& (BYVAL ClassName AS _OFFSET, WindowName$) 'handle by title
    FUNCTION GetKeyState% (BYVAL nVirtKey AS LONG) 'reads Windows key presses independently
    FUNCTION ShowWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG) 'minimize or maximize
END DECLARE

SCREEN _NEWIMAGE(370, 90, 32)
_SCREENMOVE 0, 0

DO
    CLS
    _KEYCLEAR
    PRINT " Alt + PrtScr to screenshot active window."

    DO
        _LIMIT 10
    LOOP UNTIL GetKeyState(44) = 0

    DO
        _LIMIT 10
        IF GetKeyState(18) AND GetKeyState(44) THEN EXIT DO
    LOOP

    CLS: PRINT " Working..."

    img& = _CLIPBOARDIMAGE
    IF img& < -1 THEN
        ' Find the next sequential available screenshot number.
        DO
            num = num + 1
            num$ = LTRIM$(STR$(num))
            IF _FILEEXISTS("screenshot(" + num$ + ").bmp") = 0 THEN EXIT DO
        LOOP
        screenshot$ = "screenshot(" + num$ + ")"

        SaveImage img&, screenshot$

        IF img& < -1 THEN _FREEIMAGE img&

        DO
            i = i + 1
            IF _FILEEXISTS("screenshot(" + num$ + ").bmp") THEN
                PRINT: PRINT " Image saved..."
                _DELAY 1
                EXIT DO
            ELSE
                IF i = 10 THEN
                    PRINT: PRINT "Unable to capture screen image."
                    BEEP
                    END
                END IF
            END IF
        LOOP

    END IF
LOOP

SUB SaveImage (image AS LONG, filename AS STRING)
    ' Subroutine code by Rob, AKA Galleon Dragon available in QB64 Phoenix Wiki.
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes ungsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB

Rho, I think I did try -1 to no avail, but in case I only tried zero, I'll re-code it and let you know...

Pete