Dbu com minigui
Enviado: 06 Fev 2008 14:54
Código: Selecionar todos
#include "minigui.ch"
#include "common.ch"
#include "dbu.ch"
FUNCTION Main()
SET CONFIRM ON
SET DATE BRITISH
SET CENTURY ON
SET DELETED ON
SET EXCLUSIVE OFF
SET SCOREBOARD OFF
SET DECIMALS TO 8
SET WRAP ON
SET LANGUAGE TO PORTUGUESE
SET TOOLTIPSTYLE BALLOON
ShowDBF()
RETURN .T.
FUNCTION ShowDBF()
LOCAL aDbf
LOCAL aNtx
STATIC aOriginal := {}
STATIC cPath
cPath := if( file(CurDrive()+":\"+Curdir()+"\BASE\*.*"),CurDrive()+":\"+Curdir()+"\BASE\" , CurDrive()+":\"+Curdir()+"\")
aDBF := Directory( cPath+"*.DBF" )
aNtx := Directory( cPath+"*.NTX" )
aEval( aDbf, {|x| x[1] := StrTran( Upper(x[1]), ".DBF", "") } )
DEFINE WINDOW Show_DBF ;
AT 0,0 ;
WIDTH 526 HEIGHT 540 ;
TITLE 'Arquivos DBF: '+NtoC(Len(aDbf))+" - Arquivos de Indice: "+NtoC(Len(aNtx));
NOMAXIMIZE ;
MAIN ;
ICON 'CONFIG' ;
NOSIZE
DEFINE STATUSBAR
STATUSITEM '<DELETE> Eliminar Arquivo' WIDTH 160
STATUSITEM '<ENTER> Editar' WIDTH 160
END STATUSBAR
ON KEY DELETE ACTION Deletar_Arquivos()
ON KEY F2 ACTION Renomear_Arquivos()
@ 005,005 LABEL Lbl_Path ;
WIDTH 80 HEIGHT 20 ;
VALUE 'Caminho' ;
FONT 'Verdana' SIZE 10 BOLD
@ 025,005 TEXTBOX Text_Path ;
WIDTH 374 HEIGHT 20 ;
VALUE cPath ;
READONLY ;
TOOLTIP 'Caminho de Pesquisa das Bases de Dados'
@ 025,387 BUTTON Btn_Path ;
CAPTION '...' ;
WIDTH 20 HEIGHT 23 ;
ACTION Mudar_Path() ;
TOOLTIP 'Selecionar Caminho' ;
FONT "MS Sans Serif" SIZE 09 BOLD
// Grid dos Arquivos DBF...
@ 050,000 GRID Grid_DBFs ; // Funcionando!!!
WIDTH 410 ;
HEIGHT 160 ;
HEADERS {'Arquivo','Tamanho','Data', 'Hora', 'Atr.'};
WIDTHS { 118, 75, 80, 70, 40 } ;
COLUMNCONTROLS { ;
{'TEXTBOX'} , ;
{'TEXTBOX','NUMERIC', '99,999,999'} , ;
{'DATEPICKER'} , ;
{'TEXTBOX'} , ;
{'TEXTBOX'} ;
} ;
JUSTIFY { BROWSE_JTFY_LEFT,BROWSE_JTFY_RIGHT, BROWSE_JTFY_CENTER, BROWSE_JTFY_CENTER, BROWSE_JTFY_CENTER } ;
FONT "Arial" SIZE 09 ;
ITEMS aDBF ;
ON CHANGE {|| Mostra_Indices(), Mostra_Relatorios(), Mostra_Telas() };
ON DBLCLICK Editar_Arquivo() ;
TOOLTIP 'Duplo clique para Editar o Arquivo'
Show_DBF.Grid_DBFs.SetFocus()
@ 225,000 GRID Grid_Indices ; // Funcionando!!!
WIDTH 515 ;
HEIGHT 108 ;
HEADERS {"Arquivo","Chave de Índice","Condição"};
WIDTHS {100,200,200} ;
FONT "Arial" SIZE 09 ;
ON DBLCLICK Editar_Indice(.T.) ;
TOOLTIP 'Duplo clique para Editar o Índice'
// Este grid vai mostrar os arquivos .RPTs relacionados com o DBF...
// Abaixo mais explicações sobre esse tipo de arquivo.
@ 330,000 GRID Grid_Relatorios ; // Funcionando!!!
WIDTH 515 ;
HEIGHT 070 ;
HEADERS {"Relatórios"} ;
WIDTHS {500} ;
FONT "Arial" SIZE 09 ;
ON DBLCLICK Criar_Relatorio(.F.) ;
TOOLTIP 'Duplo clique para Editar o Relatório'
// Este grid vai mostrar os arquivos .FMGs relacionados com o DBF...
// Abaixo mais explicações sobre esse tipo de arquivo.
@ 405,000 GRID Grid_Telas ; // Funcionando!!!
WIDTH 515 ;
HEIGHT 070 ;
HEADERS {"Telas"};
WIDTHS {500} ;
FONT "Arial" SIZE 09 ;
ON DBLCLICK Criar_Tela(.F.) ;
TOOLTIP 'Duplo clique para Editar a Tela'
// Botões que aparecem no lado direito do Grip Show_DBF
@ 000,416 BUTTON Btn_NovoDBF ; // Funcionando!!!
CAPTION 'Novo &Arquivo' ;
WIDTH 100 HEIGHT 23 ;
ACTION Mod_Estrutura( .T. ) ;
TOOLTIP 'Criar Novo Arquivo DBF' ;
FONT "MS Sans Serif" SIZE 09
@ 025,416 BUTTON Btn_NovoIndice ; // Funcionando!!!
CAPTION 'Novo &Indice' ;
WIDTH 100 HEIGHT 23 ;
ACTION Editar_Indice(.F.) ;
TOOLTIP 'Criar Novo Arquivo de Índice' ;
FONT "MS Sans Serif" SIZE 09
@ 050,416 BUTTON Btn_EditarDBF ; // Funcionando!!!
CAPTION '&Editar' ;
WIDTH 100 HEIGHT 23 ;
ACTION Editar_Arquivo() ;
TOOLTIP 'Editar o Arquivo Selecionado' ;
FONT "MS Sans Serif" SIZE 09
// Ok, pronto... Já tem a função genérica...
// Aqui vai ser feita uma funcao generica para implementar os arquivos RPTs.
// Estes arquivos sao baseados em um arquivo texto com todas as definicoes.
// Nome do relatorio, campos, mascaras, totalizacao, etc... Muito bom mesmo...
@ 075,416 BUTTON Btn_Relatorio ; // Funcionando!!!
CAPTION '&Relatório' ;
WIDTH 100 HEIGHT 23 ;
ACTION Criar_Relatorio(.T.) ;
TOOLTIP 'Criar um Template de Relatório' ;
FONT "MS Sans Serif" SIZE 09
@ 100,416 BUTTON Btn_Tela ; // Funcionando!!!
CAPTION '&Tela' ;
WIDTH 100 HEIGHT 23 ;
ACTION Criar_Tela(.T.) ;
TOOLTIP 'Criar Template de Tela para a Base de Dados' ;
FONT "MS Sans Serif" SIZE 09
@ 125,416 BUTTON Btn_ListarEstrutura; // Funcionando!!!
CAPTION '&Listar Estrutura' ;
WIDTH 100 HEIGHT 23 ;
ACTION ListaEstrutura() ;
TOOLTIP 'Listar a Estrutura do DBF' ;
FONT "MS Sans Serif" SIZE 09
@ 150,416 BUTTON Btn_Mod_Estrutura ; // Estou trabalhando nisso...
CAPTION '&Modificar Estrutura' ;
WIDTH 100 HEIGHT 23 ;
ACTION Mod_Estrutura( .F. ) ;
TOOLTIP 'Modificar a Estrutura do DBF' ;
FONT "MS Sans Serif" SIZE 09
@ 175,416 BUTTON Btn_Pack ; // Funcionando!!!
CAPTION '&Compactar' ;
WIDTH 100 HEIGHT 23 ;
ACTION Pack_DBF() ;
TOOLTIP 'Compactar (PACK) a Base de Dados' ;
FONT "MS Sans Serif" SIZE 09
@ 200,416 BUTTON Btn_Zap ; // Funcionando!!!
CAPTION '&ZAP' ;
WIDTH 100 HEIGHT 23 ;
ACTION Zap_DBF() ;
TOOLTIP 'Eliminar (ZAP) os Registros da Base de Dados' ;
FONT "MS Sans Serif" SIZE 09
MODIFY Grid_DBFs OF Show_DBF VALUE 1
//Show_Dbf.Grid_DBFs.SetFocus()
END WINDOW
CENTER WINDOW Show_DBF
ACTIVATE WINDOW Show_DBF
RETURN NIL
/*
Mostra os Indices do arquivo DBF selecionado...
*/
FUNCTION Mostra_Indices()
LOCAL cDBF := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )
LOCAL nI := 0, nArea := dbSelectArea()
LOCAL lOpened := Select( cDBF ) > 0
DELETE ITEM ALL FROM Grid_Indices OF Show_DBF
IF ! Empty( cDBF )
IF ! lOpened
AbreArquivos( cDBF, Show_DBF.Text_Path.Value )
ENDIF
DO WHILE ! Empty( (cDBF)->( IndexKey( ++nI ) ) )
ADD ITEM { cDBF+NtoC(nI), (cDBF)->(IndexKey(nI)), (cDBF)->(OrdFor(nI)) } TO Grid_Indices OF Show_DBF
ENDDO
IF ! lOpened
FechaArquivos(cDBF)
ENDIF
dbSelectArea( nArea )
ENDIF
RETURN NIL
/*
O Minigui tem um negócio interessante que é o .RPT.
É um arquivo que contém as definições de um relatório.
Muito interessante. Vou tentar fazer uma rotina genérica só para começar a impressão.
Depois pode-se modificar o arquivo gerado, copiá-lo e dar uma ajeitada.
É só um ponto de partida, e um começo para se entender esse tipo de relatório/arquivo.
*/
FUNCTION Mostra_Relatorios()
LOCAL cDBF := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )
LOCAL nI
LOCAL aRpt := Directory( Show_Dbf.Text_Path.Value+"..\RPT\"+cDBF+"*.RPT" )
DELETE ITEM ALL FROM Grid_Relatorios OF Show_DBF
IF ! Empty( cDBF )
FOR nI := 1 TO Len(aRpt)
ADD ITEM { StrTran( aRpt[nI][1], ".RPT", "" ) } TO Grid_Relatorios OF Show_DBF
NEXT nI
ENDIF
RETURN NIL
FUNCTION Mostra_Telas()
LOCAL cDBF := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )
LOCAL nI
LOCAL aFMG := Directory( Show_Dbf.Text_Path.Value+"..\FMG\"+cDBF+"*.FMG" )
DELETE ITEM ALL FROM Grid_Telas OF Show_DBF
IF ! Empty( cDBF )
FOR nI := 1 TO Len(aFMG)
ADD ITEM { StrTran( aFMG[nI][1], ".FMG", "" ) } TO Grid_Telas OF Show_DBF
NEXT nI
ENDIF
RETURN NIL
// Lista a estrutura do arquivo e mostra na tela...
FUNCTION ListaEstrutura()
LOCAL cDbf := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )
LOCAL nArea := dbSelectArea(), nI, nL
LOCAL lOpened
IF Empty( cDBF )
MsgExclamation('Selecione o caminho (path) e o arquivo', 'Listar Estrutura')
RETURN .F.
ENDIF
IF MsgYesNo( "Confirma a Listagem da Estrutura do Arquivo " + cDBF );
.AND. ( ( lOpened := Select(cDBF) > 0 ) .OR. AbreArquivos(cDBF, Show_DBF.Text_Path.Value) )
/*
aTmp := (cDBF)->( dbStruct(cDBF) )
aTmp2 := {}
aEval( aTmp, {|x| aAdd( aTmp2, PadR( x[1], 10 ) + " | " + x[2] + " | " +;
str( x[3], 7 ) + " | " + str( x[4], 7 ) ) } )
INIT PRINTSYS
SELECT DEFAULT PREVIEW
SET UNITS MM
DEFINE FONT "F0" NAME "Courier New" SIZE 24
START DOC
START PAGE
@ 5, 10 SAY "+------------------------------------+"
@ 10, 10 SAY "| " + PadC( cDbf + ".DBF", 35 ) + "|"
@ 15, 10 SAY "+-----------+-----+---------+--------+"
@ 20, 10 SAY "| CAMPO |TIPO | TAM. | DEC. |"
@ 25, 10 SAY "+-----------+-----+---------+--------+"
nL := 30
FOR nI := 1 TO Len( aTmp2 )
@ nL, 10 SAY "|" + x + "|"
nL += 5
NEXT nI
@ nL+5, 10 SAY "+-----------+-----+---------+--------+"
END PAGE
END DOC
RELEASE PRINTSYS
IF ! lOpened
FechaArquivos(cDBF)
ENDIF
dbSelectArea( nArea )
*/
aTmp := (cDBF)->( dbStruct(cDBF) )
aTmp2 := {}
aEval( aTmp, {|x| aAdd( aTmp2, PadR( x[1], 10 ) + " | " + x[2] + " | " +;
str( x[3], 7 ) + " | " + str( x[4], 7 ) ) } )
Show_DBF.Btn_ListarEstrutura.Enabled := .F.
PRIVATE nFont := 11
PRIVATE cArquivo := ""
// Estas duas variaveis tem que ser PRIVATE para que a funcao de zoom funcione...
// Direciona a saída para o arquivo LST do DBF...
SetaImpressora(.T., cDBF+".LST")
?? "+------------------------------------+"
? "| " + PadC( cDbf + ".DBF", 35 ) + "|"
? "+-----------+-----+---------+--------+"
? "| CAMPO |TIPO | TAM. | DEC. |"
? "+-----------+-----+---------+--------+"
aEval( aTmp2, {|x| qout( "|" + x + "|" )} )
? "+-----------+-----+---------+--------+"
?
// Volta a saida para a tela...
SetaImpressora( .F. )
IF ! lOpened
FechaArquivos(cDBF)
ENDIF
dbSelectArea( nArea )
// Agora vai mostrar na tela...
cArquivo := MemoRead(cDBF+".LST")
DEFINE WINDOW LstEstrutura ;
AT 0,0 ;
WIDTH 445 ;
HEIGHT 500 ;
TITLE "Estrutura do Arquivo: "+cDBF+".DBF";
ICON 'CONFIG' ;
CHILD ;
NOSIZE ;
ON RELEASE Show_DBF.Btn_ListarEstrutura.Enabled := .T. ;
BACKCOLOR WHITE
@ 30,01 EDITBOX Edit_1 ;
WIDTH 460 ;
HEIGHT 510 ;
VALUE cArquivo ;
TOOLTIP "Estrutura do Arquivo "+cDBF+".DBF" ;
MAXLENGTH 255
@ 001,075 BUTTON Bt_Zoom_Mais ;
PICTURE 'ZOOMMAIS' ;
ACTION ZoomLabel(1) ;
WIDTH 40 HEIGHT 27 ;
TOOLTIP 'Aumentar Zoom'
@ 001,188 BUTTON Bt_Zoom_Menos ;
PICTURE 'ZOOMMENOS' ;
ACTION ZoomLabel(2) ;
WIDTH 40 HEIGHT 27 ;
TOOLTIP 'Diminuir Zoom'
@ 001,310 BUTTON Sair_1 ;
PICTURE 'SAIR' ;
ACTION {|| LstEstrutura.Release, Show_DBF.SetFocus} ;
WIDTH 40 HEIGHT 27 ;
TOOLTIP 'Fechar'
END WINDOW
MODIFY CONTROL Edit_1 OF LstEstrutura FONTSIZE nFont
CENTER WINDOW LstEstrutura
ACTIVATE WINDOW LstEstrutura
ENDIF
RETURN NIL
FUNCTION Editar_Arquivo()
LOCAL cDbf := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )
LOCAL nI
LOCAL lOpened
LOCAL aStruct, aHeaders := {}, aWidths := {}
IF Empty( cDBF )
MsgExclamation('Selecione o caminho (path) e o arquivo', 'Editar Arquivo')
RETURN .F.
ENDIF
IF !( lOpened := Select( cDBF ) > 0 )
AbreArquivos( cDBF, Show_DBF.Text_Path.Value )
ENDIF
DISABLE CONTROL Btn_EditarDBF OF Show_DBF
aStruct := (cDBF)->( dbStruct(cDBF) )
FOR nI := 1 TO Len(aStruct)
aAdd( aHeaders, aStruct[nI][1])
aAdd( aWidths, Min(Max((aStruct[nI][3]+aStruct[nI][4]), Len(aStruct[nI][1]) ),50)*11)
NEXT nI
DEFINE WINDOW Browse ;
AT 0,0 ;
WIDTH 640 HEIGHT 480 ;
TITLE 'Editar Arquivo '+cDBF;
ICON 'CONFIG' ;
CHILD NOMAXIMIZE ;
ON RELEASE if( lOpened, FechaArquivos( cDBF ), NIL )
DEFINE STATUSBAR
STATUSITEM '<Enter>/Clique Duplo Editar' WIDTH 160
STATUSITEM '<Alt>+A Adicionar Registro' WIDTH 160
STATUSITEM '<Del> Deletar Registro' WIDTH 160
END STATUSBAR
DEFINE BROWSE Browse_1
ROW 10
COL 10
WIDTH 610
HEIGHT 390
HEADERS aHeaders
WIDTHS aWidths
WORKAREA &(cDBF)
FIELDS aHeaders
VALUE 1
ALLOWEDIT .T.
ONHEADCLICK { {|| SetaOrdem(cDBF, 1)}, {|| SetaOrdem(cDBF, 2)}, {|| SetaOrdem( cDBF, 3 )}, {|| SetaOrdem( cDBF, 4 )}, {|| SetaOrdem( cDBF, 5 )}, {|| SetaOrdem( cDBF, 6 )}}
ALLOWAPPEND .T.
LOCK .T.
ALLOWDELETE .T.
END BROWSE
END WINDOW
CENTER WINDOW Browse
Browse.Browse_1.SetFocus
ACTIVATE WINDOW Browse
ENABLE CONTROL Btn_EditarDBF OF Show_DBF
RETURN .T.
FUNCTION SetaOrdem( cDBF, cOrdem )
LOCAL nOrder := (cDBF)->( IndexOrd() )
LOCAL nI := 0
LOCAL lAchou := .F.
cOrdem := Browse.Browse_1.Header(cOrdem)
DO WHILE ! Empty( (cDBF)->(IndexKey(++nI)) )
// Falta verificar se o campo é data, se for tem que colocar o DTOS() na frente...
IF Left( (cDBF)->(IndexKey(nI)), Len( cOrdem ) ) == cOrdem .OR. Left( (cDBF)->(IndexKey(nI)), Len( cOrdem )+5 ) == "DTOS("+cOrdem
(cDBF)->( dbSetOrder( nI ) )
lAchou := .T.
EXIT
ENDIF
ENDDO
IF ! lAchou
(cDBF)->( dbSetOrder( nOrder ) )
ENDIF
Browse.Browse_1.Refresh()
RETURN .T.
FUNCTION Mod_Estrutura( lNew )
LOCAL nI
PRIVATE cDbf := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )
PRIVATE nRecords
PRIVATE lOpened := .F.
PRIVATE aStruct, aRows := {}
PRIVATE lNovo := lNew
IF Empty( cDBF )
MsgExclamation('Selecione o caminho (path) e o arquivo', 'Modificar Estrutura')
RETURN .F.
ENDIF
DISABLE CONTROL Btn_Mod_Estrutura OF Show_DBF
DISABLE CONTROL Btn_NovoDBF OF Show_DBF
IF ! lNew .AND. !( lOpened := Select( cDBF ) > 0 )
// Se nao é um novo arquivo e ele está fechado, abre..
AbreArquivos( cDBF, Show_DBf.Text_Path.Value )
ENDIF
IF ! lNew
nRecords := (cDBF)->( LastRec() )
// Pega a estrutura do arquivo que vai ser modificado...
aStruct := (cDBF)->( dbStruct(cDBF) )
// Faz uma copia para guardar as modificacoes...
// O primeiro array guarda o original, o segundo guarda as modificacoes...
aOriginal := { {}, {} }
FOR nI := 1 TO Len(aStruct)
// Vamos ver se funciona assim...
// Vou guardar os valores do campo original...
aAdd( aRows, { aStruct[nI][1], aStruct[nI][2], aStruct[nI][3], aStruct[nI][4] } )
// Bom, nao sei porque nao conseguiu funcionar com o aClone, mas vamos ver como vai ficar...
aAdd( aOriginal[1], { aStruct[nI][1], aStruct[nI][2], aStruct[nI][3], aStruct[nI][4] } )
aAdd( aOriginal[2], { aStruct[nI][1], aStruct[nI][2], aStruct[nI][3], aStruct[nI][4] } )
NEXT nI
ELSE
aStruct := {}
nRecords := 0
ENDIF
// Carrega o Window Template da Estrutura (.\FMG\FMOD_STRU.FMG)
IF !IsWindowDefined(Mod_Struct)
LOAD WINDOW FMOD_STRU AS Mod_Struct
ENDIF
CENTER WINDOW Mod_Struct
Mod_Struct.Mod_Grid.SetFocus
ACTIVATE WINDOW Mod_Struct
ENABLE CONTROL Btn_Mod_Estrutura OF Show_DBF
ENABLE CONTROL Btn_NovoDBF OF Show_DBF
RETURN .T.
FUNCTION CriarDBF( lNovo )
LOCAL cField, cTipo, cTime := Time(), cChave, cCond
LOCAL nTam, nDec, nI, nScan
LOCAL cAntigo := '', cNewDBF := TmpFile("A"), cMsg := "", cContent
LOCAL nCampos := Mod_Struct.Mod_Grid.ItemCount
LOCAL lFirst
LOCAL aStruct := {}, aItemGrid, aNtx, aIndices
IF lNovo
IF Empty( Mod_Struct.Text_Arquivo.Value )
PlayExclamation()
MsgInfo('Informe o Nome do Arquivo a ser Criado!', 'Criar DBF' )
Mod_Struct.Text_Arquivo.SetFocus()
ELSEIF nCampos == 0
PlayExclamation()
MsgInfo('Adicione os Campos Primeiro', 'Criar DBF' )
Mod_Struct.Text_Campo.SetFocus()
ELSE
// Vai criar um novo mesmo, é mais fácil...
//aEval( aCampos, {|x| cMsg += x[1]+" - "+x[2]+QUEBRA } )
FOR nI := 1 TO nCampos
aItemGrid := Mod_Struct.Mod_Grid.Item(nI)
cField := aItemGrid[1]
cTipo := aItemGrid[2]
nTam := aItemGrid[3]
nDec := aItemGrid[4]
aAdd(aStruct, { cField, cTipo, nTam, nDec } )
NEXT nI
// Cria efetivamente o DBF...
cDBF := Mod_Struct.Text_Arquivo.Value
dbCreate(Show_Dbf.Text_Path.Value+cDBF, aStruct)
IF File( Show_Dbf.Text_Path.Value+cDBF+'.DBF')
MsgInfo('Arquivo '+cDBF+' criado com sucesso!')
ELSE
PlayExclamation()
MsgInfo('Ocorreu um erro ao tentar criar o Arquivo '+cDBF)
ENDIF
Show_Dbf.Grid_Dbfs.Refresh()
ENDIF
ELSE
// Vai modificar a estrutura... é mais complicado...
// Cria o DBF antigo...
cAntigo := TmpFile('A')
dbCreate(Show_Dbf.Text_Path.Value+cAntigo, aOriginal[1])
AbreArquivos( Lower( cAntigo ), Show_Dbf.Text_Path.Value )
// Vai guardar as chaves de indice para fazer mudancas nos campos chaves...
aIndices := {}
nI := 0
DO WHILE ! Empty( (cDBF)->( IndexKey(++nI) ) )
aAdd( aIndices, { (cDBF)->( IndexKey(nI) ), (cDBF)->( OrdFor(nI) ) } )
ENDDO
(cDBF)->( dbGoTop() )
DO WHILE ! (cDBF)->( Eof() )
// Copia o arquivo original para o temporario...
(cAntigo)->(AddRec())
FOR nI := 1 TO (cDBF)->( fCount() )
(cAntigo)->( FieldPut( nI, (cDBF)->( FieldGet(nI) ) ) )
NEXT nI
(cDBF)->( dbSkip() )
ENDDO
// Verifica os campos do arquivo modificado...
aStruct := {}
FOR nI := 1 TO nCampos
aItemGrid := Mod_Struct.Mod_Grid.Item(nI)
cField := aItemGrid[1]
cTipo := aItemGrid[2]
nTam := aItemGrid[3]
nDec := aItemGrid[4]
aAdd( aStruct, { cField, cTipo, nTam, nDec } )
NEXT nI
// Fecha o arquivo para poder criar...
FechaArquivos(cDBF)
// Cria o arquivo já com as modificacoes...
dbCreate( Show_Dbf.Text_Path.Value+cDBF, aStruct)
// Abre o arquivo e retira os indices porque se fizer mudança no campo que é chave vai dar erro...
// Esta faltando apenas guardar as chaves de indice e fazer as modificacoes...
aNtx := Directory(Show_Dbf.Text_Path.Value+cDBF+'*.NTX')
FOR nI := 1 TO Len( aNtx )
DELETE FILE ( Show_Dbf.Text_Path.Value+aNtx[nI][1] )
NEXT nI
AbreArquivos( Lower( cDBF ), Show_DBf.Text_Path.Value )
(cAntigo)->( dbGoTop() )
DO WHILE ! (cAntigo)->( Eof() )
lFirst := .T.
FOR nI := 1 TO (cDBF)->( fCount() )
IF (nScan := aScan( aOriginal[2], {|x| x[1] == (cAntigo)->( FieldName(nI) ) } ) ) > 0
cContent := (cAntigo)->( FieldGet( FieldPos( aOriginal[2][nI][1] ) ) )
ELSEIF (nScan := aScan( aOriginal[1], {|x| x[1] == (cAntigo)->( FieldName(nI) ) } ) ) > 0
cContent := (cAntigo)->( FieldGet( FieldPos( aOriginal[1][nI][1] ) ) )
ENDIF
IF nScan > 0
// Se não for um campo novo, tem que pegar o conteudo...
IF lFirst
lFirst := .F.
(cDBF)->( AddRec() )
ENDIF
cTipo := ValType( (cDBF)->( FieldGet(nI) ) )
IF cTipo == "C"
cContent := AnyToChar( cContent )
ELSEIF cTipo == "N"
cContent := AnyToNum( cContent )
ELSEIF cTipo == "L"
cContent := AnyToLogical( cContent )
ELSEIF cTipo == "D"
cContent := AnyToDate( cContent )
ENDIF
(cDBF)->( FieldPut( nI, cContent ) )
ENDIF
NEXT nI
(cAntigo)->( dbSkip() )
ENDDO
// Vai recriar os indices agora...
FOR nI := 1 TO Len( aIndices )
IF (nScan := aScan( aOriginal[1], {|x| x[1] $ aIndices[nI][1] } ) ) > 0
cChave := StrTran( aIndices[nI][1], aOriginal[1][nScan][1], aOriginal[2][nScan][1] )
cCond := StrTran( aIndices[nI][2], aOriginal[1][nScan][1], aOriginal[2][nScan][1] )
ELSE
cChave := aIndices[nI][1]
cCond := aIndices[nI][2]
ENDIF
IF Empty( cCond )
(cDBF)->(dbCreateIndex( Show_Dbf.Text_Path.Value + cDBF+AllTrim(Str(nI))+'.NTX', cChave, {|| &cChave } ))
ELSEIF ! Empty( cCond ) .AND. ! Empty( cChave )
(cDBF)->(ordCondSet( cCond, {|| &cCond },,,,, RECNO(),,,, ))
(cDBF)->(ordCreate( Show_Dbf.Text_Path.Value+cDBF+AllTrim(Str(nI))+'.NTX',, cChave, {|| &cChave }, ))
ENDIF
NEXT nI
// Deleta o arquivo antigo...
DELETE FILE ( Show_Dbf.Text_Path.Value+cAntigo+'.DBF' )
ENDIF
// Libera a tela de criacao/modificacao de dbfs
Mod_Struct.Release
// Recria o grid dbf...
Mostrar_Arquivos()
RETURN .T.
// Esta funcao é chamada quando se clica duas vezes em um campo no Grid Mod_Struct...
FUNCTION Mostra_Campos()
LOCAL cField := PegaValorDaColuna( "Mod_Grid" , "Mod_Struct" , 1 )
LOCAL cTipo := PegaValorDaColuna( "Mod_Grid" , "Mod_Struct" , 2 )
LOCAL nTam := PegaValorDaColuna( "Mod_Grid" , "Mod_Struct" , 3 )
LOCAL nDec := PegaValorDaColuna( "Mod_Grid" , "Mod_Struct" , 4 )
LOCAL aTipo := {'C', 'N', 'L', 'D', 'M'}
// Tem que ficar trocando o botão que vai ficar visivel...
Mod_Struct.Btn_AdicionaCampo.Visible := .F.
Mod_Struct.Btn_ModificaCampo.Visible := .T.
Mod_Struct.Text_Campo.Value := cField
Mod_Struct.Combo_Tipo.Value := aScan( aTipo, {|x| x == cTipo } )
Mod_Struct.Text_Tamanho.Value := Str(nTam)
Mod_Struct.Text_Decimal.Value := Str(nDec)
RETURN .T.
// Esta funcao guarda o campo original e o novo nome do campo para quando for efetuar a modificacao na estrutura...
FUNCTION Modificar_Campo()
LOCAL nScan, nItem := Mod_Struct.Mod_Grid.Value
LOCAL cField := Mod_Struct.Text_Campo.Value
LOCAL cTipo := Mod_Struct.Combo_Tipo.DisplayValue
LOCAL nTam := if(cTipo == "D", "8", if(cTipo == "L", "1", Mod_Struct.Text_Tamanho.Value))
LOCAL nDec := if(cTipo == "N", Mod_Struct.Text_Decimal.Value, "0")
// Tem que ficar trocando o botão que vai ficar visivel...
Mod_Struct.Btn_AdicionaCampo.Visible := .T.
Mod_Struct.Btn_ModificaCampo.Visible := .F.
// É, agora está tudo funcionando... Só tem que guardar o valor no array aOriginal...
IF ( nScan := aScan( aOriginal[2], {|x| x[1] == Mod_Struct.Mod_Grid.Item(nItem)[1] } ) ) > 0
// Guarda o valor original no array aOriginal...
aOriginal[2][nScan][1] := cField
aOriginal[2][nScan][2] := cTipo
aOriginal[2][nScan][3] := Val(nTam)
aOriginal[2][nScan][4] := Val(nDec)
Mod_Struct.Mod_Grid.Item(nItem) := { cField, cTipo, nTam, nDec }
ELSE
MsgInfo('Problemas na Alteração da Estrutura! Campo: '+Mod_Struct.Mod_Grid.Item(nItem)[1], 'Modificar Campo')
ENDIF
Mod_Struct.Text_Campo.Value := ''
Mod_Struct.Text_Tamanho.Value := '0'
Mod_Struct.Text_Decimal.Value := '0'
RETURN .T.
//Adiciona campo no array de estrutura...
FUNCTION Adicionar_Campo(lNovo)
LOCAL cField := Mod_Struct.Text_Campo.Value
LOCAL cTipo := Mod_Struct.Combo_Tipo.DisplayValue
LOCAL nTam := if(cTipo == "D", "8", if(cTipo == "L", "1", Mod_Struct.Text_Tamanho.Value))
LOCAL nDec := if(cTipo == "N", Mod_Struct.Text_Decimal.Value, "0")
LOCAL nCampos := Mod_Struct.Mod_Grid.ItemCount, nI
LOCAL aItemGrid
IF Empty( cField )
PlayExclamation()
MsgInfo( 'Informe o Nome do Novo Campo', 'Adicionar Campo' )
Mod_Struct.Text_Campo.SetFocus()
RETURN .F.
ELSEIF Val(nTam) == 0
PlayExclamation()
MsgInfo( 'Informe o Tamanho do Novo Campo', 'Adicionar Campo' )
Mod_Struct.Text_Tamanho.SetFocus()
RETURN .F.
ENDIF
// Tem que fazer a verificação se o campo já existe...
FOR nI := 1 TO nCampos
aItemGrid := Mod_Struct.Mod_Grid.Item(nI)
IF cField == aItemGrid[1]
// Se vai criar um arquivo novo, verifica se já incluiu o campo...
PlayHand()
MsgInfo('Campo '+cField+' Já Está na Estrutura.', 'Adicionar Campo')
RETURN .F.
ENDIF
NEXT nI
ADD ITEM { cField, cTipo, nTam, nDec } TO Mod_Grid OF Mod_Struct
RETURN .T.
//Remove campo do array de estrutura...
FUNCTION Deletar_Campo()
LOCAL nItem := Mod_Struct.Mod_Grid.Value
IF nItem == 0
MsgInfo('Selecione o Campo que deseja Excluir')
ELSEIF MsgYesNo( 'Deseja Eliminar o Campo '+Mod_Struct.Mod_Grid.Item(nItem)[1] )
Mod_Struct.Mod_Grid.DeleteItem(nItem)
Mod_Struct.Btn_ModificaCampo.Visible := .F.
Mod_Struct.Btn_AdicionaCampo.Visible := .T.
ENDIF
RETURN .T.
FUNCTION Deletar_Arquivos()
LOCAL cDBF := AllTrim(PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 ))
LOCAL cMsg := "", cMsgInfo := "", cFile
LOCAL nI, nItem
LOCAL aArqs := {}, aDir
cFocus := Show_DBF.FocusedControl
PlayExclamation()
IF cFocus == "Grid_DBFs"
cMsgInfo := 'Essa operação irá eliminar o Arquivo '+cDBF+', seus Índices, suas Telas e seus Relatórios'
aDir := Directory(Show_DBF.Text_Path.Value+cDBF+'*.DBF') // DBFs
aEval( aDir, {|x| aAdd( aArqs, Show_Dbf.Text_Path.Value+x[1] ) } )
aDir := Directory(Show_DBF.Text_Path.Value+cDBF+'*.NTX') // Indices
aEval( aDir, {|x| aAdd( aArqs, Show_Dbf.Text_Path.Value+x[1] ) } )
aDir := Directory(Show_DBF.Text_Path.Value+'..\FMG\'+cDBF+'*.FMG') // Telas
aEval( aDir, {|x| aAdd( aArqs, Show_Dbf.Text_Path.Value+'..\FMG\'+x[1] ) } )
aDir := Directory(Show_DBF.Text_Path.Value+'..\RPT\'+cDBF+'*.RPT') // Relatorios
aEval( aDir, {|x| aAdd( aArqs, Show_Dbf.Text_Path.Value+'..\RPT\'+x[1] ) } )
aEval(aArqs, {|x| cMsg += x+QUEBRA } )
ELSEIF cFocus == "Grid_Indices"
cFile := AllTrim(PegaValorDaColuna( "Grid_Indices" , "Show_DBF" , 1 ))+".NTX"
cMsgInfo := 'Essa operação irá eliminar o Arquivo '+cFile
cMsg += cFile+QUEBRA
aAdd( aArqs, Show_DBF.Text_Path.Value+cFile)
ELSEIF cFocus == "Grid_Relatorios"
cFile := AllTrim(PegaValorDaColuna( "Grid_Relatorios" , "Show_DBF" , 1 ))+".RPT"
cMsgInfo := 'Essa operação irá eliminar o Arquivo '+cFile
cMsg += cFile+QUEBRA
aAdd( aArqs, Show_DBF.Text_Path.Value+"..\RPT\"+cFile)
ELSEIF cFocus == "Grid_Telas"
cFile := AllTrim(PegaValorDaColuna( "Grid_Telas" , "Show_DBF" , 1 ))+".FMG"
cMsgInfo := 'Essa operação irá eliminar o Arquivo '+cFile
cMsg += cFile+QUEBRA
aAdd( aArqs, Show_DBF.Text_Path.Value+"..\FMG\"+cFile)
ELSE
MsgInfo('Impossível determinar qual arquivo a eliminar. Clique no Arquivo desejado.', SISTEMA)
RETURN .F.
ENDIF
IF MsgYesNo(cMsgInfo+" !!!"+QUEBRA+' Você tem certeza que quer continuar?', 'Deletar Arquivos') .AND. MsgYesNo('Essa operação não pode ser desfeita. Você tem certeza?', 'Deletar Arquivos')
FOR nI := 1 TO Len( aArqs )
DELETE FILE ( aArqs[nI] )
NEXT nI
//Tira o arquivo eliminado do Grid DBFs...
//nItem := Show_DBF.DBFs.Value
//DELETE ITEM nItem FROM DBFs OF Show_DBF
MsgInfo('Arquivos Eliminados: '+QUEBRA+QUEBRA+cMsg, 'Deletar Arquivos')
// Recria os itens do grid_dbf...
Mostrar_Arquivos()
ENDIF
RETURN .T.
FUNCTION Renomear_Arquivos()
LOCAL cDBF := AllTrim(PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )), cMsg := ""
cNovoArquivo := InputBox('Informe o Novo Nome', 'Renomear Arquivo', cDBF)
MsgInfo('Renomear Arquivo '+cDBF+' Para '+cNovoArquivo)
RETURN .T.
FUNCTION Editar_Indice(lEditar)
LOCAL cDbf := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )
LOCAL cNtx := if( lEditar, PegaValorDaColuna( "Grid_Indices" , "Show_DBF" , 1 ), 'Novo Arquivo de Indice' )
LOCAL nItem := Show_DBF.Grid_Indices.Value, nArea := dbSelectArea()
LOCAL lOpened := Select( cDBF ) > 0
IF Empty( cDBF )
MsgExclamation('Selecione o caminho (path) e o arquivo', 'Editar Indice')
RETURN .F.
ENDIF
IF ! lOpened
AbreArquivos( cDBF, Show_Dbf.Text_Path.Value )
ENDIF
DISABLE CONTROL Btn_NovoIndice OF Show_DBF
DEFINE WINDOW Editar_Indice ;
AT 0,0 ;
WIDTH 640 HEIGHT 150 ;
ICON 'CONFIG' ;
CHILD ;
TITLE 'Arquivo '+cDbf+' - '+if( lEditar, 'Indice ', '')+cNtx
@ 10,010 LABEL Lbl_Chave ;
WIDTH 80 HEIGHT 20 ;
VALUE 'Chave' ;
FONT 'Verdana' SIZE 10 BOLD
@ 10,120 TEXTBOX Chave ;
WIDTH 440 ;
UPPERCASE ;
VALUE (cDbf)->( IndexKey( nItem ) );
FONT 'Verdana' SIZE 10 ;
TOOLTIP 'Informe a Chave de Indice'
@ 40,010 LABEL Lbl_Condicao ;
WIDTH 80 HEIGHT 20 ;
VALUE 'Condicao' ;
FONT 'Verdana' SIZE 10 BOLD
@ 40,120 TEXTBOX Condicao ;
WIDTH 440 ;
UPPERCASE ;
VALUE (cDBF)->( OrdFor( nItem) );
FONT 'Verdana' SIZE 10 ;
TOOLTIP 'Informe a Condicao do Indice'
@ 72,190 BUTTON CriaIndice ;
CAPTION '&Confirmar' ;
WIDTH 100 HEIGHT 37 ;
ACTION {|| CriarIndice(cDBF, lEditar, nItem, lOpened) } ;
FONT "MS Sans Serif" SIZE 10 BOLD
@ 72,380 BUTTON Fechar ;
CAPTION '&Cancelar' ;
WIDTH 100 HEIGHT 37 ;
ACTION {|| if(lOpened, FechaArquivos(cDBF), .T.), Editar_Indice.Release() };
FONT "MS Sans Serif" SIZE 10 BOLD
END WINDOW
Editar_Indice.Center
Editar_Indice.Activate
IF ! lOpened
FechaArquivos( cDBF )
ENDIF
ENABLE CONTROL Btn_NovoIndice OF Show_DBF
Mostra_Indices()
RETURN .T.
STATIC FUNCTION CriarIndice(cDBF, lEditar, nItem, lOpened)
LOCAL aNtx := Directory( Show_Dbf.Text_Path.Value+cDBF+'*.NTX' )
IF ! lOpened
AbreArquivos( cDbf, Show_DBF.Text_Path.Value )
ENDIF
cChave := Editar_Indice.Chave.Value
cCond := Editar_Indice.Condicao.Value
IF ! lEditar
// Se for criar tem que saber quantos indices o arquivo já tem e adicionar um para o proximo...
aNtx := Directory(Show_Dbf.Text_Path.Value+cDBF+"*.NTX")
nItem := Len( aNtx )+1
ENDIF
IF Empty( Editar_Indice.Condicao.Value )
(cDBF)->(dbCreateIndex( Show_Dbf.Text_Path.Value+cDBF+AllTrim(Str(nItem))+'.NTX', cChave, {|| &cChave } ))
ELSEIF ! Empty( cCond ) .AND. ! Empty( cChave )
(cDBF)->(ordCondSet( cCond, {|| &cCond },,,,, RECNO(),,,, ))
(cDBF)->(ordCreate( Show_Dbf.Text_Path.Value+cDBF+AllTrim(Str(nItem))+'.NTX',, cChave, {|| &cChave }, ))
ENDIF
Editar_Indice.Release()
RETURN NIL
// Esta funcao cria um Template de Relatorio...
// Uma habilidade do Minigui que é muito bem-vinda...
FUNCTION Criar_Relatorio(lCriar)
LOCAL cDbf := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 ), cRPT
LOCAL cReport
LOCAL nI, nArea := dbSelectArea()
LOCAL aStruct
LOCAL lOpened
// Arrays que vão guardar as informações de acordo com o tipo de cada campo...
LOCAL cHeaders := "{ ", cFields := "{ ", cWidths := "{ ", cTotals := "{ ", cFormats := "{ "
IF Empty( cDBF )
MsgExclamation('Selecione o caminho (path) e o arquivo', 'Criar Relatorio')
RETURN .F.
ENDIF
DISABLE CONTROL Btn_Relatorio OF Show_DBF
IF lCriar
cReport := cDBF+StrZero( Len( Directory(".\RPT\"+cDBF+"*.RPT") )+1, 1)
IF !( lOpened := Select( cDBF ) > 0 )
AbreArquivos( cDBF, Show_Dbf.Text_Path.Value )
ENDIF
cRPT := "DEFINE REPORT TEMPLATE"+QUEBRA
cRPT += " TITLE " + cDBF+QUEBRA
aStruct := (cDBF)->( dbStruct(cDBF) )
FOR nI := 1 TO Len(aStruct)
cHeaders += "'"+aStruct[nI][1] + "'" + if(nI < Len( aStruct ), ", ", "")
cWidths += AllTrim(Str(aStruct[nI][3]+aStruct[nI][4])) + if(nI < Len( aStruct ), ", ", "")
cTotals += if(aStruct[nI][2] == "N", ".T.", ".F.") + if(nI < Len( aStruct ), ", ", "")
cFormats += if(aStruct[nI][2] == "N", "999,999,999.99", "") + if(nI < Len( aStruct ), ", ", "")
NEXT nI
cHeaders += " }"
cFields += " }"
cWidths += " }"
cTotals += " }"
cFormats += " }"
cRPT += " HEADERS "+cHeaders+","+cHeaders+QUEBRA
cRPT += " FIELDS "+cHeaders+QUEBRA
cRPT += " WIDTHS "+cWidths+QUEBRA
cRPT += " TOTALS "+cTotals+QUEBRA
cRPT += " NFORMATS "+cFormats+QUEBRA
cRPT += " WORKAREA "+ cDBF+QUEBRA
cRPT += " LPP 50 "+QUEBRA
cRPT += " CPL 80 "+QUEBRA
cRPT += " LMARGIN 4"+QUEBRA
cRPT += " PAPERSIZE A4"+QUEBRA
cRPT += " PREVIEW "+QUEBRA
cRPT += " SELECT "+QUEBRA
cRPT += " GROUPED BY "+aStruct[1][1]+QUEBRA
cRPT += " HEADRGRP "+aStruct[1][1]+":"+QUEBRA
cRPT += "END REPORT"+QUEBRA
IF lOpened
FechaArquivos( cDBF )
ENDIF
ELSE
cReport := PegaValorDaColuna( "Grid_Relatorios" , "Show_DBF" , 1 )
cRpt := MemoRead('.\RPT\'+cReport+'.RPT')
//MsgInfo('Relatorio: '+cRpt)
ENDIF
DEFINE WINDOW Mostra_Relatorio;
AT 0,0 ;
WIDTH 640 HEIGHT 600 ;
ICON 'CONFIG' ;
CHILD ;
TITLE 'Template de Relatório do '+cReport+".RPT"
@20,-1 EDITBOX Report;
WIDTH 460 ;
HEIGHT 510 ;
VALUE cRPT ;
TOOLTIP "Template do Relatório "+cReport+".RPT"
@ 200,500 BUTTON Btn_SalvarRelatorio ;
CAPTION '&Salvar' ;
WIDTH 100 HEIGHT 30 ;
TOOLTIP 'Salvar o Relatorio' ;
ACTION SalvarRelatorio(cReport, cRPT) ;
FONT "MS Sans Serif" BOLD SIZE 09
@ 300,500 BUTTON Btn_SairRelatorio ;
CAPTION '&Sair' ;
WIDTH 100 HEIGHT 30 ;
TOOLTIP 'Fechar Janela' ;
ACTION {|| if( MsgYesNo('Confirma Término das Operações', SISTEMA), Mostra_Relatorio.Release, NIL ) };
FONT "MS Sans Serif" BOLD SIZE 09
END WINDOW
Mostra_Relatorio.Center
Mostra_Relatorio.Activate
ENABLE CONTROL Btn_Relatorio OF Show_DBF
RETURN .T.
// Esta funcao cria um Template de Tela...
// Uma habilidade do Minigui que é muito bem-vinda...
FUNCTION Criar_Tela(lCriar)
LOCAL cDbf := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 ), cFMG
LOCAL cReport, cHeaders, cWidths
LOCAL nI, nArea := dbSelectArea()
LOCAL aStruct
LOCAL lOpened
// Arrays que vão guardar as informações de acordo com o tipo de cada campo...
IF Empty( cDBF )
MsgExclamation('Selecione o caminho (path) e o arquivo', 'Criar Tela')
RETURN .F.
ENDIF
DISABLE CONTROL Btn_Tela OF Show_DBF
IF lCriar
cReport := cDBF+StrZero( Len( Directory(".\FMG\"+cDBF+"*.FMG") )+1, 1)
IF !( lOpened := Select( cDBF ) > 0 )
AbreArquivos( cDBF, Show_DBF.Text_Path.Value )
ENDIF
cFMG := "DEFINE WINDOW TEMPLATE;"+QUEBRA
cFMG += " AT 0, 0 ;"
cFMG += " WIDTH 640, 480;"
cFMG += " TITLE 'Cadastro de "+cDBF+"';"+QUEBRA
cFMG += " ICON 'CADASTRO'"+QUEBRA
cFMG += " ON INIT AbreArquivos( '"+ cDBF+"' );"+QUEBRA
cFMG += " ON RELEASE FechaArquivos( '"+ cDBF+"' );"+QUEBRA
cFMG += " ON INTERACTIVECLOSE MsgYesNo('Deseja Sair do Sistema');"+QUEBRA
cFMG += " FONT ARIAL SIZE 10;"+QUEBRA
cFMG += QUEBRA
cFMG += " DEFINE STATUSBAR FONT 'Arial' SIZE 9;"+QUEBRA
cFMG += " STATUSITEM 'F1 - Ajuda';"+QUEBRA
cFMG += " END STATUSBAR"+QUEBRA
cFMG += QUEBRA
cFMG += " DEFINE TAB TAB_CADASTRO"+QUEBRA
cFMG += " AT 10,10 ;"+QUEBRA
cFMG += " WIDTH 600 ;"+QUEBRA
cFMG += " HEIGHT 400 ;"+QUEBRA
cFMG += " VALUE 1 FONT 'ARIAL' SIZE 10"+QUEBRA
cFMG += QUEBRA
cFMG += " PAGE '&Cadastro'"+QUEBRA+QUEBRA
cFMG += " DEFINE BROWSE Browse_1"+QUEBRA
cFMG += " ROW 10"+QUEBRA
cFMG += " COL 10"+QUEBRA
cFMG += " WIDTH 610"+QUEBRA
cFMG += " HEIGHT 390"+QUEBRA
cHeaders := cWidths := "{"
aStruct := (cDBF)->( dbStruct(cDBF) )
FOR nI := 1 TO Len(aStruct)
cHeaders += "'"+aStruct[nI][1] + "'" + if(nI < Len( aStruct ), ", ", "")
cWidths += Str( Min(Max((aStruct[nI][3]+aStruct[nI][4]), Len(aStruct[nI][1]) ),50)*11 )+ if(nI < Len( aStruct ), ", ", "")
NEXT nI
cHeaders += "}"
cWidths += "}"
cFMG += " HEADERS "+cHeaders+QUEBRA
cFMG += " WIDTHS "+cWidths+QUEBRA
cFMG += " WORKAREA "+cDBF+QUEBRA
cFMG += " FIELDS "+cHeaders+QUEBRA
cFMG += " VALUE 1 "+QUEBRA
cFMG += " ALLOWEDIT .T."
cFMG += " ONHEADCLICK { {|| SetaOrdem(cDBF, 1)}, {|| SetaOrdem(cDBF, 2)}, {|| SetaOrdem( cDBF, 3 )}, {|| SetaOrdem( cDBF, 4 )}, {|| SetaOrdem( cDBF, 5 )}, {|| SetaOrdem( cDBF, 6 )}}"+QUEBRA
cFMG += " ALLOWAPPEND .T."+QUEBRA
cFMG += " LOCK .T."+QUEBRA
cFMG += " ALLOWDELETE .T."+QUEBRA
cFMG += " END BROWSE"+QUEBRA
cFMG += " END PAGE"+QUEBRA+QUEBRA
cFMG += " END TAB"+QUEBRA+QUEBRA
cFMG += "END WINDOW"+QUEBRA
IF lOpened
FechaArquivos( cDBF )
ENDIF
ELSE
cReport := PegaValorDaColuna( "Grid_Telas" , "Show_DBF" , 1 )
cFMG := MemoRead('.\FMG\'+cReport+'.FMG')
//MsgInfo('Tela: '+cFMG)
ENDIF
DEFINE WINDOW Mostra_Tela;
AT 0,0 ;
WIDTH 640 HEIGHT 600 ;
ICON 'CONFIG' ;
CHILD ;
TITLE 'Template de Relatório do '+cReport+".FMG"
@20,-1 EDITBOX Tela;
WIDTH 460 ;
HEIGHT 510 ;
VALUE cFMG ;
TOOLTIP "Template do Relatório "+cReport+".FMG"
@ 200,500 BUTTON Btn_SalvarTela ;
CAPTION '&Salvar' ;
WIDTH 100 HEIGHT 30 ;
TOOLTIP 'Salvar o Tela' ;
ACTION SalvarTela(cReport, cFMG) ;
FONT "MS Sans Serif" BOLD SIZE 09
@ 300,500 BUTTON Btn_SairTela ;
CAPTION '&Sair' ;
WIDTH 100 HEIGHT 30 ;
TOOLTIP 'Fechar Janela' ;
ACTION {|| if( MsgYesNo('Confirma Término das Operações', SISTEMA), Mostra_Tela.Release, NIL ) };
FONT "MS Sans Serif" BOLD SIZE 09
END WINDOW
Mostra_Tela.Center
Mostra_Tela.Activate
ENABLE CONTROL Btn_Tela OF Show_DBF
RETURN .T.
FUNCTION SalvarRelatorio(cReport, cRPT)
LOCAL cFile
IF MsgYesNo( 'Salvar o Relatório Atual', SISTEMA )
// Pelo que eu vi no SOURCE\H_DIALOGS.PRG tem um último parâmetro que é noChangeDir... Vamos ver se funciona...
//cFile := Putfile ( { {'Relatórios','*.RPT'} } , 'Salvar Relatório' , '.\RPT\'+cReport, .T. )
//MemoWrit(cFile+'.RPT', Mostra_Relatorio.Report.Value)
//MsgInfo(cFile)
MemoWrit('..\RPT\'+cReport+'.RPT', Mostra_Relatorio.Report.Value)
Mostra_Relatorios()
Mostra_Relatorio.Release
ENDIF
RETURN .T.
FUNCTION SalvarTela(cTela, cFMG)
LOCAL cFile
IF MsgYesNo( 'Salvar o Template da Tela Atual', SISTEMA )
// Pelo que eu vi no SOURCE\H_DIALOGS.PRG tem um último parâmetro que é noChangeDir... Vamos ver se funciona...
//cFile := Putfile ( { {'Telas','*.FMG'} } , 'Salvar Relatório' , '.\FMG\'+cTela, .T. )
//MsgInfo(cFile)
//MemoWrit(cFile+'.FMG', Mostra_Tela.Report.Value)
MemoWrit('..\FMG\'+cTela+'.FMG', Mostra_Tela.Tela.Value)
Mostra_Telas()
Mostra_Tela.Release
ENDIF
RETURN .T.
FUNCTION Pack_DBF()
LOCAL cDbf := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )
IF Empty( cDBF )
MsgExclamation('Selecione o caminho (path) e o arquivo', 'Pack')
RETURN .F.
ENDIF
IF MsgYesNo( "Confirma a Compactação do Arquivo " + cDbf ) .AND.;
MsgYesNo( "Tem Certeza" )
IF Select(cDbf) > 0
MsgExclamation( "Arquivo " + cDbf + " Já Está em Uso. Não Foi Possível Efetuar a Operação" )
ELSEIF AbreArquivos( lower(cDbf), Show_DBF.Text_Path.Value )
(cDbf)->( __dbPack() )
FechaArquivos(cDbf)
MsgInfo('Arquivo '+cDbf+' foi compactado com sucesso', SISTEMA)
ELSE
MsgExclamation( "Não Foi Possível Abrir o Arquivo " + cDbf )
ENDIF
ENDIF
RETURN .T.
FUNCTION Zap_DBF()
LOCAL cDbf := PegaValorDaColuna( "Grid_DBFs" , "Show_DBF" , 1 )
IF Empty( cDBF )
MsgExclamation('Selecione o caminho (path) e o arquivo', 'Zap')
RETURN .F.
ENDIF
IF MsgYesNo( "Confirma a Remoção de Todos os Registros do Arquivo " + cDbf ) .AND.;
MsgYesNo( "Esta é uma Operação IRREVERSíVEL!!! Tem Certeza" )
IF Select(cDbf) > 0
MsgExclamation( "Arquivo " + cDbf + " Já Está em Uso. Não Foi Possível Efetuar a Operação" )
ELSEIF AbreArquivos( lower(cDbf), Show_DBF.Text_Path.Value )
(cDbf)->( __dbZap() )
FechaArquivos(cDbf)
MsgInfo('Registros do Arquivo '+cDbf+' foram eliminados com sucesso', SISTEMA)
ELSE
MsgExclamation( "Não Foi Possível Abrir o Arquivo " + cDbf )
ENDIF
ENDIF
RETURN .T.
FUNCTION Mostrar_Arquivos()
LOCAL aDbf := Directory( Show_Dbf.Text_Path.Value+"*.DBF" )
LOCAL nI
aEval( aDbf, {|x| x[1] := StrTran( Upper(x[1]), ".DBF", "") } )
DELETE ITEM ALL FROM Grid_DBFs OF Show_DBF
FOR nI := 1 TO Len( aDBF )
ADD ITEM { aDBF[nI][1], aDBF[nI][2], aDBF[nI][3], aDBF[nI][4], aDBF[nI][5] } TO Grid_DBFs OF Show_DBF
NEXT nI
RETURN .T.
FUNCTION PegaValorDaColuna( xObj, xForm, nCol)
LOCAL nPos := GetProperty( xForm , xObj , 'Value' )
LOCAL aRet := GetProperty( xForm , xObj , 'Item' , nPos )
RETURN aRet[nCol]
// Vai aumentando o tamanho da letra e dá a impressão de estar fazendo um zoom...
// Tem que modificar para que seja genérica...
FUNCTION ZoomLabel( nMM )
IF nMM == 1
nFont++
ELSE
nFont--
ENDIF
MODIFY CONTROL Edit_1 OF LstEstrutura FONTSIZE nFont
RETURN NIL
/*
Tenta travar o Registro em uso
*/
FUNCTION RecLock()
LOCAL lLocked
LOCAL nTime
lLocked := .T.
nTime := 0
DO WHILE ! rLock()
IF ++nTime > 50 .AND. ! MsgYesNo( "Registro em Uso. Continuo Tentando" )
lLocked := .F.
EXIT
ELSEIF nTime > 50
nTime := 0
ENDIF
ENDDO
RETURN lLocked
FUNCTION FileLock()
LOCAL lLocked
DO WHILE ! ( lLocked := fLock() )
IF ! MsgYesNo( "Arquivo " + Trim( alias() ) + " em Uso. Continuo Tentando" )
EXIT
ENDIF
ENDDO
RETURN lLocked
// Função para fechar os arquivos dbf´s abertos...
FUNCTION FechaArquivos( cFiles )
LOCAL nI
LOCAL aFile := aSplit( cFiles, " ")
FOR nI := 1 TO Len( aFile )
(aFile[nI])->( dbCloseArea() )
NEXT nI
RETURN .T.
// Abre os arquivos dbf´s desejados...
FUNCTION AbreArquivos( cFiles, cPath )
LOCAL lOk := .T.
LOCAL aFile := aSplit( cFiles, " " )
cPath := if( cPath == NIL, BaseDeDados( __INI ), cPath )
FOR nI := 1 TO Len( aFile )
IF ( lClosed := Select( aFile[nI] ) == 0 )
IF isUpper( aFile[nI] )
USE ( cPath ) + ( aFile[nI] ) SHARED VIA "DBFNTX" NEW
ELSE
USE ( cPath ) + ( aFile[nI] ) EXCLUSIVE VIA "DBFNTX" NEW
ENDIF
ELSEIF isLower( aFile[nI] )
lOk := .F.
MsgInfo( "Arquivo Ja Esta Aberto em Modo Compartilhado. Nao Ser Possivel Abri-lo em Modo Exclusivo", SISTEMA )
FOR nJ := nI TO 1 STEP -1
FechaArquivos( aFile[nJ] )
NEXT
EXIT
ENDIF
IF ! NetErr()
/* Abre os indices */
IF lClosed
nIndex := 0
DO WHILE File( cPath + aFile[nI] + NtoC( ++nIndex ) + ".NTX" )
( aFile[nI] )->( dbSetIndex( cPath + aFile[nI] + NtoC( nIndex ) + ".NTX" ) )
ENDDO
ENDIF
ELSE
/* Fecha os arquivos abertos e retorna falso */
lOk := .F.
MsgInfo( "Nao Foi Possivel Abrir o Arquivo " + aFile[nI], SISTEMA )
FOR nJ := nI-1 TO 1
( aFile[nJ] )->( dbCloseArea() )
NEXT
EXIT
ENDIF
NEXT
IF lOk .AND. Len( aFile ) > 0
// Vai para a area do primeiro arquivo aberto...
dbSelectArea( aFile[1] )
ENDIF
RETURN lOk
FUNCTION AddRec()
LOCAL lLocked
DO WHILE .T.
dbAppend()
IF ( lLocked := ! NETERR() )
EXIT
ENDIF
IF ! MsgYesNo( "Nao Foi Possivel Incluir Registro. Deseja Continuar", SISTEMA )
EXIT
ENDIF
ENDDO
IF if( lLocked, ! ( lLocked := rLock() ), .F. )
MsgInfo( "Erro na Tentativa de Inclusao de Registro", SISTEMA )
ENDIF
RETURN lLocked
FUNCTION xSetOrder( cNtxKey, cCondition, cPath )
LOCAL nI, nOldOrder
IF cPath == NIL
cPath := ""
ENDIF
IF cCondition == NIL
cCondition := ""
ENDIF
nOldOrder := IndexOrd()
nI := 0
DO WHILE ! Empty( IndexKey( ++nI ) )
IF Upper( AllTrim( IndexKey( nI ) )+OrdFor( nI ) ) == Upper( AllTrim( cNtxKey ) + AllTrim( cCondition ) )
EXIT
ENDIF
ENDDO
IF Upper( AllTrim( IndexKey( nI ) ) ) <> Upper( AllTrim( cNtxKey ) )
MsgInfo( "Erro. Chave de indice <" + cNtxKey + ">, Condição <" + Trim( cCondition ) + "> do Arquivo " + proper( alias() ) + " Não Existe", SISTEMA )
nI := nOldOrder
ENDIF
dbSetOrder( nI )
RETURN nOldOrder
FUNCTION TmpFile( cChar )
// ATENCAO
// Usava a nNetStaNum() da CA-TOOLS
RETURN if( cChar == NIL, "A", cChar ) + strZero( Random( 999 ), 6 )
FUNCTION Mudar_Path()
LOCAL nI
LOCAL aDBF
cPath := GetFolder('Selecione o Caminho das Bases de Dados')
IF ! Empty( cPath )
Show_Dbf.Text_Path.Value := cPath+"\"
aDBF := Directory( cPath+"\*.DBF" )
aEval( aDbf, {|x| x[1] := StrTran( Upper(x[1]), ".DBF", "") } )
DELETE ITEM ALL FROM Grid_DBFs OF Show_DBF
FOR nI := 1 TO Len( aDBF )
ADD ITEM { aDBF[nI][1], aDBF[nI][2], aDBF[nI][3], aDBF[nI][4], aDBF[nI][5] } TO Grid_DBFs OF Show_DBF
NEXT nI
Show_DBF.Grid_DBFs.SetFocus()
Mostra_Indices()
Mostra_Relatorios()
Mostra_Telas()
ENDIF
RETURN .T.
FUNCTION SetaImpressora( lSeta, cFile, lHtml )
IF lSeta
IF cFile <> NIL .AND. ! Empty( cFile )
cFile := if( SubStr(cFile, -4, 1) == ".", AllTrim(cFile), AllTrim(cFile)+if(lHtml <> NIL .AND. lHtml, ".HTM", ".TXT"))
SET PRINTER TO &(cFile)
ENDIF
SET DEVICE TO PRINTER
SET CONSOLE OFF
SET PRINTER ON
IF lHtml <> NIL .AND. lHtml
? '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">'
? '<HTML><HEAD><TITLE>HwGUI</TITLE>'
? '<META http-equiv=Content-Type content="text/html; charset=windows-1252">'
? '<META content="MSHTML 6.00.2900.2802" name=GENERATOR></HEAD>'
? '<BODY>'
? '<PRE>'
ENDIF
ELSE
IF lHtml <> NIL .AND. lHtml
? '</BODY>'
? '</PRE>'
? '</HTML>'
ENDIF
SET CONSOLE ON
SET DEVICE TO SCREEN
SET PRINTER OFF
SET PRINTER TO
ENDIF
RETURN NIL
*----------------------------
FUNCTION AnyToChar( xcValue )
*----------------------------
LOCAL cType
cType := valType( xcValue )
IF cType == "C"
/* none */
ELSEIF cType == "N"
xcValue := Str( xcValue )
ELSEIF cType == "D"
xcValue := dtoc( xcValue )
ELSEIF cType == "L"
xcValue := if( .T., "T", "F" )
ELSEIF cType == "B"
xcValue := "{|| }"
ELSEIF cType == "M"
xcValue := StrTran( xcValue, chr( 13 ) + chr( 10 ) )
ELSEIF cType == "A"
xcValue := "{ }"
ELSEIF cType == "O"
xcValue := "Obj"
ELSE
xcValue := "NIL"
ENDIF
RETURN xCValue
*---------------------------
FUNCTION AnyToNum( xcValue )
*---------------------------
LOCAL cType
cType := valType( xcValue )
IF cType == "N"
/* none */
ELSEIF cType == "C"
IF len( xcValue ) == 8
xcValue := ctof( xcValue )
ELSE
xcValue := CtoN( xcValue )
ENDIF
ELSEIF cType == "L"
xcValue := if( xcValue, 1, 0 )
ELSEIF cType == "D"
xcValue := xcValue - ctod( "00/00/0000" )
ELSE
xcValue := 0
ENDIF
RETURN xCValue
*-------------------------------
FUNCTION AnyToLogical( xcValue )
*-------------------------------
LOCAL cType
cType := valType( xcValue )
IF cType == "L"
/* none */
ELSEIF cType == "C"
xcValue := if( xcValue == "T" .OR. xcValue == "Y", .T., .F. )
ELSEIF cType == "N"
xcValue := if( xcValue == 1, .T., .F. )
ELSE
xcValue := .F.
ENDIF
RETURN xCValue
*----------------------------
FUNCTION AnyToDate( xcValue )
*----------------------------
LOCAL cType
cType := valType( xcValue )
IF cType == "D"
/* none */
ELSEIF cType == "C"
xcValue := ctod( xcValue )
ELSEIF cType == "N"
xcValue := ctod( "00/00/0000" ) + xcValue
ELSE
xcValue := ctod( "" )
ENDIF
RETURN xCValue
/*
Quebra o cText em um aArray
*/
*------------------------------
FUNCTION aSplit( cText, cChar )
*------------------------------
LOCAL nI
LOCAL aText
aText := {}
DO WHILE ( nI := at( cChar, cText ) ) > 0
IF ! Empty( left( cText, nI - 1 ) )
aAdd( aText, left( cText, nI - 1 ) )
ENDIF
cText := substr( cText, nI + len( cChar ) )
ENDDO
if( Empty( cText ), NIL, aAdd( aText, cText ) )
RETURN aText
*-------------------------------------------
* Lê o arquivo .INI e retorna a Base De Dados
FUNCTION BaseDeDados()
*-------------------------------------------
LOCAL cValue := ""
BEGIN INI FILE __INI+".Ini"
GET cValue SECTION "Base De Dados" ENTRY "Base De Dados"
END INI
RETURN Upper( cValue )
*------------------------------------
FUNCTION Proper( cTexto, cDelimiter )
*------------------------------------
LOCAL cExcessao
LOCAL aTexto
cDelimiter := if( cDelimiter == NIL, " ", cDelimiter )
cExcessao := "E_DA_DE_DO_S/A"
aTexto := aSplit( cTexto, cDelimiter )
cTexto := ""
aEval( aTexto, {|x| cTexto += if( x $ cExcessao, lower( x ), upper( left( x, 1 ) ) + lower( substr( x, 2 ) ) ) + cDelimiter } )
RETURN trim( cTexto )