Version 0 of Capture a window into an image

Updated 2003-06-17 09:56:16

David Easton: 17 Mar 2003 This uses the Img package to capture a screenshot of a widget hierarchy or toplevel window into a photo image. It is an extension of the canvas2photo techniques from the Img page.

Feel free to use, correct, improve, comment etc.

---

 #
 # Capture a window into an image
 # Author: David Easton
 #

 proc captureWindow { win } {

   package require Img

   regexp {([0-9]*)x([0-9]*)\+([0-9]*)\+([0-9]*)} [winfo geometry $win] - w h x y

   # Make the base image based on the window
   set image [image create photo -format window -data $win]

   foreach child [winfo children $win] {
     captureWindowSub $child $image 0 0
   }

   return $image
 }

 proc captureWindowSub { win image px py } {

   if {![winfo ismapped $win]} {
     return
   }

   regexp {([0-9]*)x([0-9]*)\+([0-9]*)\+([0-9]*)} [winfo geometry $win] - w h x y

   incr px $x
   incr py $y

   # Make an image from this widget
   set tempImage [image create photo -format window -data $win]

   # Copy this image into place on the main image
   $image copy $tempImage -to $px $py
   image delete $tempImage

   foreach child [winfo children $win] {
     captureWindowSub $child $image $px $py
   }
 }

---

David Easton: 17 Mar 2003 Here is a demo for above the above that creates a window and saves the screenshot to a file, when the user presses the 'x' key in the window.

 proc windowToFile { win } {

   set image [captureWindow $win]

   set types {{"Image Files" {.gif}}}

   set filename [tk_getSaveFile -filetypes $types \
                                  -initialfile capture.gif \
                                -defaultextension .gif]

   if {[llength $filename]} {
       $image write -format gif $filename
       puts "Written to file: $filename"
   } else {
       puts "Write cancelled"
   }
   image delete $image
 }

 proc demo { } {

    package require Tk
    wm withdraw .
    set top .t
    toplevel $top
    wm title $top "Demo"
    frame $top.f
    pack  $top.f -fill both -expand 1
    label $top.f.hello -text "Press x to capture window"
    pack  $top.f.hello -s top -e 0 -f none -padx 10 -pady 10

    checkbutton $top.f.b1 -text "CheckButton 1"
    checkbutton $top.f.b2 -text "CheckButton 2"
    radiobutton $top.f.r1 -text "RadioButton 1" -variable num -value 1
    radiobutton $top.f.r2 -text "RadioButton 2" -variable num -value 2

    pack $top.f.b1 $top.f.b2 $top.f.r1 $top.f.r2 \
        -side top -expand 0 -fill none 

    update
    bind $top <Key-x> [list windowToFile $top]
 }

 demo