Vou postar uma parte porque este programa tem + ou menos 1300 linhas.
Código: Selecionar todos
* PROGRAM ............ CONSDATA.PRG
* INSTALLATION ....... 12/OUT/90
* MAINTENANCE ........ 12/OUT/90
* AUTHOR ............. J.C. ROQUE
* FUNCTION ........... Consulta Coleta por Data
*
*
#include "inkey.ch"
#include "cor.ch"
#include "sixnsx.ch"
#DEFINE amarelo "R+/B,GR+/B*"
#DEFINE azul "R+/B*,GR+/B*"
#DEFINE corcons "W+/B*,W+/B*"
#DEFINE bege "GR+/RB,GR+/B*"
#DEFINE CORTELA "GR+/B,GR+/B"
#DEFINE vermelho "BG+/B,BG+/B"
#DEFINE REFRESH_TIME "15:00:00" // minutos aguardando a rotina antes do REFRESH
#DEFINE DIF_TEMPO(A,B) ELAPTIME(hora1,hora2) // Rotina para verificar tempo parado do sistema
close databases
*
IF !(USA_ARQ("DATA",.F.,0))
CLOSE DATABASES
RETURN
ENDIF
NT_DATA:=DIA
*
SELE A // area 1
IF !(USA_ARQ("NUMCOL",.F.,0))
CLOSE DATABASES
RETURN
ENDIF
*
SELE B // area 2
IF !(USA_ARQ("BACKCOL",.F.,0))
CLOSE DATABASES
RETURN
ENDIF
*
SELE C // area 3
IF !(USA_ARQ("ARCLI",.F.,0))
CLOSE DATABASES
RETURN
ENDIF
*
SELE D // area 4
IF !(USA_ARQ("COLETA",.F.,0))
CLOSE DATABASES
RETURN
ENDIF
*
SELE E // area 5
IF !(USA_ARQ("ROMANEIO",.F.,0))
CLOSE DATABASES
RETURN
ENDIF
*
Acima ele seleciona os arquivos. O problema maior é o arquivo ROMANEIO que tem uma BAG com 13 indices.
e_coleta:=.T.
VER_COLETA(04,04,18,75,"COLETA",1,;
{"N_COLETA","DATA","R_NOME","D_NOME","D_CIDADE","R_FONE","CONTATO"},{"Coleta","Data","Remetente","Destinatario","Destino","Fone","Contato"},;
{"@!","@!","@!","@!","@!","@!","@!"},1)
tone(5000,1)
tone(5000,2)
tone(5000,3)
SET DELETED OFF
SET DELETED OFF
CLOSE DATABASES
RETURN
ENDDO
*
*-------------------------------------------------------------------------
Function Ver_coleta(Li,Ci,Lf,Cf,Arquivo,Indices,Campo,Cabecalho,Pictr,titulo)
*-------------------------------------------------------------------------
/*----------------------------- Parametros -----------------------------------
Li, Ci (N) - Coordenadas do canto superior esquerdo da janela de visualizaç╞o
Lf, Cf (N) - Coordenadas do canto inferior direito da janela de visalizaç╞o
Arquivo (N) - Numero da area
Indices (N) - Indices do arquivo
Campo (M) - Matriz que contem os campos do arquivo a serem visualizados
Cabecalho(M) - Matriz que contem o cabecalho das colunas a serem visualizados
Pictr (M) - Matriz com as pictures dos campos. Este parametro é opcional
titulo (N) - Numero do arquivo - 1 Principal 2 Backup
----------------------------------------------------------------------------*/
Local Tela:=SaveScreen(0,0,24,79),Area:=Select(), CorSalva:=SetColor()
Local oMyBrowser, Coluna, nKey, NroDig:=0, qNome:="", Col:=Ci+19
Local PictTam:={6,10,21,21,15,9,10}
Local cTitulo:= IF(titulo=1,"Arquivo Principal de Coletas","Arquivo Backup de Coletas")
Local nseconds:=0
Local hora1:=TIME()
Local hora2
//SELE D
SELE &Arquivo
set order to (indices)
//set order to 1
do while .t.
DbGotop()
oMybrowser:=TBrowseDb(li,Ci+1,Lf-1,Cf-1)
oMybrowser:HeadSep :=Chr(196)
oMybrowser:FootSep :=Chr(196)
oMybrowser:ColSep :=CHR(32)+Chr(179)+CHR(32)
oMybrowser:ColorSpec := "W+/B,G+/B,GR+/B,R+/B,GB+/B,RB+/B,W+/G,R*/B"
// cores 1 2 3 4 5 6 7 8
@ 02,40 SAY PADC(cTitulo,40) color "gb+/w"
@ 18,05 SAY "[F1]" color "rb+/b"
@ 18,10 SAY "Renova a Tela" color "gr+/b"
@ 18,24 SAY "[F2]" color "rb+/b"
@ 18,29 SAY "Coleta" color "gr+/b"
@ 18,36 SAY "[F3]" color "rb+/b"
@ 18,41 SAY "Data" color "gr+/b"
@ 18,48 SAY "[F4]" color "rb+/b"
@ 18,53 SAY "Remetente" color "gr+/b"
@ 18,63 SAY "[F5]" color "rb+/b"
@ 18,70 SAY "Fone" color "gr+/b"
*
@ 19,05 SAY "[F6]" color "rb+/b"
@ 19,10 SAY "Endereco" color "gr+/b"
@ 19,20 SAY "[F7]" color "rb+/b"
@ 19,25 SAY "Bairro" color "gr+/b"
@ 19,32 SAY "[F8]" color "rb+/b"
@ 19,37 SAY "Destino" color "gr+/b"
@ 19,45 SAY "[F9]" color "rb+/b"
@ 19,50 SAY "Destinatario" color "gr+/b"
@ 19,63 SAY "[F10]" color "rb+/b"
@ 19,70 SAY (IF( e_coleta,"BACKUP","COLETA")) color "gr+/b"
@ 20,05 SAY "[F11]" color "rb+/b"
@ 20,11 SAY "Baixar" color "gr+/b"
@ 20,18 SAY "[DEL]" color "rb+/b"
@ 20,24 SAY "Excluir" color "gr+/b"
IF e_coleta
@ 20,31 SAY "[ALT P]" color "rb+/b"
@ 20,39 SAY "Reemissao" color "gr+/b"
@ 20,49 SAY "[ALT C]" color "rb+/b"
@ 20,57 SAY "Clona" color "gr+/b"
@ 20,62 SAY "[ALT O]" color "rb+/b"
@ 20,70 SAY "Ocorr" color "gr+/b"
ELSE
SETCOLOR("W+/B,GR+/R")
@ 20,31 CLEAR TO 20,75
@ 20,31 SAY "[ALT C]" color "rb+/b"
@ 20,39 SAY "Clona" color "gr+/b"
@ 20,49 SAY "[ALT O]" color "rb+/b"
@ 20,57 SAY "Ocorrencia" color "gr+/b"
ENDIF
For I:=1 To Len(Campo)
Coluna:=TbColumnNew(Cabecalho[I],FieldwBlock(Campo[I],Select()))
Coluna:Picture:=Pictr[I]
Coluna:width:=PictTam[I]
Coluna:colorblock={|cor1|videcode(FEITO,IMPRESSO) }
oMybrowser:AddColumn(Coluna)
Next
// posiciona no primeiro registro
dbGoTop()
SET CURSOR OFF
Aqui através de uma função ele cria e estabiliza o Browse. O erro está na função videcode
*
*---------------------------------------------------------------------*
STATIC FUNCTION videcode(FEITO,IMPRESSO)
*---------------------------------------------------------------------*
*
*
nt_col=N_COLETA
cChave:=STR(nt_Col,6,0)+DTOC(nt_data)
Rua:=.F.
Area:=SELECT() // area 4
*
SELE E // SELECIONA ARQUIVO DE ROMANEIOS
SET ORDER TO 13
seek(cChave)
IF !EOF() // se localizado significa que foi pra emntrega/coleta
Rua:=.t. // se .t. saiu pra rua
ENDIF
SELE &Area // arquivo de coleta
SET ORDER TO 1
// Condições para as cores do Browse
IF IMPRESSO =" " .and. FEITO ="S"
cor1:={2,5} // Verde - Feito
ELSEIF IMPRESSO=" " .and. Rua .and. FEITO ="S"
cor1:={2,5} // Verde - Feito
ELSEIF IMPRESSO=" " .and. Rua .and. FEITO =" "
cor1:={3,5} // Amarelo - Em andamento
ELSEIF IMPRESSO=" " .and. !Rua .and. FEITO =" "
cor1:={1,5} // Branco - Não Impresso
ELSEIF IMPRESSO="S" .and. Rua .and. FEITO =" "
cor1:={3,5} // Amarelo - Em andamento
ELSEIF IMPRESSO="S" .and. !Rua .and. FEITO =" "
cor1:={5,1} // Magenta - Impresso, mas não na Rua
ELSEIF IMPRESSO="S" .and. Rua .and. FEITO ="S"
cor1:={2,5} // Verde - Feito
ELSEIF IMPRESSO=" " .and. FEITO ="S"
cor1:={2,5} // Verde - Feito
ELSEIF IMPRESSO="S" .and. FEITO ="S"
cor1:={2,5} // Verde - Feito
ELSE
cor1:={5,1} // Magenta - Impresso, mas não na Rua
ENDIF
Rua:=.F.
RETURN(cor1)
O erro está dentro desta função. Ele "pinta " a linha de acordo com a situação da coleta. Quando chama o arquivo ROMANEIo aí aparece o erro já citado.