Version 1 of Canvas pixel painting

Updated 2005-08-15 11:47:55

"Elfo" <[email protected]> wrote in the comp.lang.tcl newsgroup:

Here you have a sample... it's a very simple application for paint. I used an image in a canvas widget... I'm not sure it's the best way to do it... but it works (I use 8.4a2 version of Tcl/Tk and Win2000).

 global _paint

 set _paint(alto) 600
 set _paint(ancho) 800
 set _paint(color) black

 ### Buttons
 frame .barra
 spinbox .barra.spgrosorx -textvariable _paint(grosorx) -from 1 -to 200 -width 5
 spinbox .barra.spgrosory -textvariable _paint(grosory) -from 1 -to 200 -width 5
 button .barra.bcolor -text Color -bg $_paint(color) -command "ChangeColor"
 button .barra.bcapas -text Capas -command "MostrarCapas"
 set _paint(grosorx) 1
 set _paint(grosory) 1
 pack .barra.spgrosorx .barra.spgrosory .barra.bcolor -side left
 pack .barra -side top -fill x

 ### Draw area
 frame .lienzo

 canvas .lienzo.c -bg white -width $_paint(ancho) -height $_paint(alto)
 pack .lienzo.c -fill both
 pack .lienzo -fill both -side right

 set _paint(lienzo) [.lienzo.c create image 0 0 -image [image create photo _paint(fondo) -width $_paint(ancho) -height $_paint(alto) -palette 256/256/256] -anchor nw ]
 .lienzo.c create image 0 0 -image [image create photo _paint(capa1) -width $_paint(ancho) -height $_paint(alto) -palette 256/256/256] -anchor nw
 _paint(fondo) put {white} -to 0 0 $_paint(ancho) $_paint(alto)

 bind .lienzo.c <1> "Paint %x %y"
 bind .lienzo.c <B1-Motion> "Paint %x %y"

 proc Paint {x y} {
    global _paint

    if {$x >= 0 && $y >= 0} {
        _paint(fondo) put $_paint(color) -to $x $y [expr $x + $_paint(grosorx)] [expr $y + $_paint(grosory)]

 proc ChangeColor {} {
    global _paint

    set aux $_paint(color)

    set _paint(color) [tk_chooseColor]
    if {$_paint(color) != ""} {
        .barra.bcolor configure -bg $_paint(color)
    } else  {
        set _paint(color) $aux

Sorry about the spanish words in my code... Good luck!!

 Asier Burgoa González
 [email protected]

 Éniac, Sistemas Informáticos S.A.
 +34 941 28 28 28

Arts and crafts of Tcl-Tk programming