Tcl/Tk Curso On-Line de Programação

Trabalhando com imagens

Tk, atualmente, suporta três formatos para arquivos de imagens: GIF, PGM e PPM. Outros formatos como JPEG, PNG, TIFF e WMF podem ser acessados através de bibliotecas externas. Entretanto, a Ajuba Solutions, atual mantenedor do Tcl/Tk pretende incluir estas extensões na próxima versão( 8.4 ) que deverá estar disponível, em sua versão final, em dezembro. Ícones no formato do Windows( *.ICO ) são suportados através do comando winico, caso você compile o seu programa usando o freeWrap para Windows, ou utilize uma biblioteca externa. Ícones do X-Window( pixmaps ) são suportados através de uma biblioteca em Tcl puro, cujo código fonte será apresentado no final desta aula. Você pode usar arquivos XPM( pixmaps X11 ) no Windows.

A seguir são apresentados os comando para leitura, manipulação e gravação de imagens em Tcl/Tk:
 

As opções suportadas dependem do tipo da imagem. Os tipos suportados por Tk são: bitmap e photo. Bitmap é uma imagem monocromática, que pode ter um fundo transparente. É um bitmap X-Window e não um bitmap Windows. Os bitmaps do Windows são suportados através de bibliotecas externas. Photo é uma imagem colorida, que pode ser lida e salva em vários formatos. Pode ser transparente.

As opções para as imagens do tipo bitmap são as seguintes:
 

As opções para as imagens do tipo photo são as seguintes:
 

As imagens do tipo photo suportam ainda os seguintes comandos:
 

O comando copy suporta as seguintes opções:
 

O comando read suporta as seguintes opções:
 

O comando write suporta as seguintes opções:
 

Veja um exemplo:

toplevel .t

label .t.l

pack .t.l

image create photo logo -file [file join $tk_library images logo100.gif]

.t.l configure -image logo

Mapas de pixels( arquivos XPM )

Os mapas de pixels, pixmaps X11, são largamente usados como arquivos de ícones devido à facilidade para criação de ícones no próprio código do programa. Veja o conteúdo típico de uma arquivo XPM:
 

/* XPM */
static char * calc_xpm[] = {
"32 32 7 1",
"       c None",
".      c #666666",
"+      c #E5E5E5",
"@      c #7F7F7F",
"#      c #FFFFFF",
"$      c #000000",
"%      c #CCCCCC",
"                                ",
"     ......................     ",
"     .+++++++++++++++++++@.     ",
"     .+##################@.     ",
"     .+##############$#$#@.     ",
"     .+##################@.     ",
"     .+@@@@@@@@@@@@@@@@@@@.     ",
"     .%%%%%%%%%%%%%%%%%%%%.     ",
"     .++++$++++$++++$++++$.     ",
"     .+%%%$+%%%$+%%%$+%%%$.     ",
"     .+%$%$+%$%$+%$%$+%$%$.     ",
"     .+%%%$+%%%$+%%%$+%%%$.     ",
"     .+$$$$+$$$$+$$$$+$$$$.     ",
"     .++++$++++$++++$+%%%$.     ",
"     .+%%%$+%%%$+%%%$+%%%$.     ",
"     .+%$%$+%$%$+%$%$+%$%$.     ",
"     .+%%%$+%%%$+%%%$+%%%$.     ",
"     .+$$$$+$$$$+$$$$+$$$$.     ",
"     .++++$++++$++++$++++$.     ",
"     .+%%%$+%%%$+%%%$+%%%$.     ",
"     .+%$%$+%$%$+%$%$+%$%$.     ",
"     .+%%%$+%%%$+%%%$+%%%$.     ",
"     .+$$$$+$$$$+$$$$+$$$$.     ",
"     .++++$++++$++++$++++$.     ",
"     .+%%%$+%%%$+%%%$+%%%$.     ",
"     .+%$%$+%$%$+%$%$+%$%$.     ",
"     .+%%%$+%%%$+%%%$+%%%$.     ",
"     .+$$$$+$$$$+$$$$+$$$$.     ",
"     .%%%%%%%%%%%%%%%%%%%%.     ",
"     .%%%%%%%%%%%%%%%%%%%%.     ",
"     ......................     ",
"                                "};

O código fonte a seguir define o comando xpm-to-image que retorna uma imagem( para ser atribuída à propriedade -image de um widget ) a partir de um arquivo XPM:
 

# ------------------------------------------------------------------------------
#  xpm2image.tcl
# ------------------------------------------------------------------------------
#
#  Copyright 1996 by Roger E. Critchlow Jr., San Francisco, California
#  All rights reserved, fair use permitted, caveat emptor.
#  rec@elf.org
# 
# ------------------------------------------------------------------------------

proc xpm-to-image { file } {
    set f [open $file]
    set string [read $f]
    close $f

    #
    # Analiza a strings no arquivo XPM
    #
    set xpm {}
    foreach line [split $string "\n"] {
        if {[regexp {^"([^\"]*)"} $line all meat]} {
            if {[string first XPMEXT $meat] == 0} {
                break
            }
            lappend xpm $meat
        }
    }

    #
    # Extrai os dados no arquivo
    #
    set sizes  [lindex $xpm 0]
    set nsizes [llength $sizes]
    if { $nsizes == 4 || $nsizes == 6 || $nsizes == 7 } {
        set data(width)   [lindex $sizes 0]
        set data(height)  [lindex $sizes 1]
        set data(ncolors) [lindex $sizes 2]
        set data(chars_per_pixel) [lindex $sizes 3]
        set data(x_hotspot) 0
        set data(y_hotspot) 0
        if {[llength $sizes] >= 6} {
            set data(x_hotspot) [lindex $sizes 4]
            set data(y_hotspot) [lindex $sizes 5]
        }
    } else {
            error "A largura da linha {$sizes} em $file nao computa"
    }

    #
    # Extrai as definicoes de cores
    #
    foreach line [lrange $xpm 1 $data(ncolors)] {
        set colors [split $line \t]
        set cname  [lindex $colors 0]
        lappend data(cnames) $cname
        if { [string length $cname] != $data(chars_per_pixel) } {
            error "A definição de cor {$line} no arquivo $file esta com um nome incorreto"
        }
        foreach record [lrange $colors 1 end] {
            set key [lindex $record 0]
            set color [string tolower [join [lrange $record 1 end] { }]]
            set data(color-$key-$cname) $color
            if { ![string compare $color "none"] } {
                set data(transparent) $cname
            }
        }
        foreach key {c g g4 m} {
            if {[info exists data(color-$key-$cname)]} {
                set color $data(color-$key-$cname)
                set data(color-$cname) $color
                set data(cname-$color) $cname
                lappend data(colors) $color
                break
            }
        }
        if { ![info exists data(color-$cname)] } {
            error "A definicao de cor {$line} em $file falhou ao definir a cor"
        }
    }

    #
    # Extrai os dados da imagem
    #
    set image [image create photo -width $data(width) -height $data(height)]
    set y 0
    foreach line [lrange $xpm [expr 1+$data(ncolors)] [expr 1+$data(ncolors)+$data(height)]] {
        set x 0
        set pixels {}
        while { [string length $line] > 0 } {
            set pixel [string range $line 0 [expr {$data(chars_per_pixel)-1}]]
            set c $data(color-$pixel)
            if { ![string compare $c none] } {
                if { [string length $pixels] } {
                    $image put [list $pixels] -to [expr {$x-[llength $pixels]}] $y
                    set pixels {}
                }
            } else {
                lappend pixels $c
            }
            set line [string range $line $data(chars_per_pixel) end]
            incr x
        }
        if { [llength $pixels] } {
            $image put [list $pixels] -to [expr {$x-[llength $pixels]}] $y
        }
        incr y
    }

    #
    # Retorna a imagem
    #
    return $image
}

toplevel .t

label .t.l

pack .t.l

.t.l configure -image [xpm-to-image c:/temp/calc.xpm]

Para uma descrição detalhada de todos os comandos disponíveis em Tk, consulte a documentação on-line, ou o Tcl/Tk Reference Guide, ou ainda o Tcl/Tk Electronic Reference.

Para maiores informações envie e-mail para info@souzamonteiro.com.