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]
}
demoTV 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 bmpThe 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 countOn 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?