25 Ago 2013 20:16
25 Ago 2013 21:54
25 Ago 2013 22:20
1 - mesmo esvaziando a pasta dbf, e colocando arquivos próprios, os arquivos do exemplo voltam a ser criados, ous seja: 'TESTE.prg', 'Exemplo.prg' e 'Tabmax.prg'.
2 - No arquivo Mem.prg, criado para compilar os formulários, os DBFs que não são os seus são criados desta forma:
#include 'CLIENTES.DBF.prg', e para compilar precisa tirar o .DBF.
25 Ago 2013 23:16
conteudo2 += "#include '" + strtran(upper(Apasta[ct][1]),".DBF","") + ".prg'" + QUEBRA
#include <hmg.ch>
#include "Directry.ch"
#include "Dbstruct.ch"
#define QUEBRA CHR(13) + CHR(10)
#define DENT Space(4)
Function Main
Load Window Main
Main.Center
Main.Activate
Return
// ----------------------------------------------------------------------------------
Function PegaDiretorio()
x := Getfolder ( { {'Pastas com DBF','*.*'} } , 'Abrir Pasta' , 'c:\' , .f. , .t. )
Main.diretorio.value := x
return
// ----------------------------------------------------------------------------------
Function GerarFormularios()
LOCAL ct:=0, tabela:="", contador, arq, conteudo:="", conteudo2:="", XTAB
MakeDir( "formularios" ) // pasta onde ficarão os formulários gerados
if file("formularios\ORDEM.TXT")
copy file formularios\ORDEM.TXT to ORDEM.TXT
ENDIF
aLimpar := DIRECTORY("formularios\*.*", "H")
for ct:= 1 to len(aLimpar)
arq := "formularios\"+aLimpar[ct][1]
delete file &arq
next
if file("ORDEM.TXT")
copy file ORDEM.TXT to formularios\ORDEM.TXT
delete file ORDEM.TXT
ENDIF
configuracao()
criadbf() // gera um arquivo dbf de exemplo...
Pasta := Main.diretorio.value
if empty(pasta)
MsgStop("É necessário selecionar a pasta onde estão os arquivos DBF!","ERRO")
Return
endif
pasta2 := pasta + "\*.dbf"
pasta2 := strtran(pasta2,"\\","\")
aPasta := DIRECTORY(pasta2, "H")
if len(aPasta)==0
MsgInfo("Não há arquivos DBF para processar!","AVISO")
Return
endif
// Verificando todas as tabelas e todos os campos
for ct:= 1 to len(aPasta)
xdbf := strtran(pasta + "\" +aPasta[ct][1],"\\","\")
use &xdbf
campos := Dbstruct()
close all
tabela := STRTRAN(lower(aPasta[ct][1]),".dbf","")
// Gerenciando a ordem dos campos no formulário.
if FILE("formularios\ORDEM.TXT")
conteudo := memoread("formularios\ORDEM.TXT")
endif
conteudo2 := "["+tabela+"]"
for contador:= 1 to len(campos)
conteudo2 += campos[contador][1] + ","
next
conteudo2 += "["+tabela+"]"
conteudo2 := strtran(conteudo2,",[","[")
XTAB := "["+tabela+"]"
if ( XtAB $ conteudo)
ELSE
conteudo := conteudo + QUEBRA + conteudo2 + QUEBRA
endif
gravarArquivo("ORDEM.TXT",STRTRAN(conteudo,QUEBRA+QUEBRA,QUEBRA))
campos := ordem(tabela,campos)
// Gerando o Formulário:
GerarFormularioDaTabela(tabela,campos)
next
// Copiando arquivo Main e Form Main
copy file cp_main.prg to formularios\Main.prg
copy file cp_fmg.fmg to formularios\Main.Fmg
conteudo:= memoread("formularios\Main.prg")
conteudo2 := ""
for ct:= 1 to len(aPasta)
conteudo2 += "#include '" + strtran(upper(Apasta[ct][1]),".DBF","") + ".prg'" + QUEBRA
next
GRAVARARQUIVO("MAIN.PRG",conteudo + QUEBRA + CONTEUDO2)
MsgInfo("Formulários gerados com sucesso!","AVISO")
Return
// ---------------------------------------------------------------------------------------
Function CriaDbf()
local ct:=0
MakeDir( "dbf" )
// exemplo 1
aDbf := {}
AADD(aDbf, { "Nome", "C", 25, 0 })
AADD(aDbf, { "sexo", "C", 2, 0 })
AADD(aDbf, { "Data", "D", 10, 0 })
AADD(aDbf, { "Endereco", "C", 100, 0 })
AADD(aDbf, { "Telefone", "N", 13, 0 })
AADD(aDbf, { "Cidade", "C", 50, 0 })
AADD(aDbf, { "Estado", "C", 2, 0 })
AADD(aDbf, { "Ativo", "C", 1, 0 })
AADD(aDbf, { "OBS", "M", 10, 0 })
dbf := "dbf\Exemplo"
DBCREATE(dbf, aDbf)
// exemplo 2
aDbf := {}
AADD(aDbf, { "Nome", "C", 25, 0 })
AADD(aDbf, { "sexo", "C", 2, 0 })
AADD(aDbf, { "Data", "D", 10, 0 })
dbf := "dbf\TESTE"
DBCREATE(dbf, aDbf)
// exemplo 3
aDbf := {}
campo113 := "campo"
tipo := {"C","D","N","M"}
for ct:= 1 to 16
aadd(aDbf,{campo113+alltrim(strzero(ct,5)),tipo[(ct%3)+1],30,0})
next
for ct:= 17 to 74
aadd(aDbf,{campo113+alltrim(strzero(ct,5)),tipo[(ct%4)+1],30,0})
next
dbf := "dbf\Tabmax"
DBCREATE(dbf, aDbf)
return
// ----------------------------------------------------------------------------------------
Function GerarFormularioDaTabela(tabela,campos)
// Gera o arquivo PRG do formulário
conteudo := '#include <hmg.ch>' + QUEBRA + ;
'Function '+tabela + QUEBRA + DENT +;
'Load Window ' + tabela + ' ' + QUEBRA + DENT +;
tabela+'.Center' + QUEBRA + DENT +;
tabela+'.Activate' + QUEBRA +;
'Return'
gravarArquivo(tabela+".prg",conteudo) // Grava o PRG que chama o formulario
gravarFormulario(tabela,campos) // Gera o formulario
Return
// ----------------------------------------------------------------------------------------
// Grava um arquivo com dado conteudo
function gravarArquivo(arquivo,conteudo)
arq := fcreate("formularios\"+arquivo)
fwrite(arq,conteudo,len(conteudo))
fclose(arq)
return
// ----------------------------------------------------------------------------------------
// Gera o formulario automaticamente
function gravarFormulario(tabela,campos)
local tam:=len(campos), ct:=0, conteudo, varmax:=0, formText:=""
local xLin:= 80, xCol1:= 20, xCol2:= 240 // Para formulario simples
local pagina:=1, memoVarx
// Verificando a altura máxima do formulário
for ct:= 1 to tam
if (alltrim(upper(campos[ct][2]))=="M")
varmax:=varmax+6
else
++varmax
endif
next
if (varmax<17) // Criando o formulario sem abas (até 16 campos)
// Cabeçalho do Formulário
formText:= formText + cabecalho(tabela,NIL)
for ct:= 1 to tam
// Verificando Campos ignorados no formulário:
if ( (","+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.COMBObOX2.Value)) .OR. (","+ upper(tabela)+":"+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.ComboBox2.Value)) )
loop
endif
// campos tipos CheckBox - definido para todas as tabelas ou personalizado para a tabela corrente
if ( (","+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.CheckBox.Value)) .OR. (","+ upper(tabela)+":"+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.CheckBox.Value)) )
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_check(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
loop
endif
// campos tipos Combo - definido para todas as tabelas ou personalizado para a tabela corrente
if ( (","+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.COMBObOX.Value)) .OR. (","+ upper(tabela)+":"+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.ComboBox.Value)) )
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_combo(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
loop
endif
// campos tipos Radio - definido para todas as tabelas ou personalizado para a tabela corrente
if ( (","+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.Radio.Value)) .OR. (","+ upper(tabela)+":"+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.radio.Value)) )
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_radio(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
loop
endif
// Abaixo temos os campos padronizados...
campo := alltrim(upper(Campos[ct][2]))
if (campo=="M")
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_memo(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 180 - 15
endif
if (campo=="C" .OR. campo=="N")
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_texto(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
endif
if (campo=="D")
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_data(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
endif
next
else // ------ SISTEMA DE ABAS -------------------
// Configurando as linhas para formulario com abas
// Suporte para até 5 abas (máximo de 80 campos)
// Cabeçalho do Formulário
formText:= formText + cabecalho(tabela,"1")
pagina := 1
xRefPage := {0,0,0,0,0}
// Verificando a altura máxima do formulário
varmax:=0
controle:=1
memoVarx:=0
tam := len(campos)
for ct:= 1 to tam // VARRENDO CAMPOS
xRefPage[controle]:= ct
memoVarx:= varmax
if (alltrim(upper(campos[ct][2]))=="M")
varmax:=varmax+6
else
++varmax
endif
// verifica estouro de pagina
if (varMax > 16)
xRefPage[controle]:= ct-1
++ controle
if (controle>5)
exit
endif
xRefPage[controle]:= ct
varmax := varmax - memoVarx
endif
if controle > 5
exit
endif
next
controle := 1
formText:= formText + cp_tab_ini() // inicia tab...
xinicio := 1
do while.t.
xLin:= 40
xCol1:= 20
xCol2:= 240
// Criando uma aba:
formText:= formText + cp_page_ini(pagina)
for ct:= xinicio to xRefPage[controle]
// Verificando Campos ignorados no formulário:
if ( (","+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.COMBObOX2.Value)) .OR. (","+ upper(tabela)+":"+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.ComboBox2.Value)) )
loop
endif
// campos tipos CheckBox - definido para todas as tabelas ou personalizado para a tabela corrente
if ( (","+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.CheckBox.Value)) .OR. (","+ upper(tabela)+":"+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.CheckBox.Value)) )
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_check(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
loop
endif
// campos tipos Combo - definido para todas as tabelas ou personalizado para a tabela corrente
if ( (","+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.COMBObOX.Value)) .OR. (","+ upper(tabela)+":"+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.ComboBox.Value)) )
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_combo(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
loop
endif
// campos tipos Radio - definido para todas as tabelas ou personalizado para a tabela corrente
if ( (","+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.Radio.Value)) .OR. (","+ upper(tabela)+":"+alltrim(upper(campos[ct][1]))+"," $ Upper(Main.radio.Value)) )
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_radio(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
loop
endif
// Abaixo temos os campos padronizados...
campo := alltrim(upper(Campos[ct][2]))
if (campo=="M")
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_memo(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 180 - 15
endif
if (campo=="C" .OR. campo=="N")
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_texto(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
endif
if (campo=="D")
formText += cp_label(campos[CT][1]+"1",XLin,XCol1)
formText += cp_data(campos[CT][1]+"2",XLin,XCol2)
xLin := xLin + 30
endif
next
// FECHANDO A PAGINA:
formText:= formText + cp_page_end()
++pagina
xinicio := xRefPage[controle]+1
++controle
if controle > 5
exit
endif
if xRefPage[controle] == 0
exit
endif
enddo
// FECHANDO A TAB:
formText:= formText + cp_tab_end()
endif
FormText:= FormText + QUEBRA + memoread("cp_botoes.txt") + QUEBRA + "END WINDOW"
gravarArquivo(tabela+".fmg",Formtext)
Return
// ----------------------------------------------------------------------------------------
/**
Monta o cabeçalho do formulário
*/
function cabecalho(tabela,tipo)
if tipo == NIL
comando := hb_memoread("cab.txt")
else
comando := hb_memoread("cabTab.txt")
endif
comando := strtran(comando,"NomeCadastro",tabela)
comando := strtran(comando,"NomeCadastro_1",tabela+"TAB")
return comando
// ----------------------------------------------------------------------------------------
/**
Monta o componente LABEL
*/
function cp_label(campo,XL,XC)
comando := hb_memoread("cp_label.txt")
comando := strtran(comando,"modeloLabelHMG_ROTULO",SUBSTR(CAMPO,1,LEN(CAMPO)-1))
comando := strtran(comando,"modeloLabelHMG",CAMPO)
comando := strtran(comando,"ROW_VALOR","ROW " + ALLTRIM(STR(XL)))
comando := strtran(comando,"COL_VALOR","COL " + ALLTRIM(STR(XC)))
return comando
// ----------------------------------------------------------------------------------------
/**
Monta o componente TEXT
*/
function cp_texto(campo,XL,XC)
comando := hb_memoread("cp_texto.txt")
comando := strtran(comando,"modeloTextoHMG",CAMPO)
comando := strtran(comando,"ROW_VALOR","ROW " + ALLTRIM(STR(XL)))
comando := strtran(comando,"COL_VALOR","COL " + ALLTRIM(STR(XC)))
return comando
// ----------------------------------------------------------------------------------------
/**
Monta o componente DATA
*/
function cp_data(campo,XL,XC)
comando := hb_memoread("cp_data.txt")
comando := strtran(comando,"modelodataHMG",CAMPO)
comando := strtran(comando,"ROW_VALOR","ROW " + ALLTRIM(STR(XL)))
comando := strtran(comando,"COL_VALOR","COL " + ALLTRIM(STR(XC)))
return comando
// ----------------------------------------------------------------------------------------
/**
Monta o componente MEMO
*/
function cp_memo(campo,XL,XC)
comando := hb_memoread("cp_memo.txt")
comando := strtran(comando,"modelomemoHMG",CAMPO)
comando := strtran(comando,"ROW_VALOR","ROW " + ALLTRIM(STR(XL)))
comando := strtran(comando,"COL_VALOR","COL " + ALLTRIM(STR(XC)))
return comando
// ====================================================================================
/**
Monta o componente CHECKBOX
*/
function cp_check(campo,XL,XC)
comando := hb_memoread("cp_check.txt")
comando := strtran(comando,"modeloCheckHMG",CAMPO)
comando := strtran(comando,"ROW_VALOR","ROW " + ALLTRIM(STR(XL)))
comando := strtran(comando,"COL_VALOR","COL " + ALLTRIM(STR(XC)))
return comando
// ====================================================================================
/**
Monta o componente COMBO
*/
function cp_combo(campo,XL,XC)
comando := hb_memoread("cp_combo.txt")
comando := strtran(comando,"modeloComboHMG",CAMPO)
comando := strtran(comando,"ROW_VALOR","ROW " + ALLTRIM(STR(XL)))
comando := strtran(comando,"COL_VALOR","COL " + ALLTRIM(STR(XC)))
return comando
// ====================================================================================
/**
Monta o componente RADIO
*/
function cp_radio(campo,XL,XC)
comando := hb_memoread("cp_radio.txt")
comando := strtran(comando,"modeloRadioHMG",CAMPO)
comando := strtran(comando,"ROW_VALOR","ROW " + ALLTRIM(STR(XL)))
comando := strtran(comando,"COL_VALOR","COL " + ALLTRIM(STR(XC)))
return comando
// ==========================================================================================
/**
Monta o componente TAB
*/
function cp_tab_ini()
comando := hb_memoread("cp_tab.txt")
return comando
function cp_tab_end()
comando := QUEBRA + "END TAB " + QUEBRA + QUEBRA
return comando
function cp_page_ini(pagina)
comando := QUEBRA + 'PAGE "Pág ' + alltrim(STR(pagina)) + '"'+ QUEBRA + QUEBRA
return comando
function cp_page_end()
comando := QUEBRA + "END PAGE " + QUEBRA + QUEBRA
return comando
// ====================================================================================
function ordem(tabela,campos)
local camposFinal := array(len(campos),2), cPosic:= "[" + tabela + "]", CP:="",TIPO:="", resultado
leitura:= hb_memoread("formularios\ordem.txt")
cIni := at(cPosic,leitura)
cFim := rat(cPosic,leitura)
cFim := cFim - cIni
if (cIni==0 .or. cFim==0 )
return campos
endif
comando := substr(leitura,cIni,cFim)
cPosic := at("]",comando)
comando := substr(comando,cPosic+1)
comando := "{'" + comando + "'}"
comando:= upper(strtran(comando,",","','"))
campos2 := &comando
IF (LEN(CAMPOS2)<>LEN(CAMPOS))
msgstop("Ocorreu um erro grave!!!" + QUEBRA +;
"O ARQUIVO [ORDEM.TXT] não contém todos os campos da tabela!!! " + QUEBRA +;
"Você deve somente reordenar os campos, nunca excluí-los!!!" + QUEBRA +;
"Apague o arquivo [ORDEM.TXT] e reinicie o sistema para corrigir este erro!!!" + QUEBRA;
,"ERRO")
delete file FORMULARIOS\ORDEM.TXT
delete file ORDEM.TXT
clear all
main.release
ENDIF
contador := 1
for ct:= 1 to len(campos)
camposFinal[contador][1] := campos2[ct]
for ct2:= 1 to len(campos)
if (camposFinal[contador][1]==upper(campos[ct2][1]))
camposFinal[contador][2] := upper(campos[ct2][2])
++ contador
exit
endif
next
next
for ct:= 1 to len(camposFinal)
cp:= camposFinal[ct][1]
tipo:= camposFinal[ct][2]
resultado:= .F.
for ct2:= 1 to len(campos)
if (cp==campos[ct2][1])
if (TIPO==campos[ct2][2])
resultado := .T.
EXIT
endif
endif
next
if (resultado==.f.)
exit
endif
next
if (resultado==.f.)
msgstop("Ocorreu um erro grave!!!" + QUEBRA +;
"O ARQUIVO [ORDEM.TXT] não contém todos os campos da tabela!!! " + QUEBRA +;
"Você deve somente reordenar os campos, nunca excluí-los!!!" + QUEBRA +;
"Apague o arquivo [ORDEM.TXT] e reinicie o sistema para corrigir este erro!!!" + QUEBRA;
,"ERRO")
delete file FORMULARIOS\ORDEM.TXT
delete file ORDEM.TXT
clear all
main.release
endif
return camposFinal
// ======================================================================================
// CRIANDO ARQUIVOS DE CONDIGURACAO DO PROJETO
FUNCTION configuracao()
local conteudo:=""
// copiando arquivos de configuracoes:
// copy file Projeto.hbc to formularios\Projeto.hbc
// copy file Projeto.rc to formularios\Projeto.rc
// copy file Projeto.hbp to formularios\Projeto.hbp
conteudo := "inc=yes" + QUEBRA + "head=native" + QUEBRA + "mt=yes"
gravarArquivo("Projeto.hbc",conteudo)
conteudo:= ""
gravarArquivo("Projeto.rc",conteudo)
conteudo := "main.prg"
gravarArquivo("Projeto.hbp",conteudo)
return
26 Ago 2013 02:01
Ops.. Não pensei...yugi386 escreveu:Para criar os formulários dos seus arquivos DBF não utilize esta pasta.
Certinho. Funcionou corretamente.yugi386 escreveu:substitua a linha 101 do arquivo Main.prg por esta:
16 Set 2013 16:03
call ..\..\..\batch\compile.bat main %1 %2 %3 %4 %5 %6 %7 %8 %9
16 Set 2013 19:45
16 Set 2013 21:41