Visualizador de imagem

Publicado por tiago 07/04/2006

[ Hits: 6.458 ]

Download tkview.tcl




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

  



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

Scripts recomendados

Relógio analógico

Calculadora em Tcl/Tk

Script em Tcl para descompactar arquivos

tkFind

Corretagem 0.1 - calcula corretagem padrão de operações da Bovespa


  

Comentários

Nenhum comentário foi encontrado.


Contribuir com comentário




Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts