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

http://www.posoft.de/html/extTkImg.html

Just copy image to clipboard

• requires twapi and Img (at least tkimg files pkgIndex.tcl, tkimg14.dll, tkimgbmp14.dll)
• Image is named Img (image create photo Img)

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 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 edit

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

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References