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

Calculadora com funções básicas

Script lixeira em Tcl

Cadeias aleatórias

param - abre aplicativos com parâmetros no Blackbox e outros

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

Nenhum comentário foi encontrado.