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"
updatePasting 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 $canvpotrzebie - 2011-11-15 07:46:28
The test code works directly with latest ActiveTCL, so I guess they included your extended BMP parser.