[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/download/tkimg/Img1.3.zip

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.
----
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.6 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?

----

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

----

[[
[Category Windows] |
[Category Graphics] |
[Category GUI]
]]