::screenshooterTop

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


Optionsscreenshooter, Top

The result of the modification is screenshooter.tcl that:

  • restores the opacity in Linux at start
  • saves and restores options: -grid, -showgeometry, -topmost, -wait
  • saves and restores the window's geometry and the directory to save
  • sets a pause to wait before the screenshooting
  • gets the focus at start, to enable Ctrl+s in Windows without clicking
  • disables "Create Screenshot" menu item in Windows, as it's buggy
  • makes png by default
  • doesn't exit after canceling the Save dialog
  • if topmost, stays on the screen after saving a screenshot, otherwises exits
  • closes wish on exiting, incl. with Alt+F4 and Escape keys
  • can be used as a widget from Tcl/Tk code

The options are saved to ~/.config/screenshooter.conf.


Usagescreenshooter, Top

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 Windows: press Ctrl+s
  • in Linux: click it with the right button of mouse, then choose "Create Screenshot" from the popup menu

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:

  • in Windows: press Escape or Alt+F4 or choose "Exit" from the popup menu
  • in Linux: choose "Exit" from the popup menu

Widgetscreenshooter, Top

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)

Linksscreenshooter, Top


Licensescreenshooter, Top

MIT.


Commandsscreenshooter, Top




screenshot [::screenshooter]screenshooter, Top

screenshot path ?args?
Parameters
pathNot documented.
argsOptional 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 }


Classesscreenshooter, Top



ScreenShot [::screenshooter]screenshooter, Top

Method summary
constructorConstructor for the class.
destructorDestructor for the class.
cgetNot documented.
configureNot documented.
displayNot documented.
hideNot documented.
unknownNot documented.


constructor [::screenshooter::ScreenShot]ScreenShot, Top

ScreenShot create path ?args?
Parameters
pathNot documented.
argsOptional 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}]" }



destructor [::screenshooter::ScreenShot]ScreenShot, Top

OBJECT destroy

method destructor {} { set w [namespace tail [self]] catch {bind $w <Destroy> {}} catch {destroy $w} }



cget [::screenshooter::ScreenShot]ScreenShot, Top

OBJECT cget ?opt?
Parameters
optNot 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] }



configure [::screenshooter::ScreenShot]ScreenShot, Top

OBJECT configure ?args?
Parameters
argsOptional 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 } } } } }



display [::screenshooter::ScreenShot]ScreenShot, Top

OBJECT display

method display {} { my variable wcanvas set win [winfo toplevel $wcanvas] wm deiconify $win raise $win after idle "focus $wcanvas" }



hide [::screenshooter::ScreenShot]ScreenShot, Top

OBJECT hide

method hide {} { my variable wcanvas set win [winfo toplevel $wcanvas] wm withdraw $win }



unknown [::screenshooter::ScreenShot]ScreenShot, Top

OBJECT unknown method ?args?
Parameters
methodNot documented.
argsOptional 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 }

Document generated by Ruff!