[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 mya slightly modifirtedr version that remcovmbines `capthureWindow` and `captureWindowSub` into one proc, and removes some other redundant code.
====== package require Img
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
} return $baseImg
}
======
----
[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