#!/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 {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 {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 { if {$tclopcao != "bus" && $tclopcao != "pri"} { set tclopcao alt do_exit } } bind .cbuf {focus .entcidade} bind Entry {set [lindex [split [%W configure -textvariable] " "] 4] \ [string trimright [%W get] " "] ; %W icursor 0 ; %W selection clear ; focus %W} bind all {tk::TabToWindow [tk_focusNext %W]} bind all {tk::TabToWindow [tk_focusPrev %W]} var_cobol focus .entcod