Visualizador de imagem

Publicado por tiago 07/04/2006

[ Hits: 5.972 ]

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: [email protected]           #
# Msn: [email protected]             # 
# E-mail: [email protected]            # 
#                                       # 
#########################################

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

Calculadora em Tcl/Tk

Renomeando arquivos de forma padronizada

O mundo do Polinômio

tkFind

Script lixeira em Tcl


  

Comentários

Nenhum comentário foi encontrado.


Contribuir com comentário




Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner
Linux banner
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts