[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?


<<categories>> Graphics | GUI