The screenshooter is a Tcl/Tk small utility allowing to make screenshots with a grid window covering a target spot of the screen.
This is a bit modified code made by Johann Oberdorfer:
A Screenshot Widget implemented with TclOO
The result of the modification is screenshooter.tcl that:
wish
on exiting, incl. with Alt+F4 and Escape keysThe options are saved to ~/.config/screenshooter.conf.
Runs with the command:
tclsh screenshooter.tcl
The Img
and treectrl
packages have to be installed to run it. In Debian Linux the packages are titled libtk-img
and tktreectrl
.
There are also executables:
The executables run as simply as:
screenshooter screenshooter.exe
To change the screenshooter's position, just grab it with the mouse, then drag and drop it.
To change the screenshooter's size, grab its bottom or right side, then drag and drop it.
To make a screenshot:
In the popup menu, change options of the screenshooter.
To make several screenshots at once, set "Keep on Top" option on.
To close the screenshooter:
The screenshooter package can be used in Tcl/Tk code to make the screenshooter widget.
The appropriate code may look like this:
package require screenshooter # ... # call the widget if {[info exists ::widshot]} { $::widshot display } else { set ::widshot [screenshooter::screenshot .win.sshooter -background LightYellow -foreground Green] }
where:
::widshot
- variable for the widget's command$::widshot display
- shows the existing screenshooter.win.sshooter
- path to a toplevel window (to be created by screenshooter)MIT.
| Not documented. |
| Optional arguments. |
proc ::screenshooter::screenshot {path args} { wm withdraw [toplevel $path] set path $path.scrshot set obj [ScreenShot create tmp $path {*}$args] rename $obj ::$path return $path }
constructor | Constructor for the class. |
destructor | Destructor for the class. |
cget | Not documented. |
configure | Not documented. |
display | Not documented. |
hide | Not documented. |
unknown | Not documented. |
| Not documented. |
| Optional arguments. |
method constructor {path args} { my variable wcanvas my variable woptions my variable width my variable height my variable measure my variable shade my variable edge my variable drag my variable curdim array set woptions { -foreground black -font {Helvetica 14} -interval {10 50 100} -sizes {4 8 12} -showvalues 1 -outline 1 -grid 1 -measure pixels -zoom 1 -showgeometry 1 -alpha 0.4 -topmost 1 -conffile "~/.config/screenshooter.conf" -geometry "" -savedir "." -wait "0 sec." } array set shade { small gray medium gray large gray } array set measure { what "" valid {pixels points inches mm cm} cm c mm m inches i points p pixels "" } set width 0 set height 0 array set edge { at 0 left 1 right 2 top 3 bottom 4 } array set drag {} array set curdim {x 0 y 0 w 0 h 0} # -------------------------------- ttk::frame $path -class ScreenShot # -------------------------------- # for the screenshot window, depending on the os-specific window manager, # we'd like to have a semi-transparent window, which is on the very top of # all the windows stack and which is borderless (wm overrideredirect ...) # set t [winfo toplevel $path] wm withdraw $t catch { wm attributes $t -topmost 1 wm overrideredirect $t 1 } canvas $path.c -width 600 -height 300 -relief flat -bd 0 -background white -highlightthickness 0 set wcanvas $path.c pack $wcanvas -fill both -expand true bind $wcanvas <Configure> "[namespace code {my Resize}] %W %w %h" bind $wcanvas <ButtonPress-1> "[namespace code {my DragStart}] %W %X %Y" bind $wcanvas <B1-Motion> "[namespace code {my PerformDrag}] %W %X %Y" bind $wcanvas <Motion> "[namespace code {my EdgeCheck}] %W %x %y" my AddMenu $wcanvas # $wcanvas xview moveto 0 ; $wcanvas yview moveto 0 # we must rename the widget command # since it clashes with the object being created set widget ${path}_ rename $path $widget # start with default configuration foreach opt_name [array names woptions] { my configure $opt_name $woptions($opt_name) } # and configure custom arguments my configure {*}$args set showcmd "[namespace code {my RestoreOptions}]; pack $path -expand true -fill both ; wm deiconify $t" if {$::tcl_platform(platform) eq "windows"} { after 50 "$showcmd ; focus $wcanvas" } else { after 50 $showcmd } wm protocol $t WM_DELETE_WINDOW "[namespace code {my SaveOptions}]" }
method destructor {} { set w [namespace tail [self]] catch {bind $w <Destroy> {}} catch {destroy $w} }
| Not documented; optional, default "" |
method cget {{opt {}}} { my variable wcanvas my variable woptions if { [string length $opt] == 0 } { return [array get woptions] } if { [info exists woptions($opt) ] } { return $woptions($opt) } return [$wcanvas cget $opt] }
| Optional arguments. |
method configure {args} { my variable wcanvas my variable woptions my variable measure my variable curdim if {[llength $args] == 0} { # return all canvas options set opt_list [$wcanvas configure] # as well as all custom options foreach xopt [array get woptions] { lappend opt_list $xopt } return $opt_list } elseif {[llength $args] == 1} { # return configuration value for this option set opt $args if { [info exists woptions($opt) ] } { return $woptions($opt) } return [$wcanvas cget $opt] } # error checking if {[expr {[llength $args]%2}] == 1} { return -code error "value for \"[lindex $args end]\" missing" } # overwrite with new value and # process all configuration options... # array set opts $args foreach opt_name [array names opts] { set opt_value $opts($opt_name) # overwrite with new value if { [info exists woptions($opt_name)] } { set woptions($opt_name) $opt_value } # some options need action from the widgets side switch -- $opt_name { -font - -conffile - -savedir - -wait {} -sizes - -showvalues - -outline - -grid - -zoom { my Redraw } -foreground { my ReShade my Redraw } -measure { if {[set idx [lsearch -glob $measure(valid) $opt_value*]] == -1} { return -code error "invalid $option value \"$value\": must be one of [join $measure(valid) {, }]" } set value [lindex $measure(valid) $idx] set measure(what) $measure($value) set woptions(-measure) $value my Redraw } -interval { set dir 1 set newint {} foreach i $woptions(-interval) { if {$dir < 0} { lappend newint [expr {$i/2.0}] } else { lappend newint [expr {$i*2.0}] } } set woptions(-interval) $newint my Redraw } -showgeometry { if {![string is boolean -strict $opt_value]} { return -code error "invalid $option value \"$opt_value\": must be a valid boolean" } $wcanvas delete geoinfo if {$opt_value} { set x 20 set y 20 foreach d {x y w h} { set w $wcanvas._$d catch { destroy $w } entry $w -borderwidth 1 -highlightthickness 1 -width 4 -textvar [namespace current]::curdim($d) -bg Orange $wcanvas create window $x $y -window $w -tags geoinfo bind $w <Return> "[namespace code {my PlaceCmd}]" # avoid toplevel bindings bindtags $w [list $w Entry all] incr x [winfo reqwidth $w] } } } -alpha { wm attributes [winfo toplevel $wcanvas] -alpha $opt_value } -topmost { wm attributes [winfo toplevel $wcanvas] -topmost $opt_value } -geometry { catch { wm geometry [winfo toplevel $wcanvas] $opt_value lassign [split $opt_value x+] - - curdim(x) curdim(y) } } default { # if the configure option wasn't one of our special one's, # pass control over to the original canvas widget # if {[catch {$wcanvas configure $opt_name $opt_value} result]} { return -code error $result } } } } }
method display {} { my variable wcanvas set win [winfo toplevel $wcanvas] wm deiconify $win raise $win after idle "focus $wcanvas" }
method hide {} { my variable wcanvas set win [winfo toplevel $wcanvas] wm withdraw $win }
| Not documented. |
| Optional arguments. |
method unknown {method args} { my variable wcanvas # if the command wasn't one of our special one's, # pass control over to the original canvas widget # if {[catch {$wcanvas $method {*}$args} result]} { return -code error $result } return $result }