Num ta muito bom , mas da pra ver algumas imagens :)
Precisa do tkimg --> http://sourceforge.net/projects/tkimg/

• Download tkview.tcl
• Enviar nova versão

Esconder código-fonte

#!/usr/bin/wish
#########################################
#                                       #
# Autor: Tiago Nascimento Marques       #
# JID: tiagotnm@amessage.info           #
# Msn: tiago-nm@hotmail.com             # 
# E-mail: tiagotux@gmail.com            # 
#                                       # 
#########################################

package require Img
set fig "Nenhum arquivo"
menu .menu
menu .menu.file
.menu add cascade -label "Arquivo" -menu .menu.file -underline 0
.menu.file add command -label "Abrir" -command {abrir} -accelerator "<Control-a>"
.menu.file add separator
.menu.file add command -label "Imprimir" -command {imprimir} -accelerator "<Control-p>" 
.menu.file add command -label "Sair" -command {exit} -accelerator "<Esc>"
. configure -menu .menu
################################################
#                    BIND                      #
################################################

bind all <Control-p> {imprimir}
bind all <Control-a> {abrir}
bind all <Key-Escape> {exit}

label .lbl -background white 

##################################################

if {$argv != ""} {
set file [ lindex $argv 0 ] 
image create photo jpg -file [ file join $file ]  
.lbl configure -image jpg
set x [ image width jpg ]
set y [ image height jpg ]
.lbl configure -width $x -height $y      

set meio "x" 
set res  $x$meio$y 
wm geometry . $res+0+0 
wm title . "TkView - $file"


}




####################################################
#                  PROCEDURES                      #
####################################################
proc abrir {} {
   global fig dir initdir
   set tipos {
      {    
       "Extenções de imagem"   {.jpg .jpeg .bmp .gif .png .xpm} }    
      
      
   }
 
   set imagem [ tk_getOpenFile -filetypes $tipos -parent . ]
   if {$imagem != ""} {
      
                set fig $imagem
                image create photo jpg -file [ file join $fig ]  
           .lbl configure -image jpg
                set x [ image width jpg ]
                set y [ image height jpg ]
                .lbl configure -width $x -height $y      
                set meio "x" 
                set res  $x$meio$y 
                wm geometry . $res+0+0 
                wm title . "TkView - $fig" 
   }
}

proc imprimir {} {

toplevel .p
wm title .p "Imprimir - "
wm geometry .p 300x170+0+0
label .p.lblnum -text "Número de cópias"
spinbox .p.spi -from 1 -to 50 -textvariable valor

button .p.btok -text "Ok" -command {


exec lpr-cups -# $valor $fig
destroy .p 



} 
proc arg {$argv} {

}
    
button .p.btcancel -text "Cancelar" -command { destroy .p}
 

pack .p.lblnum .p.spi 
pack .p.btok 
pack .p.btcancel 
}



wm title . "TkView - $fig"
wm geometry . 1024x708+0+0
. configure -background white
pack .lbl

Crivo de Eratóstenes Simples em Tcl (sem Tk)

Calculadora com funções básicas

Script em Tcl para descompactar arquivos

Relógio analógico

Script lixeira em Tcl

Nenhum comentário foi encontrado.