Updated 2013-01-25 18:36:51 by Potrzebie

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.

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.

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

[potrzebie] - 2011-11-15 07:46:28

The test code works directly with latest ActiveTCL, so I guess they included your extended BMP parser.