**Use TWAPI and tkImg BMP to copy/paste image with clipboard**

[Paul Obermeier] 2006/03/24

Test program showing the use of the [Twapi] and [Img] extensions to copy photo images to and from the Windows clipboard.

There was a thread on clt recently (copy image to windows clipboard), discussing the use of Twapi and Img to copy images to and from the Windows clipboard.
Due to a lack in the implementation of the Windows BMP parser (missing 16 and 32 bit variants) in Img, images copied into the clipboard with Alt-PrintScreen could not be saved as a photo image.

I have created a version of Img with an extended BMP parser, which implements reading of 16 and 32 bit images.
You can download it from: http://www.posoft.de/html/extTkImg.html

Please give it a try and supply me with (hopefully positive) feedback, so the new version can make it into the official SourceForge version of Img.

The patched sources of the BMP parser are in the SF repository since 2006/06/06.

<<discussion>> Old questions

Tried on Window 2000 Pro, AS Tcl 8.4.6, TWAPI 0.8. Put image on clipboard via Alt-PrntScrn. The image pastes into MSpaint fine. When I push paste on this test program the process just disappears with no message or error display of any kind. :*(  RT, 26March2006.  To install the patched Img I simply copied the zip files over top of existing
Img install. Was that correct? (I did this because the zip did not contain a full compliment of files)
'''Update by [RT], 30June06''' - finally tried with 8.4.9 (ActiveState) and the new Img is indeed working to load the .bmp file created by the Clipboard2Img proc below. Thanks!

[PO] 2006/03/26
The Zip file should contain everything you need. 
But, I've compiled the Img extension against Tcl 8.4.9. This may be your problem; Stubs are only upwards compatible.

[APN] Both copy and paste worked fine for me on XP SP2 in 16 and 32 bit display modes.
Tcl 8.4.12, [TWAPI] 0.8. Unlike the above user, I removed by original Img directory
and just used the above version instead.

[MG] I used a simplified version of this code on XP SP2 for pasting PNG images for different Excel objects (charts, equations) from the clipboard directly to Tk canvas. Tcl 8.4.11, TWAPI 0.8 and a standard Img1.3. My code follows after the main example.

[DC] Paul, did you ever post a patch file or the source code to this modification?

[MR] Did not work for me on WinXP, Tcl 8.4.9, TWAPI 0.8. Getting this error: couldn't load library "Img1.3/tkimgwindow13.dll": this library or a dependent library could not be found in library path while executing.

[PO] 2006/09/19
The Img package available from my homepage is dependent on msvcrtd.dll. It was intended as a test/debug version.

The patched sources of the BMP parser are in the SF repository since 2006/06/06.
It could therefore be part of an actual AS distribution. 

'''[potrzebie] - 2011-11-15 07:46:28'''
The test code works directly with latest ActiveTCL, so I guess they included your extended BMP parser.

<<discussion>>
----

***Just copy image to clipboard***

(extract from below)
   *   requires [twapi] and [Img] (at least tkimg files pkgIndex.tcl, tkimg14.dll, tkimgbmp14.dll)
   *   Image is named Img (image create photo Img)

======none
package require twapi_clipboard
package require img::bmp
twapi::open_clipboard
twapi::empty_clipboard
# First 14 bytes are bitmapfileheader - get rid of this
twapi::write_clipboard 8 [string range\
        [binary decode base64 [Img data -format bmp]] 14 end]
twapi::close_clipboard
======

----

***Test programm***


You may use the following little test program:


======
package require Tk
package require Img
package require twapi
package require base64

# Copy the contents of the Windows clipboard into a photo image.
# Return the photo image identifier.
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 } {
        error "Invalid or no content in clipboard"
    }

    # 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} {
        error "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} {
        error "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 {
            error "Unsupported compression type '$compression' for bitcount value $bitcount"
        }
    } elseif {$bitcount == 24} {
        set color_table_size $clrused
    } else {
        error "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
    $phImg put $filehdr -format bmp

    twapi::close_clipboard
    return $phImg
}

# Copy photo image "phImg" into Windows clipboard.
proc Img2Clipboard { phImg } {
    # First 14 bytes are bitmapfileheader - get rid of this
    set data [string range [base64::decode [$phImg data -format bmp]] 14 end]
    twapi::open_clipboard
    twapi::empty_clipboard
    twapi::write_clipboard 8 $data
    twapi::close_clipboard
}

# Start of test program.

proc poMisc:Min { a b } {
    if { $a < $b } {
        return $a
    } else {
        return $b
    }
}

proc poWin:CreateScrolledWidget { wType w titleStr args } {
    if { [winfo exists $w.par] } {
        destroy $w.par
    }
    frame $w.par
    if { [string compare $titleStr ""] != 0 } {
        label $w.par.label -text "$titleStr"
    }
    eval { $wType $w.par.widget \
            -xscrollcommand "$w.par.xscroll set" \
            -yscrollcommand "$w.par.yscroll set" } $args
    scrollbar $w.par.xscroll -command "$w.par.widget xview" -orient horizontal
    scrollbar $w.par.yscroll -command "$w.par.widget yview" -orient vertical
    set rowNo 0
    if { [string compare $titleStr ""] != 0 } {
        set rowNo 1
        grid $w.par.label -sticky ew -columnspan 2
    }
    grid $w.par.widget $w.par.yscroll -sticky news
    grid $w.par.xscroll               -sticky ew
    grid rowconfigure    $w.par $rowNo -weight 1
    grid columnconfigure $w.par 0      -weight 1
    pack $w.par -side top -fill both -expand 1
    return $w.par.widget
}

proc poWin:CreateScrolledCanvas { w titleStr args } {
    return [eval {poWin:CreateScrolledWidget canvas $w $titleStr} $args ]
}

# Load photo image "phImg" into canvas "canv".
proc Img2Canvas { phImg canv } {
    $canv itemconfigure myImg -image $phImg
    set iw [image width $phImg]
    set ih [image height $phImg]
    $canv coords myRect \
            [expr $iw/2 -10] [expr $ih/2 -10] \
            [expr $iw/2 +10] [expr $ih/2 +10] 
    set sw [winfo screenwidth .]
    set sh [winfo screenheight .]
    $canv configure -width [poMisc:Min $iw $sw] \
                    -height [poMisc:Min $ih $sh]
    $canv configure -scrollregion "0 0 $iw $ih"
    .fr3.inf configure -text [format "Size: %dx%d" $iw $ih]
}

# Select an image file.
proc OpenImg { canv } {
    global gLastDir gCurImg

    set fileName [tk_getOpenFile -initialdir $gLastDir]
    if { $fileName != "" } {
        if { [info exists gCurImg] } {
            image delete $gCurImg
        }
        set gCurImg [image create photo -file $fileName]
        Img2Canvas $gCurImg $canv
        set gLastDir [file dirname $fileName]
    }
}

# Copy the current image shown in the canvas to the clipboard.
proc Canv2Clipboard {} {
    global gCurImg

    if { ! [info exists gCurImg] } {
        error "No image loaded in canvas"
    }
    Img2Clipboard $gCurImg
}

# Get the clipboard content as a photo image and display it on the canvas.
proc Clipboard2Canv { canv } {
    global gCurImg

    if { [info exists gCurImg] } {
        image delete $gCurImg
    }
    set gCurImg [Clipboard2Img]
    Img2Canvas $gCurImg $canv
}

set gLastDir [pwd]

frame .fr1
frame .fr2
frame .fr3
grid .fr1 -row 0 -column 0 -sticky news
grid .fr2 -row 1 -column 0 -sticky news
grid .fr3 -row 2 -column 0 -sticky news
grid rowconfigure    . 0 -weight 1
grid columnconfigure . 0 -weight 1

set canv [poWin:CreateScrolledCanvas .fr1 "" \
          -width 300 -height 300 -bg magenta]

button .fr2.b1 -text "Open file ..." -command "OpenImg $canv"
button .fr2.b2 -text "Copy"          -command "Canv2Clipboard"
button .fr2.b3 -text "Paste"         -command "Clipboard2Canv $canv"
label  .fr3.inf -text "No image loaded"
pack .fr2.b1 .fr2.b2 .fr2.b3 -side left -fill x -expand 1
pack .fr3.inf -side top -fill x -expand 1

bind . <<Copy>>  "Canv2Clipboard"
bind . <<Paste>> "Clipboard2Canv $canv"

$canv create image 0 0 -anchor nw -tags myImg

wm title . "Clipboard test"
update
======


----


**Pasting a PNG image to a canvas**


======
package require Tk
package require Img
package require twapi

proc Img2Canvas { phImg canv } {
    $canv itemconfigure myImg -image $phImg
    set iw [image width $phImg]
    set ih [image height $phImg]
    $canv configure -width $iw -height $ih
}

proc Clipboard2PngImg {} {

    twapi::open_clipboard
    set retVal [catch {twapi::read_clipboard 49406} clipData]
    if { $retVal != 0 } {
        error "Invalid or no content in clipboard"
    }
    twapi::close_clipboard
    set im [image create photo -format PNG -data $clipData]
    return $im
}

set canv [canvas .canv]

$canv create image 0 0 -anchor nw -tags myImg
wm title . "Clipboard test"

set gCurImg [Clipboard2PngImg]
Img2Canvas $gCurImg $canv

pack $canv
======


<<categories>> Category Graphics|Category Windows|Category GUI