234 lines
13 KiB
Tcl
234 lines
13 KiB
Tcl
#!/bin/sh
|
|
# \
|
|
exec wish "$0" "$@"
|
|
wm title . "Cadastro de Clientes"
|
|
# Os dois comandos abaixo, servem para chamar os pacotes BWidget(ComboBox) \
|
|
e Wcb(para definir limite de tamanho dos widgets entry), usados nesse tutorial.\
|
|
OBS: entry: são os campos da tela, como ACCEPTs do Cobol.\
|
|
widget: objetos de tela(ComboBox, Textos, entry etc)
|
|
package require BWidget
|
|
package require Wcb
|
|
# O comando abaixo serve para definir que todos os compontes "entry" tenham fundo branco
|
|
option add *Entry.background white
|
|
# Como voce pode ver, todo componente deve receber um nome, atribuido logo depois da declaracao do componente, \
|
|
precedido de um ponto (ex: label .nome_do_label)
|
|
# Quando se coloca o caracter "\" no final da linha, significa que a linha abaixo, e' continuacao da linha atual
|
|
# O comando abaixo, serve para criar um frame. Um frame serve para organizar melhor a sua janela, pois varios \
|
|
componetes podem ser armazenados dentro dele, como se fossem filhos desse frame, conforme você exibe ele, \
|
|
os widgets dentro dele, tambem sao exibidos, a opcao -bd define a largura de sua borda, e a opcao -relief \
|
|
define o estilo de frame.
|
|
frame .fr -bd 2 -relief groove
|
|
frame .meio
|
|
frame .fim -bd 2 -relief groove
|
|
# o comando button, serve para criar um botao, e a palavra a seguir e' o nome do botao, no caso abaixo\
|
|
o nome do botao e' .butgravar(nao se esquecendo do ponto no inicio), a opcao -image, define que imagem \
|
|
o botao ira mostrar em seu rotulo, a opcao -command, define qual acao sera feita, apos ser clicado no \
|
|
botao, no caso abaixo, a variavel tclopcao, sera carregada com o valor "gra", e logo em seguida fara o comando\
|
|
do_exit, que faz com que o programa retorne ao Cobol(explicado mais detalhadamente no arquivo leia-me.txt)\
|
|
OBS: para um botao que tenha no seu rotulo, epenas texto, voce substitui a opcao -image por -text e o \
|
|
texto desejado
|
|
button .butgravar -image [image create photo -file "gravarc.gif"] -command {set tclopcao gra ; do_exit}
|
|
button .butdeletar -image [image create photo -file "excluirc.gif"] -command {set tclopcao del ; do_exit}
|
|
button .butcancelar -image [image create photo -file "cancelac.gif"] -command {set tclcodigo "" ;\
|
|
set tclnome "" ; set tclendereco "" ; set tclbairro "" ; set tclcidade "" ; set tclcep "" ;\
|
|
set tclddd "" ; set tclfone "" ; set tclfax "" ; set tcluf SC ; focus .entcod}
|
|
button .butbusca -image [image create photo -file "buscac.gif"] -command {set tclopcao bus ; \
|
|
janela_busca ; do_exit}
|
|
button .butsair -image [image create photo -file "sairc.gif"] -command {set tclopcao sai ; do_exit}
|
|
button .butsobre -image [image create photo -file "sobrec.gif"] -command {janela_infocont}
|
|
# o comando abaixo, serve para criar rotulos a serem exibidos na tela, grotescamente falando, e' semelhante ao\
|
|
DISPLAY do Cobol, a opcao -textvariable, indica que o texto a ser exibido pelo label e' o valor que a variavel\
|
|
indicada tem, conforme muda o valor da variavel, automaticamente, o texto exibido pelo label, tambem e' alterado,\
|
|
no caso abaixo, o texto do label .labmensagem, tera o valor da variavel tclmensagem.
|
|
label .labmensagem -textvariable tclmensagem
|
|
label .mensagem2 -textvariable tclmensagem2
|
|
# o comando "pack" e' uma forma de mostrar os componentes na tela, explicado mais detalhadamente no arquivo leia-me.txt
|
|
pack .butgravar .butdeletar .butcancelar .butbusca .butsair .butsobre -in .fr -side left -fill both
|
|
pack .labmensagem -in .fim -pady 5 -side left
|
|
pack .mensagem2 -in .fim -pady 5 -side right
|
|
pack .fr -side top -fill x
|
|
pack .meio -side top -padx 10 -pady 10 -fill y -anchor nw
|
|
pack .fim -side bottom -fill x -anchor nw
|
|
|
|
label .labcodigo -text "Codigo"
|
|
label .labnome -text "Nome"
|
|
label .labendereco -text "Endereco"
|
|
label .labbairro -text "Bairro"
|
|
label .labcidade -text "Cidade"
|
|
label .labuf -text "UF"
|
|
label .labcep -text "CEP"
|
|
label .labddd -text "DDD"
|
|
label .labfone -text "Telefone"
|
|
label .labfax -text "FAX"
|
|
# O comando abaixo serve para criar campos na tela(semelhante ao ACCEPT do Cobol), a opcao -textvariable, \
|
|
tem a mesma funcao referente ao label, o valor exibido pelo entry e' o valor da variavel, conforme muda \
|
|
o valor da variavel e' alterado o valor do entry, e vice-versa.
|
|
entry .entcod -textvariable tclcodigo -width 5
|
|
# O comando abaixo pertence ao pacote Wcb. Ele faz com que o componente indicado(no caso o .entcod), tenha no maximo o \
|
|
numero de caracteres indicado(no caso, 5) e se os caracteres nao-numericos estao desativados(no caso esta desativado)
|
|
wcb::callback .entcod before insert {wcb::checkEntryLen 5} wcb::checkEntryForInt
|
|
entry .entnome -textvariable tclnome -width 40
|
|
wcb::callback .entnome before insert {wcb::checkEntryLen 40}
|
|
entry .entendereco -textvariable tclendereco -width 40
|
|
wcb::callback .entendereco before insert {wcb::checkEntryLen 40}
|
|
entry .entbairro -textvariable tclbairro -width 25
|
|
wcb::callback .entbairro before insert {wcb::checkEntryLen 25}
|
|
entry .entcidade -textvariable tclcidade -width 25
|
|
wcb::callback .entcidade before insert {wcb::checkEntryLen 25}
|
|
entry .entfocu -textvariable tclfocus
|
|
entry .entopcao -textvariable tclopcao
|
|
entry .entuf -textvariable tcluf
|
|
# o componente abaixo pertence ao pacote BWidget, e' uma caixa de texto, com uma lista de opcoes, explicado\
|
|
mais detalhadamente no arquivo leia-me.txt
|
|
ComboBox .cbuf -width 8 -textvariable tcluf -entrybg white \
|
|
-values {AC AL AP AM BA CE DF ES FN GO MS MA MT MG PA PB PR PE PI RN RS RJ RO RR SC SP SE TO}
|
|
entry .entcep -textvariable tclcep -width 9
|
|
wcb::callback .entcep before insert verifica_cep
|
|
entry .entddd -textvariable tclddd -width 4
|
|
wcb::callback .entddd before insert {wcb::checkEntryLen 4} wcb::checkEntryForInt
|
|
entry .entfone -textvariable tclfone -width 8
|
|
wcb::callback .entfone before insert {wcb::checkEntryLen 8} wcb::checkEntryForInt
|
|
entry .entfax -textvariable tclfax -width 8
|
|
wcb::callback .entfax before insert {wcb::checkEntryLen 8} wcb::checkEntryForInt
|
|
# o comando "grid" e' um outro metodo de organizacao dos componentes, explicado melhor no arquivo leia-me.txt
|
|
grid .labcodigo .entcod -in .meio -sticky w -pady 3
|
|
grid .labnome .entnome -in .meio -sticky w -pady 3
|
|
grid .labendereco .entendereco -in .meio -sticky w
|
|
grid .labbairro .entbairro -in .meio -sticky w -pady 3
|
|
grid .labcidade .entcidade -in .meio -sticky w
|
|
grid .labuf .cbuf -in .meio -sticky w -pady 3
|
|
grid .labcep .entcep -in .meio -sticky w
|
|
grid .labddd .entddd -in .meio -sticky w -pady 3
|
|
grid .labfone .entfone -in .meio -sticky w -pady 3
|
|
grid .labfax .entfax -in .meio -sticky w -pady 3
|
|
### Criando procedures
|
|
### proc {valores} {corpo}
|
|
### se voce quiser que a procedure receba mais de um valor, eles sao separados por espaco, \
|
|
conforme o exemplo abaixo:
|
|
### proc {valor1 valor2 valor3} {
|
|
### set valor1 a
|
|
### set valor2 b
|
|
### set valor3 c
|
|
### }
|
|
|
|
proc verifica_cep {comp idx str} {
|
|
set texto [wcb::postInsertEntryText $comp $idx $str]
|
|
set tamedit [string length $texto]
|
|
set ::campo $comp
|
|
regsub -all "::_" $::campo "" ::campo
|
|
if {![regexp {^[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?\.?[0-9]{0,3}?$} $texto]} {
|
|
wcb::cancel
|
|
} else {
|
|
if {$tamedit == 6} {
|
|
$comp insert end "."
|
|
}
|
|
if {$tamedit == 9} {
|
|
tk::TabToWindow [tk_focusNext $::campo]
|
|
}
|
|
}
|
|
}
|
|
|
|
proc janela_busca {} {
|
|
global tclopcao
|
|
destroy .janbusca
|
|
toplevel .janbusca -height 195 -width 325
|
|
wm title .janbusca "Busca"
|
|
wm transient .janbusca .
|
|
listbox .janbusca.lista1 -background white -selectmode single -yscrollcommand {.janbusca.rolagem1 set}
|
|
scrollbar .janbusca.rolagem1 -orient vertical -command {.janbusca.lista1 yview}
|
|
label .janbusca.labtitulo -text "De dois clicks no item desejado"
|
|
button .janbusca.butok -text "OK" -command {set tclmensagem \
|
|
[.janbusca.lista1 get [.janbusca.lista1 curselection]] ; \
|
|
set tclopcao cer ; do_exit ; destroy .janbusca}
|
|
button .janbusca.butcan -text "Cancela" -command {destroy .janbusca; do_exit}
|
|
place .janbusca.labtitulo -x 10 -y 10
|
|
button .janbusca.sai -text "sai" -command {do_exit}
|
|
place .janbusca.lista1 -x 10 -y 30 -height 120 -width 286
|
|
place .janbusca.rolagem1 -x 294 -y 30 -height 120 -width 15
|
|
place .janbusca.butok -x 10 -y 155 -width 70
|
|
place .janbusca.butcan -x 85 -y 155 -width 70
|
|
bind .janbusca.lista1 <Double-Button-1> {set tclmensagem [.janbusca.lista1 get [.janbusca.lista1 curselection]] ; \
|
|
set tclopcao cer ; do_exit ; destroy .janbusca}
|
|
}
|
|
proc janela_infocont {} {
|
|
destroy .janinfocont
|
|
toplevel .janinfocont -height 370 -width 450
|
|
wm maxsize .janinfocont 450 370
|
|
wm title .janinfocont "Sobre"
|
|
label .janinfocont.butinfocont -image [image create photo -file "infocont.gif"]
|
|
label .janinfocont.lab1 -text "Pensando na crescente comunidade do TinyCobol no Brasil a InfoCont"
|
|
label .janinfocont.lab2 -text "disponibiliza mais um tutorial sobre o uso deste otimo compilador."
|
|
label .janinfocont.lab3 -text "Atraves da linguagem Tcl/Tk o TinyCobol se torna capaz de manipular"
|
|
label .janinfocont.lab4 -text "telas graficas tanto em Linux quanto em Windows."
|
|
label .janinfocont.lab5 -text "Neste tutorial pretendemos demonstrar a todos os interassados o uso"
|
|
label .janinfocont.lab6 -text "desta nova tecnologia."
|
|
label .janinfocont.lab7 -text "Desejamos a todos um otimo estudo!"
|
|
label .janinfocont.lab8 -text "Viva o Software Livre!!!!!!!!"
|
|
label .janinfocont.lab9 -text "Fernando Wuthstrack" -foreground blue
|
|
label .janinfocont.lab10 -text "Danilo Pacheco Martins" -foreground blue
|
|
place .janinfocont.butinfocont -x 15 -y 15
|
|
place .janinfocont.lab1 -x 15 -y 120
|
|
place .janinfocont.lab2 -x 15 -y 140
|
|
place .janinfocont.lab3 -x 15 -y 160
|
|
place .janinfocont.lab4 -x 15 -y 180
|
|
place .janinfocont.lab5 -x 15 -y 200
|
|
place .janinfocont.lab6 -x 15 -y 220
|
|
place .janinfocont.lab7 -x 15 -y 240
|
|
place .janinfocont.lab8 -x 15 -y 260
|
|
place .janinfocont.lab9 -x 300 -y 310
|
|
place .janinfocont.lab10 -x 300 -y 330
|
|
}
|
|
|
|
proc var_cobol {} {
|
|
global cobol_fields widget tclnumero0 tclnumero1
|
|
set cobol_fields {
|
|
tclcodigo 4
|
|
tclnome 40
|
|
tclendereco 40
|
|
tclbairro 25
|
|
tclcidade 25
|
|
tcluf 2
|
|
tclcep 10
|
|
tclddd 4
|
|
tclfone 9
|
|
tclfax 9
|
|
tclopcao 3
|
|
tclmensagem 60
|
|
tclfocus 3
|
|
tclmensagem2 10
|
|
}
|
|
}
|
|
|
|
proc ::cobol_preprocess {args} {
|
|
global tclopcao tclmensagem tclfocus
|
|
switch $tclopcao {
|
|
bus {.janbusca.lista1 insert end $tclmensagem
|
|
do_exit}
|
|
}
|
|
switch $tclfocus {
|
|
cod {focus .entcod}
|
|
nom {focus .entnome}
|
|
ini {focus .janbusca.butok; set tclfocus " "; set tclmensagem ""}
|
|
}
|
|
}
|
|
# O comando "bind", tem por finalidade executar algum comando, conforme o evento solicidado, Ex: \
|
|
bind .entcod <Return> {puts "voce pressionou enter"} \
|
|
no caso acima o comando fara com que ao se pressionar "Enter" no componente ".entcod", seja exibido \
|
|
na tela a frase "voce pressionou enter"
|
|
# Esse comando abaixo passara o valor "alt" para a variavel tclopcao e depois ira para o cobol (do_exit), \
|
|
quando o componente .entcod perder o foco(o cursor sair desse componente e ir para outro), isso se a \
|
|
variavel tclopcao nao for igual a "bus" e nem "pri"
|
|
bind .entcod <FocusOut> {
|
|
if {$tclopcao != "bus" && $tclopcao != "pri"} {
|
|
set tclopcao alt
|
|
do_exit
|
|
}
|
|
}
|
|
bind .cbuf <Escape> {focus .entcidade}
|
|
bind Entry <FocusIn> {set [lindex [split [%W configure -textvariable] " "] 4] \
|
|
[string trimright [%W get] " "] ; %W icursor 0 ; %W selection clear ; focus %W}
|
|
bind all <Return> {tk::TabToWindow [tk_focusNext %W]}
|
|
bind all <Escape> {tk::TabToWindow [tk_focusPrev %W]}
|
|
var_cobol
|
|
focus .entcod
|