Capture d'écran

 

Kroc - 22/10/2008 : Suite à une question sur fclt (voir [1]), voilà une tentative entièrement en Tcl basée sur Twapi.

Attention !

Cette version requiert pixane 0.8 (disponible depuis eTcl version 1.0). Si vous n'utilisez pas pixane, vous aurez besoin d'une version spéciale de Img disponible ici : http://www.posoft.de/html/extTkImg.html

    package require Tk
    # package require Img
    package require pixane
    package require twapi
    package require base64

    # Provoque la capture d'écran :
    proc ScreenShot {} {
        # Dès que la capture sera faite, on convertira en image :
        set ::MID [twapi::start_clipboard_monitor {after 1500 ; Clipboard2Img}]
        # Puis on simule l'appuie sur la touche "Imprim. écran" :
        twapi::send_keys {{PRTSC}}
        return
    }

    # Conversion du presse-papier en image, basée sur http://wiki.tcl.tk/15647 :
    proc Clipboard2Img {} {
        twapi::open_clipboard

        # Assume clipboard content is in format 8 (CF_DIB)
        set retVal [catch {twapi::read_clipboard 8} clipData]
        if { $retVal != 0 } {
            # Invalid or no content in clipboard
            return
        }
        # First parse the bitmap data to collect header information
        binary scan $clipData "iiissiiiiii" size width height planes bitcount compression\
                sizeimage xpelspermeter ypelspermeter clrused clrimportant
        # We only handle BITMAPINFOHEADER right now (size must be 40)
        if {$size != 40} {
            set err "Unsupported bitmap format. Header size=$size"
        }
        # We need to figure out the offset to the actual bitmap data
        # from the start of the file header. For this we need to know the
        # size of the color table which directly follows the BITMAPINFOHEADER
        if {$bitcount == 0} {
            set err  "Unsupported format: implicit JPEG or PNG"
        } elseif {$bitcount == 1} {
            set color_table_size 2
        } elseif {$bitcount == 4} {
            # TBD - Not sure if this is the size or the max size
            set color_table_size 16
        } elseif {$bitcount == 8} {
            # TBD - Not sure if this is the size or the max size
            set color_table_size 256
        } elseif {$bitcount == 16 || $bitcount == 32} {
            if {$compression == 0} {
                # BI_RGB
                set color_table_size $clrused
            } elseif {$compression == 3} {
                # BI_BITFIELDS
                set color_table_size 3
            } else {
                set err "Unsupported compression type '$compression' for bitcount value $bitcount"
            }
        } elseif {$bitcount == 24} {
            set color_table_size $clrused
        } else {
            set err "Unsupported value '$bitcount' in bitmap bitcount field"
        }
        set phImg [image create photo]
        set filehdr_size 14                 ; # sizeof(BITMAPFILEHEADER)
        set bitmap_file_offset [expr {$filehdr_size+$size+($color_table_size*4)}]
        set filehdr [binary format "a2 i x2 x2 i" \
		  "BM" [expr {$filehdr_size + [string length $clipData]}] $bitmap_file_offset]
        append filehdr $clipData
        if {![info exists err] && ![catch {$phImg put $filehdr -format bmp} err]} {
            puts "Screenshot enregistré : $phImg"
        } else {
            puts "Echec : $err"
        }
        twapi::stop_clipboard_monitor $::MID
        twapi::close_clipboard
        return
    }