Updated 2018-06-15 19:07:58 by dkf

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.

The 'captureWindow' function can be passed any widget path, including that of a toplevel window. The image of the window/widget will contain white areas if the display is obscured by any other window (including transient windows).

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

KPV See Capturing Multiple Screens for a way to capture more than one screenful.
 #
 # 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
   }
 }

LH 24 Feb 2018 Quite a useful piece of code, David. Here is my slightly modified version that removes the captureWindowSub proc and some other redundant code.
 proc CaptureWindow {win {baseImg ""} {px 0} {py 0}} {
   # create the base image of win (the root of capturing process)
   if {$baseImg eq ""} {
     set baseImg [image create photo -format window -data $win]
     CaptureWindow $win $baseImg
     return $baseImg
   }
   # paste images of win's children on the base image
   foreach child [winfo children $win] {
     if {![winfo ismapped $child]} continue
     set childImg [image create photo -format window -data $child]
     regexp {\+(\d*)\+(\d*)} [winfo geometry $child] -> x y
     $baseImg copy $childImg -to [incr x $px] [incr y $py]
     image delete $childImg
     CaptureWindow $child $baseImg $x $y
   }
 }

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

TV Well, eehh, this is nice for making tk documentation for instance and probably interesting implementationwise, but isn't it possible to capture any window in some way? I do remember having tried and extension package which does this.

David Easton 17 Mar 2003 After a little research: BLT also provides a mechanism for taking a snapshot of a window using the command 'winop snap <window> <photoName>". Thus, the above gives a way of doing it using Img rather than BLT. BLT will show the contents of an overlapping window, whereas the above method blanks out any overlapping window. An example of taking a snapshot using BLT is:
 proc bltCaptureWindow { win } {

   package require BLT

   # Make an empty photo image
   set image [image create photo]

   # Snapshot of window/widget
   winop snap $win $image

   return $image
 }

David Easton 2 Nov 2006 The following code will capture a whole screen except for the desktop which will appear black. This has been tested on Windows. This requires the BLT package.
 proc captureScreenToImage {} {
     package require BLT
     # Try to make a unique window name
     set win ".tmp[clock seconds]"
     toplevel $win
     # Use frame as BLT crashed interpreter when trying winop on toplevel window  
     pack [frame $win.fr -bg black -border 0] -expand true -fill both
     wm state $win zoomed
     wm overrideredirect $win 1
     lower $win
     update idletasks
    
     set image [image create photo]
     blt::winop snap $win.fr $image
     destroy $win
     return $image
 }

 set image [captureScreenToImage]
 package require Img
 $image write Screenshot.gif -format gif ;# Only if 256 colours or less
 $image write Screenshot.png -format png
 $image write Screenshot.jpg -format jpeg
 $image write Screenshot.bmp -format bmp

The combination of photo image zooming and the Img extension let us code A little magnifying glass in just a few lines.

I added a proc to record window snapshots of an app with an animated image.
proc capture_snapshot { count } {
        set img [image create photo -format window -data .]

        set name [ format "./output/%05d.ppm" $count ]

        $img write $name -format ppm 

        image delete $img
}

This is called from the proc that updates each frame like:
update
if { $make_movie == 1 } {
    capture_snapshot $count
}
incr count

On Linux this works just dandy. I get a bunch of ppm images, that I post process to jpeg, and then to an avi. On Windows, many (10-15) frames are skipped. Can anyone explain why? Can I fix this for Windows?