[MEd]: Just another simple drawing tool, I use a very similar script as Scratch-Pad plugin for [MetPad]. Basically following actions are supported:
   * Doodle
   * Draw lines, rectangles and ovals
   * Change outline-, fill- and background color
   * Save the drawing as .jpg or .gif
   * Show canvas size and pointer position
''updated 2006/02/23''

----

======
 # Name: ScratchPad.tcl
 # Author: Martin Eder, snofix@users.sourceforge.net
 # Description: A simple scratch pad which provides free-hand drawing and
 #     basic geometric figures (lines, rectangels, circles).
 #     The drawing can be saved as jpg or gif file.
     
 namespace eval spad {
     set currentmode "freehand"
     set thickness 1
     set thicklist "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 22 24 26 28 30"
     set pcolor "black"
     set pbcolor "white"
     set canbg "white"
     set savename ""
 }
 
 proc spad::setcol {cvar widget} {
     set newcolor [tk_chooseColor -initialcolor $cvar -parent .ppad -title "Choose new fill color"]
     if {$newcolor != ""} {
         set $cvar $newcolor
         $widget configure -bg $newcolor
         return $newcolor
     }
 }
 
 proc spad::gui {} {
     if {[winfo exists .ppad]} {destroy .ppad}
     wm withdraw .
     toplevel .ppad -padx 5 -pady 5
     wm protocol .ppad WM_DELETE_WINDOW exit
     wm title .ppad "Scratch Pad"
     frame .ppad.f -relief ridge -borderwidth 4
     canvas .ppad.f.c -bg $spad::canbg -highlightthickness 0 -width 320 -height 240
     frame .ppad.panel
     frame .ppad.dpanel
     frame .ppad.status
     label .ppad.status.pos -relief groove -width 9
     label .ppad.status.size -relief groove -width 9
     label .ppad.status.bar -relief groove -anchor w -width 10
     label .ppad.panel.pcollab -text " Pen:"
     button .ppad.panel.pcol -width 3 -bg $spad::pcolor -relief ridge -command {
         set tmpcol [spad::setcol $spad::pcolor .ppad.panel.pcol]
         if {$tmpcol != ""} {set spad::pcolor $tmpcol}
     }
     label .ppad.panel.pbcollab -text " Fill:"
     button .ppad.panel.pbcol -width 3 -bg $spad::pbcolor -relief ridge -command {
         set tmpcol [spad::setcol $spad::pbcolor .ppad.panel.pbcol]
         if {$tmpcol != ""} {set spad::pbcolor $tmpcol}
     }
     label .ppad.panel.bgcollab -text " Background:"
     button .ppad.panel.bgcol -width 3 -bg $spad::canbg -relief ridge -command {
         set tmpcol [spad::setcol $spad::canbg .ppad.panel.bgcol]
         if {$tmpcol != ""} {
             .ppad.f.c configure -bg [set spad::bgcollab $tmpcol]
         }
     }
     spinbox .ppad.dpanel.thickness -values $spad::thicklist -command {set spad::thickness [.ppad.dpanel.thickness get]} -state readonly -width 3
     button .ppad.dpanel.pointer -relief raised -command spad::pointer -image [image create photo -data {
         R0lGODlhEAAQAIMAAPwCBAQCBPz+xPz+BMTCBPz+/MTCxISChDQyNAAAAAAA
         AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAREEMhJg6BYWhAG
         v5k2EKMXToSgEqc1DEIhvGAWpOvJFSXZyoXOxxY0BDahQDGg4xgOxmbgiWDq
         poeqlGrVcZuSbLfpjwAAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVy
         c2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJl
         c2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==}]
     button .ppad.dpanel.freehand -relief raised -command spad::draw_free -image [image create photo -data {
         R0lGODlhEgASAIAAAAAAAP///yH5BAEAAAEALAAAAAASABIAAAIjjI+pywgP
         moty1kTvyTpw/UHfRkGGqYhpt7Gn67GopMK2UgAAOw==}]
     button .ppad.dpanel.line -relief raised -command spad::draw_line -image [image create photo -data {
         R0lGODlhEgASAIAAAAAAAP///yH5BAEAAAEALAAAAAASABIAAAIdjI+py+0G
         wEtxUmlPzRDnzYGfN3KBaKGT6rDmGxQAOw==}]
     button .ppad.dpanel.rectangle -relief raised -command spad::draw_rectangle -image [image create photo -data {
         R0lGODlhEgASAIAAAAAAAP///yH5BAEAAAEALAAAAAASABIAAAImjI+py+3f
         gJxUqorB1csmv4Udh4AfeZglaqgpG7gtnFVbLUP6/hQAOw==}]
     button .ppad.dpanel.circle -relief raised -command spad::draw_circle -image [image create photo -data {
         R0lGODlhEgASAIAAAAAAAP///yH5BAEAAAEALAAAAAASABIAAAIrjI+pywkP
         X4sULKgw0tluz0iHGIIBeZlo9zWnarLjOnfxe+NVbuy8CwwWAAA7}]
     
     .ppad configure -menu [menu .ppad.padmenu] -padx 5 -pady 5
     .ppad.padmenu add cascade -label "File" -menu [menu .ppad.padmenu.file -tearoff 0]
     .ppad.padmenu.file add command -label "Clear" -command {.ppad.f.c delete all}
     .ppad.padmenu.file add command -label "Save" -command {spad::save_can $spad::savename}
     .ppad.padmenu.file add command -label "Save As" -command {spad::save_can ""}
     .ppad.padmenu.file add separator
     .ppad.padmenu.file add command -label "About" -command {tk_messageBox -title "About" -message "Scratch Pad\n2006 by Martin Eder\n(snofix@users.sourceforge.net)"}
     .ppad.padmenu.file add command -label "Exit" -command exit
     
     pack .ppad.f.c -expand 1 -fill both
     pack .ppad.dpanel.pointer .ppad.dpanel.freehand .ppad.dpanel.line .ppad.dpanel.rectangle .ppad.dpanel.circle -padx 2 -side top -pady 1 -fill x
     pack .ppad.dpanel.thickness -side top -pady 10 -padx 2 -fill x
     pack .ppad.panel.pcollab .ppad.panel.pcol .ppad.panel.pbcollab .ppad.panel.pbcol .ppad.panel.bgcollab .ppad.panel.bgcol -side left
     pack .ppad.status.size .ppad.status.pos -side right
     pack .ppad.status.bar -side left -expand 1 -fill x
     pack .ppad.status -side bottom -fill x
     pack .ppad.panel -side bottom -fill x -pady 5
     pack .ppad.dpanel -side left -fill y
     pack .ppad.f -side right -expand 1 -fill both
     
     bind .ppad.f.c <3> {.ppad.f.c delete current}
     bind .ppad.f.c <Configure> {.ppad.status.size configure -text "[winfo width .ppad.f.c]x[winfo height .ppad.f.c]"}
     bind posupdate <Motion> {spad::update_pos %x %y}
     bind posupdate <B1-Motion> {spad::update_pos %x %y}
     bindtags .ppad.f.c {posupdate .ppad.f.c .ppad}
     
     ### Help text
     bind .ppad.dpanel.pointer <Enter> {.ppad.status.bar configure -text "Magic wand. Move a figure by drag and drop."}
     bind .ppad.dpanel.freehand <Enter> {.ppad.status.bar configure -text "Tool for free-hand drawings. Press the left mouse button and keep it pressed."}
     bind .ppad.dpanel.line <Enter> {.ppad.status.bar configure -text "Draw lines. Keep the left mouse button pressed to draw the line."}
     bind .ppad.dpanel.rectangle <Enter> {.ppad.status.bar configure -text "Draw rectangeles. Keep the left mouse button pressed to draw the rectangle."}
     bind .ppad.dpanel.circle <Enter> {.ppad.status.bar configure -text "Draw ovals. Keep the left mouse button pressed to draw the oval."}
     bind .ppad.dpanel.thickness <Enter> {.ppad.status.bar configure -text "Change the thickness of the pen."}
     bind .ppad.panel.pcol <Enter> {.ppad.status.bar configure -text "Change the color of the pen."}
     bind .ppad.panel.pbcol <Enter> {.ppad.status.bar configure -text "Change the fill color for rectangles and ovals."}
     bind .ppad.f.c <Enter> {.ppad.status.bar configure -text "Scratch Pad. Right click to delete figures, left mouse button to draw figures."}
     bind .ppad.status.pos <Enter> {.ppad.status.bar configure -text "Shows x and y position of the pointer."}
     bind .ppad.status.size <Enter> {.ppad.status.bar configure -text "Shows canvas size in pixels."}
 }
 
 proc spad::pointer {} {
     spad::draw_mode pointer
     bind .ppad.f.c <ButtonPress-1> {
         set startx %x
         set starty %y
         set seltag [.ppad.f.c gettag current]
         puts $seltag}
     bind .ppad.f.c <B1-Motion> {
         .ppad.f.c move $seltag [expr %x - $startx] [expr %y - $starty]
         set startx %x
         set starty %y
     }
     bind .ppad.f.c <ButtonRelease-1> {}
 }
 
 proc spad::draw_free {} {
     spad::draw_mode freehand
     bind .ppad.f.c <ButtonPress-1> {set tempfree [.ppad.f.c create line %x %y %x %y -fill $spad::pcolor -width $spad::thickness]}
     bind .ppad.f.c <B1-Motion> {.ppad.f.c coords $tempfree [concat [.ppad.f.c coords $tempfree] %x %y]}
     bind .ppad.f.c <ButtonRelease-1> {}
 }
 
 proc spad::draw_line {} {
     spad::draw_mode line
     bind .ppad.f.c <ButtonPress-1> {
         set linestartx %x
         set linestarty %y
         set tline [.ppad.f.c create line $linestartx $linestarty %x %y -width $spad::thickness -fill $spad::pcolor]
     }
     bind .ppad.f.c <B1-Motion> {.ppad.f.c coord $tline $linestartx $linestarty %x %y}
     bind .ppad.f.c <ButtonRelease-1> {.ppad.f.c coord $tline $linestartx $linestarty %x %y}
 }
 
 proc spad::draw_rectangle {} {
     spad::draw_mode rectangle
     bind .ppad.f.c <ButtonPress-1> {
         set rectstartx %x
         set rectstarty %y
         set trect [.ppad.f.c create rectangle $rectstartx $rectstarty %x %y -width $spad::thickness -fill $spad::pbcolor -outline $spad::pcolor]
     }
     bind .ppad.f.c <B1-Motion> {.ppad.f.c coord $trect $rectstartx $rectstarty %x %y}
     bind .ppad.f.c <ButtonRelease-1> {.ppad.f.c coord $trect $rectstartx $rectstarty %x %y}
 }
 
 proc spad::draw_circle {} {
     spad::draw_mode circle
     bind .ppad.f.c <ButtonPress-1> {
         set circstartx %x
         set circstarty %y
         set tcirc [.ppad.f.c create oval $circstartx $circstarty %x %y -width $spad::thickness -fill $spad::pbcolor -outline $spad::pcolor]
     }
     bind .ppad.f.c <B1-Motion> {.ppad.f.c coord $tcirc $circstartx $circstarty %x %y}
     bind .ppad.f.c <ButtonRelease-1> {.ppad.f.c coord $tcirc $circstartx $circstarty %x %y}
 }
 
 proc spad::draw_mode {widget} {
     .ppad.dpanel.$::spad::currentmode configure -relief raised
     .ppad.dpanel.$widget configure -relief sunken
     set ::spad::currentmode $widget
 }
 
 proc spad::save_can {filename} {
     if {[catch {package require Img} err]} {
         tk_messageBox -message "Could not load package Img!" -icon error
         return
     }    
     set canimg [image create photo -format window -data .ppad.f.c]
     if {$filename == ""} {
         set filename [tk_getSaveFile -title "Save Scratch Pad" -filetypes "\"{GIF Image} {.gif}\" \"{JPEG Image} {.jpg}\"" -initialdir [pwd] -initialfile "ScratchPad.gif"]
     }    
     if {$filename != ""} {
         switch -- [file extension $filename] {
             ".gif" {set fformat "GIF"}
             ".jpg" {set fformat "JPEG"}
             default {tk_messageBox -title "Unsupported format" -message "Unsupported format.\nPlease use gif or jpg extension.\n" -icon error; return}
         }
         $canimg write $filename -format $fformat
     }
     set spad::savename $filename
 }
 
 proc spad::update_pos {xp yp} {
     set offset 0
     set xpos [expr $xp - $offset]
     set ypos [expr $yp - $offset]
     .ppad.status.pos configure -text "$xpos,$ypos"
 }
 
 spad::gui
 spad::draw_free
 spad::update_pos 0 0
 ### End of Script
======

----

[MG] You could consolidate those three procs at the start for changing colours into one if you passed the info that changes (the varname to be set / proc whose colour should be altered / title) as args, to save repeating almost-identical code. Something like this (proc name changed/'if 0' added so it doesn't clash with the real code above) would probably work

======
 if 0 {
  proc set_color2 {var widget {keyword "fill"}} {
    set newcolor [tk_chooseColor -initialcolor [set $var] -title "Choose new $keyword color"]
    if { $newcolor != "" } {
         set $var $newcolor
         $widget configure -bg $newcolor
       }
  }

  button .panel.pcol -width 3 -bg $::pcolor -relief ridge -command [list set_color2 ::pcolor .panel.pcol pencil]
 }
======

[MEd] 2006/02/23 Thanks for pointing this issue out. I improved the script a little bit, also including your consideration.
----
----
**Screenshots Section**

[Tk Paint Brush - Simple Drawing Tool screen.png] 


[gold] added pix

----
<<categories>> Toys | Example | Games | Animation| Canvas | Toys and Games | Graphics |  Tcl/Tk Games | Application | Characters