PC Toledo

Código: Selecionar todos

FUNCTION FUN_ESP


***FUNCOES COM PROBLEMA DE ERRO


FUNCTION LER_CACAD
PARA MOSTRA,LI,CO,ARQUIVO
C_SOM=""
L_SOM=""

*
* -> Funcao que faz pesquisas em outro banco de dados
SELE CACAD
INDCACAD=INDEXORD()
SET ORDER TO 1
SEEK M->CODCLI
M->RETOR_NO=.T.
IF (EOF() .AND. LASTKEY()<>5) .OR. M->TEC_F2
     M->GET_CAM=READVAR()
     IF LEN(M->GET_CAM)<>0
	  SET ORDER TO 2
	  EDIT_ARQ(.F.)   &&&& Esta função vai manusear o DBEDIT
	  IF LASTKEY()=13
	       M->CODCLI = CODCLI
	       M->NOME=NOME
	  ENDIF
     ENDIF
ELSE
     SETCOLOR(CONTECOR[8])
     M->NOME=NOME
     IF MOSTRA="S"
	@ LI,CO SAY NOME
     ENDIF
     COR("GETS")
ENDIF
SET ORDER TO INDCACAD
IF .NOT. EMPTY(ARQUIVO)
   SELE &ARQUIVO
ENDIF
RETURN M->RETOR_NO


FUNCTION PADRAO
CONTECOR[01]="09/01"
CONTECOR[02]="00/07"
CONTECOR[03]="15/04"
CONTECOR[04]="07/01"
CONTECOR[05]="00/03"
CONTECOR[06]="00/07"
CONTECOR[07]="15/07"
CONTECOR[08]="00/07"
CONTECOR[09]="15/04"
CONTECOR[10]="15/01"
CONTECOR[11]="07/01"
CONTECOR[12]="07/01"
CONTECOR[13]="15/03"
RETURN .T.
FUNCTION CGETS
*
* -> Funcao para chamada de consulta em outro arquivo
KEYBOARD CHR(13)
M->TEC_F2=.T.
 

*** Esta função manuseia o DBEDIT, e que esto com o problema

FUNCTION EDIT_ARQ
PARA E_DITAR,CAMPO_PESQ
IF E_DITAR=.F. .OR. M->TEC_F2
     GOTO TOP
     IF .NOT. EMPTY(CAMPO_PESQ)
	SET SOFTSEEK ON
	SEEK &CAMPO_PESQ
	SET SOFTSEEK OFF
	IF EOF() 
	   GO TOP
	ENDIF
     ENDIF
     M->TEC_F2=.F.
     M->RETOR_NO=.F.
     L_PSQ=L_SOM
     C_PSQ=C_SOM
     SOMBRA(L_SOM,C_SOM,.T.)
     SAVE SCREEN TO M->T_ELA
     JANELA(04,03,20,78)
     BOTAO(18,18,"Procura")
     BOTAO(18,36,"Trecho")
     BOTAO(18,54,"Continua")
     COR("MENU")
     @ 06,06 CLEAR TO 16,75
     @ 06,06 TO 08,75
     @ 08,06 TO 16,75
     @ 08,06 SAY "Ã"
     @ 08,75 SAY "´"
     SET KEY -1 TO
     KEYBOARD CHR(65)
     DECLARE PSQ_NOME[FCOUNT()],PSQ_TIPO[FCOUNT()],PSQ_TAM[FCOUNT()],PSQ_DEC[FCOUNT()]
     AFIELDS(PSQ_NOME,PSQ_TIPO,PSQ_TAM,PSQ_DEC)
     FOR F_PSQ=1 TO LEN(PSQ_NOME)
	  PSQ_NOME[F_PSQ]=SUBS(PSQ_NOME[F_PSQ],1,1)+LOWER(SUBS(PSQ_NOME[F_PSQ],2))
     NEXT

*>>>>> DBEDIT QUE ESTA DANDO O ERRO, O PARAMENTRO acColumnSayPicture está com .T.   x
*                                      x
     DBEDIT(07,07,16,74,.T.,"LER_ARQ",.T.,PSQ_NOME,"ÄÂÄ"," ³ ","ÄÁÄ")
*            XX,XX,XX,XX,axC,"LER_ARQ",acP,acHccccc,"Sca","Sco","Srd","Scr" 
*     DBEDIT(07,07,16,74,.T.,"LER_ARQ"," ",PSQ_NOME,"ÄÂÄ"," ³ ","ÄÁÄ")
     SET KEY -1 TO CGETS
     RESTORE SCREEN FROM M->T_ELA
     SOMBRA(L_PSQ,C_PSQ)
     COR("GETS")
ENDIF
 
FUNCTION LER_ARQ
*
* -> Funcao de usuario para DBEDIT
PARA P_MODO,P_CAMPO
IF M->P_MODO=3
     COR("BOX DA JANELA DE DIALOGO")
     @ 09,25,13,54 BOX " "
     @ 09,25 SAY "þ"
     COR("JANELA DE DIALOGO")
     @ 10,26 CLEAR TO 12,53
     @ 11,33 SAY "Arquivo  vazio"
     BEEP()
     INKEY(4)
     COR("MENU")
     RETURN 0
ENDIF
M->TEC_PSQ=UPPER(CHR(LASTKEY()))
IF M->TEC_PSQ="P"
     BOTAO(18,18,"Procura",-2)
     BOTAO(18,18,"Procura")
ELSEIF M->TEC_PSQ="C"
     BOTAO(18,54,"Continua",-2)
     BOTAO(18,54,"Continua")
ELSEIF M->TEC_PSQ="T"
     BOTAO(18,36,"Trecho",-2)
     BOTAO(18,36,"Trecho")
ENDIF

IF LASTKEY()=27 .OR. LASTKEY()=13
     COR("MENU")
     RETURN 0
ELSEIF M->TEC_PSQ="P" .OR. M->TEC_PSQ="C" .OR. M->TEC_PSQ="T"
     IF M->TEC_PSQ<>"C"
	  SAVE SCREEN
	  M->PSQ_POS=(80-(PSQ_TAM[M->P_CAMPO]+4))/2
	  IF PSQ_TAM[M->P_CAMPO]>50 .OR. PSQ_TIPO[M->P_CAMPO]="M"
	       COR("BOX DA JANELA DE DIALOGO")
	       @ 09,13,13,66 BOX " "
	       @ 09,13 SAY "þ"
	       COR("JANELA DE DIALOGO")
	       @ 10,15 CLEAR TO 12,65
	  ELSEIF M->PSQ_POS<25
	       COR("BOX DA JANELA DE DIALOGO")
	       @ 09,M->PSQ_POS,13,M->PSQ_POS+PSQ_TAM[M->P_CAMPO]+3 BOX " "
	       @ 09,M->PSQ_POS SAY "þ"
	       COR("JANELA DE DIALOGO")
	       @ 10,M->PSQ_POS+1 CLEAR TO 12,M->PSQ_POS+PSQ_TAM[M->P_CAMPO]+2
	  ELSE
	       COR("BOX DA JANELA DE DIALOGO")
	       @ 09,25,13,54 BOX " "
	       @ 09,25 SAY "þ"
	       COR("JANELA DE DIALOGO")
	       @ 10,26 CLEAR TO 12,53
	  ENDIF
	  COR("BOX DA JANELA DE DIALOGO")
	  @ 09,(80-LEN(TRIM(PSQ_NOME[M->P_CAMPO])))/2 SAY PSQ_NOME[M->P_CAMPO]
	  COR("BOTAO EM DESTAQUE")
	  SET CURSOR ON
	  IF PSQ_TAM[M->P_CAMPO]>50
	       M->PRO_CURA=VAR_GET(11,15,PSQ_TAM[M->P_CAMPO])
	  ELSEIF PSQ_TIPO[M->P_CAMPO]="M"
	       M->PRO_CURA=VAR_GET(11,15,200)
	  ELSE
	       M->PRO_CURA=VAR_GET(11,M->PSQ_POS+2,PSQ_TAM[M->P_CAMPO])
	  ENDIF
	  KEYBOARD CHR(65)
	  SET CURSOR OFF
	  RESTORE SCREEN
	  M->REG_ATU=RECN()
	  GOTO TOP
     ELSE
	  M->REG_ATU=RECN()
     ENDIF
     IF M->TEC_PSQ="C"
	  IF M->ULT_PSQ="P"
	       M->TEC_PSQ="CP"
	  ELSE
	       M->TEC_PSQ="CT"
	  ENDIF
     ELSE
	  M->ULT_PSQ=M->TEC_PSQ
     ENDIF
     COR("MENU")
     DO WHILE .NOT. EOF()
	  M->SUB_CAMPO=PSQ_NOME[M->P_CAMPO]
	  M->PRO_CURA=UPPER(M->PRO_CURA)
	  IF M->TEC_PSQ="P" .OR. (M->TEC_PSQ="CP" .AND. M->REG_ATU<>RECN())
                IF PSQ_TIPO[M->P_CAMPO]="N"
                     IF &SUB_CAMPO=VAL(M->PRO_CURA)
			 SET SOFTSEEK ON
			 SEEK M->PRO_CURA
			 SET SOFTSEEK OFF
			 IF EOF()
			    EXIT
			 ELSE
			    KEYBOARD CHR(65)
			    RETURN 1
			 ENDIF
                     ENDIF
                ELSEIF PSQ_TIPO[M->P_CAMPO]="D"
                     IF DTOC(&SUB_CAMPO)=M->PRO_CURA
                          KEYBOARD CHR(65)
                          RETURN 1
                     ENDIF
                ELSEIF PSQ_TIPO[M->P_CAMPO]="C"
                     M->CMP_MEMO=UPPER(&SUB_CAMPO)
                     IF M->CMP_MEMO=M->PRO_CURA
                          SET SOFTSEEK ON    
                          SEEK M->PRO_CURA
                          SET SOFTSEEK OFF    
                          IF EOF()
                             GO TOP
                          ENDIF
                          KEYBOARD CHR(65)
                          RETURN 1
                     ENDIF
                ELSEIF PSQ_TIPO[M->P_CAMPO]="T"
                     IF IIF(&SUB_CAMPO,"T","F")=M->PRO_CURA
                          KEYBOARD CHR(65)
                          RETURN 1
                     ENDIF
                ELSEIF PSQ_TIPO[M->P_CAMPO]="M"
                     M->CMP_MEMO=UPPER(&SUB_CAMPO)
                     IF M->CMP_MEMO=M->PRO_CURA
                          KEYBOARD CHR(65)
                          RETURN 1
                     ENDIF
                ENDIF
	  ELSEIF M->TEC_PSQ="T" .OR. (M->TEC_PSQ="CT" .AND. M->REG_ATU<>RECN())
	       IF PSQ_TIPO[M->P_CAMPO]="N"
		    IF AT(M->PRO_CURA,STR(&SUB_CAMPO,PSQ_TAM[M->P_CAMPO],PSQ_DEC[M->P_CAMPO]))<>0
			 KEYBOARD CHR(65)
			 RETURN 1
		    ENDIF
	       ELSEIF PSQ_TIPO[M->P_CAMPO]="D"
		    IF AT(M->PRO_CURA,DTOC(&SUB_CAMPO))<>0
			 KEYBOARD CHR(65)
			 RETURN 1
		    ENDIF
	       ELSEIF PSQ_TIPO[M->P_CAMPO]="C"
		    M->CMP_MEMO=UPPER(&SUB_CAMPO)
		    IF AT(M->PRO_CURA,M->CMP_MEMO)<>0
			 KEYBOARD CHR(65)
			 RETURN 1
		    ENDIF
	       ELSEIF PSQ_TIPO[M->P_CAMPO]="T"
		    IF IIF(&SUB_CAMPO,"T","F")=M->PRO_CURA
			 KEYBOARD CHR(65)
			 RETURN 1
		    ENDIF
	       ELSEIF PSQ_TIPO[M->P_CAMPO]="M"
		    M->CMP_MEMO=UPPER(&SUB_CAMPO)
		    IF AT(M->PRO_CURA,M->CMP_MEMO)<>0
			 KEYBOARD CHR(65)
			 RETURN 1
		    ENDIF
	       ENDIF
	  ENDIF
	  SKIP
     ENDDO
     GOTO M->REG_ATU
     SAVE SCREEN
     COR("BOX DA JANELA DE DIALOGO")
     @ 09,25,13,54 BOX " "
     @ 09,25 SAY "þ"
     COR("JANELA DE DIALOGO")
     @ 10,26 CLEAR TO 12,53
     @ 11,30 SAY "Dados n„o encontrados"
     BEEP()
     INKEY(.1)
     INKEY(3)
     COR("MENU")
     RESTORE SCREEN
ENDIF
RETURN 1

FUNCTION VAR_GET
*
* -> Simula um GET
PARA GET_X,GET_Y,GET_TAM
M->GET_VAR=""
M->TEC_GET=0
IF M->GET_TAM<50
     @ M->GET_X,M->GET_Y SAY SPACE(M->GET_TAM)
ELSE
     @ M->GET_X,M->GET_Y SAY SPACE(50)
ENDIF
DO WHILE .T.
     IF LEN(M->GET_VAR)<50
	  @ M->GET_X,M->GET_Y SAY M->GET_VAR
     ELSE
	  @ M->GET_X,M->GET_Y SAY SUBS(M->GET_VAR,LEN(M->GET_VAR)-48,50)
     ENDIF
     IF LEN(M->GET_VAR) = M->GET_TAM
	  RETURN M->GET_VAR
     ENDIF
     M->TEC_GET=INKEY(0)
     IF M->TEC_GET=27
	  RETURN ""
     ELSEIF M->TEC_GET=13
	  RETURN M->GET_VAR
     ELSEIF M->TEC_GET=8 .OR. M->TEC_GET=19 .OR. M->TEC_GET=7
	  IF LEN(M->GET_VAR)>0
	       M->GET_VAR=SUBS(M->GET_VAR,1,LEN(M->GET_VAR)-1)
	       IF LEN(M->GET_VAR)<50
		    @ M->GET_X,M->GET_Y SAY M->GET_VAR+" "
	       ENDIF
	  ENDIF
     ELSE
	  M->GET_VAR = M->GET_VAR + CHR(M->TEC_GET)
     ENDIF
ENDDO
 
 

 
FUNCTION BEEP
*
* -> Emite um sinal sonoro
TONE(250,4)
 
 
FUNCTION ON_CURSOR
*
* -> Ativa o cursor caso exista um get pendente
M->GET_VAR=READVAR()
IF LEN(M->GET_VAR)>0 .AND. M->GET_VAR<>"MENU_OPC"
     SET CURSOR ON
ENDIF
 
FUNCTION MENSAGEM
*
* -> Funcao que imprime mensagens na tela
********INSERIDO EM FUNCAO ERRO
PARA TEX_TO,PAUSA
********
COR_MENS=SETCOLOR()
COR("MENU")
SET CURSOR OFF
IF PCOUNT()=0
     @ 24,11 SAY SPACE(58)
     SETCOLOR(COR_MENS)
     ON_CURSOR()
     RETURN .T.
ENDIF
*****INSERIDO EM FUNCAO ERRO
IF PCOUNT()=1
     M->PAUSA=0
ENDIF
****ORIGINAL
*IF PCOUNT()=1
*     PARA TEX_TO
*     M->PAUSA=0
*ELSE
*     PARA TEX_TO,PAUSA
*ENDIF
********
@ 24,11 SAY SPACE(58)
@ 24,((80-LEN(M->TEX_TO))/2) SAY M->TEX_TO
IF M->PAUSA<>0
     M->X=INKEY(M->PAUSA)
ENDIF
SETCOLOR(COR_MENS)
ON_CURSOR()
RETURN .T.
 
FUNCTION DELE_TAR
RETURN IIF(DELETED(),"*"," ")
 
FUNCTION PERGUNTA
*
* -> Funcao que executa uma pergunta
PER_COR=SETCOLOR()
SET CURSOR OFF
SAVE SCREEN TO PER_TELA
M->RES_POSTA="S"
PARA TEX_TO,RES_POSTA
M->SIM_NAO=IIF(M->RES_POSTA="N",2,1)
M->LAR_G=LEN(M->TEX_TO)
IF M->LAR_G<37
     M->LAR_G=51
ELSE
     M->LAR_G=M->LAR_G+14
ENDIF
COL_SUP=INT((80-M->LAR_G)/2)
COL_INF=COL_SUP+LAR_G-1
JANELA(08,COL_SUP,16,COL_INF)
COR("JANELA DE DIALOGO")
@ 11,(80-LEN(TEX_TO))/2 SAY TEX_TO
BOTAO(13,25,"Sim",1)
BOTAO(13,42,"N„o",2)
SIM_NAO=BOTAO()
RESTORE SCREEN FROM PER_TELA
SETCOLOR(PER_COR)
RETURN IIF(M->SIM_NAO=1,"S","N")

FUNCTION BOTAO
PARA LIN_BOT,COL_BOT,NOM_BOT,NUM_BOT
IF PCOUNT()=0
     NUM_BOT=0
ENDIF
IF PCOUNT()=3
     NUM_BOT=-1
ENDIF
IF PCOUNT()=4
     IF NUM_BOT<1
	  Q_BOTOES=1
     ELSE
	  Q_BOTOES=NUM_BOT
     ENDIF
     BOTOES[Q_BOTOES]=STR(COL_BOT,3)+STR(LIN_BOT,3)+NOM_BOT
ENDIF
IF PCOUNT()=1
     X_BOT=LIN_BOT
     NUM_BOT=0
ELSE
     X_BOT=1
ENDIF
IF NUM_BOT>0 .OR. NUM_BOT=-1
     COR("BOTOES")
     @ LIN_BOT,COL_BOT SAY SPACE(11)
     @ LIN_BOT,COL_BOT+1 SAY NOM_BOT
     SETCOLOR("N/"+ALLTRIM(SUBS(CONTECOR[4],4)))
     @ LIN_BOT,COL_BOT-1 SAY "Ü"
     @ LIN_BOT+1,COL_BOT-1 SAY "ßßßßßßßßßßß "
ELSE
     TECLA=0
     DO WHILE .T.
	  COL_BOT=VAL(SUBS(BOTOES[X_BOT],1,3))
	  LIN_BOT=VAL(SUBS(BOTOES[X_BOT],4,3))
	  NOM_BOT=SUBS(BOTOES[X_BOT],7)
	  COR("BOTAO EM DESTAQUE")
	  @ LIN_BOT,COL_BOT SAY SPACE(11)
	  @ LIN_BOT,COL_BOT+1 SAY NOM_BOT
	  SETCOLOR("N/"+ALLTRIM(SUBS(CONTECOR[4],4)))
	  @ LIN_BOT,COL_BOT-1 SAY "Ü"
	  @ LIN_BOT+1,COL_BOT-1 SAY "ßßßßßßßßßßß "
	  IF TECLA=13
	       INKEY(.2)
	       RETURN X_BOT
	  ENDIF
	  IF NUM_BOT=-2
	       TECLA=13
	  ELSE
	       TECLA=INKEY(0)
	  ENDIF
	  IF TECLA=27
	       RETURN 0
	  ENDIF
	  IF TECLA=28
	       DO HELP WITH "CALENDARIO",1,""
	  ENDIF
	  COR("BOTOES")
	  @ LIN_BOT,COL_BOT+1 SAY NOM_BOT
	  FOR F_BOT=1 TO Q_BOTOES
	       IF SUBS(BOTOES[F_BOT],7,1)=UPPER(CHR(TECLA))
		    X_BOT=F_BOT
		    TECLA=13
		    COL_BOT=VAL(SUBS(BOTOES[X_BOT],1,3))
		    LIN_BOT=VAL(SUBS(BOTOES[X_BOT],4,3))
		    NOM_BOT=SUBS(BOTOES[X_BOT],7)
		    EXIT
	       ENDIF
	  NEXT
	  IF TECLA=13
	       COR("JANELA DE DIALOGO")
	       @ LIN_BOT,COL_BOT SAY " "
	       @ LIN_BOT+1,COL_BOT-1 SAY "            "
	       @ LIN_BOT,COL_BOT+10 SAY " "
	       COR("BOTAO EM DESTAQUE")
	       @ LIN_BOT,COL_BOT-1 SAY " "+NOM_BOT+" "
	       INKEY(.2)
	       LOOP
	  ENDIF
	  IF TECLA=19 .OR. TECLA=5
	       X_BOT=X_BOT-1
	  ELSEIF TECLA=4 .OR. TECLA=24
	       X_BOT=X_BOT+1
	  ENDIF
	  X_BOT=IIF(X_BOT<1,Q_BOTOES,IIF(X_BOT>Q_BOTOES,1,X_BOT))
     ENDDO
ENDIF
 
FUNCTION FUN_ACHO
*
* Funcao de usuario para achoice
PARA PAR1,PAR2,PAR3
M->TEC_ACHO=UPPER(CHR(LASTKEY()))
IF (M->TEC_ACHO>="A" .AND. M->TEC_ACHO<="Z") .OR. (M->TEC_ACHO>="0" .AND. M->TEC_ACHO<="9")
     FOR M->X_ACHO=1 TO LEN(ME_NU)
	  FOR M->ACHO_X=1 TO LEN(ME_NU[M->X_ACHO])
	       IF (SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1)>="A" .AND. SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1)<="Z") .OR. (SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1)>="0" .AND. SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1)<="9")
		    IF SUBS(ME_NU[M->X_ACHO],M->ACHO_X,1) = M->TEC_ACHO
			 M->OPC_ACHO = M->X_ACHO
			 RETURN 0
		    ENDIF
		    EXIT
	       ENDIF
	  NEXT
     NEXT
ENDIF
IF LASTKEY()=13
     M->INC_COL=ROW()
     RETURN 1
ELSEIF LASTKEY()=27 .OR. M->TEC_ACHO="R"
     RETURN 0
ELSEIF PAR1=1
     KEYBOARD CHR(30)
ELSEIF PAR1=2
     KEYBOARD CHR(31)
ENDIF
RETURN 2
 
FUNCTION MENU
*
* -> Funcao que monta menu
PARA N_TELA
IF PCOUNT()=0
     N_TELA=0
     SET KEY  4 TO T_DIR
     SET KEY 19 TO T_ESQ
ENDIF
M->M_POS=MENU_POS[M->MENU_P]
M->LIN_INIC=LIN_MENU+1
IF N_TELA=1 .OR. N_TELA=2
     M->M_POS=M->M_POS+10
     IF N_TELA=1
	  M->LIN_INIC=LIN_MENU+MENU_S+2
     ELSE
	  M->LIN_INIC=LIN_MENU+2
     ENDIF
ENDIF
M->LAR_G=0
M->AL_TU=LEN(ME_NU)
DECLARE MEN_U[M->AL_TU] , MAR_C[M->AL_TU]
AFILL(MAR_C,.T.)
FOR M->X_X=1 TO M->AL_TU
     MEN_U[M->X_X]=" "+TRIM(ME_NU[M->X_X])+" "
     IF LEN(MEN_U[M->X_X]) > M->LAR_G
	  M->LAR_G=LEN(MEN_U[M->X_X])
	  IF SUBS(MEN_U[M->X_X],2,1)=">"
	       M->LAR_G=M->LAR_G+1
	  ENDIF
     ENDIF
NEXT
IF M->LAR_G < 18
     M->LAR_G=18
ENDIF
FOR M->X_X=1 TO M->AL_TU
     IF MEN_U[M->X_X]=" - "
	  MAR_C[M->X_X]=.F.
	  MEN_U[M->X_X]=REPL("Ä",M->LAR_G)
     ENDIF
     IF SUBS(MEN_U[M->X_X],2,1)=">"
	  MEN_U[M->X_X]=" "+SUBS(MEN_U[M->X_X],3)+SPACE((M->LAR_G-LEN(ALLTRIM(MEN_U[M->X_X])))-3)+CHR(16)+" "
     ENDIF
NEXT
M->AL_TU=M->AL_TU+2
IF M->AL_TU>15
     M->AL_TU=15
ENDIF
M->ULT_OPC=M->AL_TU
IF M->M_POS + M->LAR_G + 3 > 79
     IF M->N_TELA=0
	  M->M_POS = M->M_POS - ((M->LAR_G+2) - LEN(MENU_PRI[M->MENU_P]))
     ELSE
	  M->M_POS = M->M_POS - ((M->M_POS+M->LAR_G+3)-79)
     ENDIF
ENDIF
M->X_X=M->M_POS+M->LAR_G+2
SOMBRA(M->LIN_INIC,M->M_POS,M->AL_TU+M->LIN_INIC-1,M->M_POS+M->LAR_G+3)
COR("MENU")
@ M->LIN_INIC,M->M_POS CLEAR TO M->AL_TU+M->LIN_INIC-1,M->M_POS+M->LAR_G+3
@ M->LIN_INIC,M->M_POS+1 TO M->AL_TU+M->LIN_INIC-1,M->M_POS+M->LAR_G+2
IF M->AL_TU<15
     FOR M->X_X=1 TO M->AL_TU-2
	  IF SUBS(MEN_U[M->X_X],1,1)="Ä"
	       @ M->X_X+M->LIN_INIC,M->M_POS+1 SAY "Ã"
	       @ M->X_X+M->LIN_INIC,M->M_POS+M->LAR_G+2 SAY "´"
	  ENDIF
     NEXT
ENDIF
IF LEN(MEN_U) > M->AL_TU-2
     @ M->LIN_INIC+1,M->M_POS+M->LAR_G+3 SAY CHR(24)
     @ M->LIN_INIC+M->AL_TU-2,M->M_POS+M->LAR_G+3 SAY CHR(25)
ENDIF
M->OPC_ACHO=0
M->MENU_OPC=ACHOICE(M->LIN_INIC+1,M->M_POS+2,M->LIN_INIC+M->AL_TU-2,M->M_POS+M->LAR_G+1,MEN_U,MAR_C,"FUN_ACHO")
IF M->MENU_OPC=0
     M->MENU_OPC = M->OPC_ACHO
     IF N_TELA=0 .AND. BUFFER=CHR(13) .AND. M->MENU_OPC=0
	  BUFFER="S"+CHR(13)
     ENDIF
ENDIF
IF MENU_OPC<>0
     IF .NOT.(N_TELA=0 .AND. SUBS(MEN_U[MENU_OPC],LEN(MEN_U[MENU_OPC])-1,1)=CHR(16))
	  RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
     ELSE
	  SOMBRA(L_SOM,C_SOM,.T.)
	  IF LEN(MEN_U) <= M->AL_TU
	       COR("DESTAQUE DO MENU")
	       @ LIN_MENU+MENU_OPC+1,COL() SAY MEN_U[MENU_OPC]
	  ENDIF
     ENDIF
ELSE
     RESTSCREEN(LIN_MENU+1,00,23,79,TELA_PRI)
ENDIF
SET KEY  4 TO
SET KEY 19 TO
RETURN M->MENU_OPC

FUNCTION SOMBRA
PARA LIN_SUP,COL_SUP,LIN_INF,COL_INF
IF PCOUNT()=2 .OR. PCOUNT()=3
     C_SOM=COL_SUP
     L_SOM=LIN_SUP
     LIN_SUP=VAL(SUBS(C_SOM,1,2))
     COL_SUP=VAL(SUBS(C_SOM,3,2))
     LIN_INF=VAL(SUBS(C_SOM,5,2))
     COL_INF=VAL(SUBS(C_SOM,7,2))
     COL_SOM=SUBS(C_SOM,9)
     LIN_SOM=L_SOM
ENDIF
IF COL_SUP<2 .OR. LIN_INF>22
     RETURN .F.
ENDIF
IF PCOUNT()=3
     RESTSCREEN(LIN_SUP+1,COL_SUP-2,LIN_INF+1,COL_SUP-1,COL_SOM)
     RESTSCREEN(LIN_INF+1,COL_SUP-2,LIN_INF+2,COL_INF-2,LIN_SOM)
     RETURN .F.
ENDIF
IF PCOUNT()<>2
     COL_SOM=SAVESCREEN(LIN_SUP+1,COL_SUP-2,LIN_INF+1,COL_SUP-1)
     LIN_SOM=SAVESCREEN(LIN_INF+1,COL_SUP-2,LIN_INF+2,COL_INF-2)
ENDIF
*
* -> Estas duas linhas se fazem necess rio apenas para algumas
*    vers”es do Clipper Summer 87 que vez por outra apresentam
*    problemas na fun‡„o SAVESCREEN
COL_SOM=SUBS(COL_SOM,1,((LIN_INF-LIN_SUP)+1)*4)
LIN_SOM=SUBS(LIN_SOM,1,((COL_INF-COL_SUP)+1)*4)
*
IF SUBS(COL_SOM,2,1)<>CHR(8)
     C_SOM=STR(LIN_SUP,2)+STR(COL_SUP,2)+STR(LIN_INF,2)+STR(COL_INF,2)+COL_SOM
     L_SOM=LIN_SOM
ENDIF
FOR I=2 TO LEN(COL_SOM) STEP 2
     COL_SOM=STUFF(COL_SOM,I,1,CHR(8))
NEXT
FOR I=2 TO LEN(LIN_SOM)/2 STEP 2
     LIN_SOM=STUFF(LIN_SOM,I,1,CHR(8))
NEXT
RESTSCREEN(LIN_SUP+1,COL_SUP-2,LIN_INF+1,COL_SUP-1,COL_SOM)
RESTSCREEN(LIN_INF+1,COL_SUP-2,LIN_INF+2,COL_INF-2,LIN_SOM)
RETURN .T.
 

FUNCTION COR
PARA NOM_COR
QUAL_COR=ASCAN(NOMECOR,UPPER(NOM_COR))
IF QUAL_COR<>0
     IF QUAL_COR=2
	  SETCOLOR(CONTECOR[2]+","+CONTECOR[3]+",,,"+CONTECOR[2])
     ELSEIF QUAL_COR=8
	  SETCOLOR(CONTECOR[11]+","+CONTECOR[9]+",,,"+CONTECOR[8])
     ELSE
	  SETCOLOR(CONTECOR[QUAL_COR])
     ENDIF
ENDIF
RETURN .T.

FUNCTION FUN_CFG
PARA PAR1
IF LASTKEY()=13
     RETURN 1
ELSEIF LASTKEY()=27
     RETURN 0
ELSEIF PAR1=1
     KEYBOARD CHR(30)
ELSEIF PAR1=2
     KEYBOARD CHR(31)
ENDIF
CFG_COR=SETCOLOR()
COR("MENU")
FOR F_CFG=1 TO LEN(MENU_CFG)
     @ 09+F_CFG,34 SAY " "
NEXT
SETCOLOR(CFG_COR)
RETURN 2

 
FUNCTION PESQ
*
* -> Funcao para leitura de dados em outro arquivo
PARA M_RELACAO,M_AREA,M_ORDEM,M_CAMPO,M_SAIDA,M_VAZIO
M->U_AREATUA = ALLTRIM(STR(SELECT(),3))
M->U_ORDEM = INDEXORD()
SELE &M_AREA
SET ORDER TO M->M_ORDEM
SEEK M->M_RELACAO
M->RE_TORNO = &M_CAMPO
SELE &U_AREATUA
SET ORDER TO M->U_ORDEM
IF PCOUNT()>4
     &M_SAIDA=M->RE_TORNO
     IF PCOUNT()=6
	  RETURN ""
     ENDIF
ENDIF
RETURN M->RE_TORNO
 
* Final do programa FUN_ESP.PRG

Código: Selecionar todos

#Include "common.ch"
#Include "inkey.ch"
#Include "button.ch"
#Include "setcurs.ch"
#Include "color.ch"
#Include "hbsetup.ch"
#Include "dbedit.ch"

STATIC Static12,Static13

FUNCTION DBEDIT(Arg1,Arg2,Arg3,Arg4,Arg5,Arg6,Arg7,Arg8,Arg9,Arg10,Arg11,Arg12)
LOCAL Local1,Local2,Local3,Local4,Local5,Local6,Local7

*** FOI PRECISO CRIAR ESTA SECAO PARA INICIALIZACAO DOS ARGUMENTOS
*** COM UM VALOR DEFAULT, POIS QUANDO COMPILADO COM XHARBOUR
*** AS LINHAS DE SEPARACAO DE HEADSEP E COLSEP NAO ESTAVAM APARECENDO

DEFAULT ARG9 TO chr(196)+chr(194)+chr(196)
DEFAULT ARG10 TO " "+CHR(179)+" "
DEFAULT ARG11 TO " "
DEFAULT ARG12 TO " "

IF EOF()
GOTO BOTTOM
ENDIF
Local1:=DBEDSETUP(Arg1,Arg2,Arg3,Arg4,Arg5,Arg6,Arg7,Arg8,Arg9,Arg10,Arg11,Arg12)
Local1:SKIPBLOCK({| _1 | SKIPPED(_1)})
Local1:AUTOLITE(.F.)
Local2:=SETCURSOR(0)
Local7:={Static12,Static13}
Static12:=.F.
Static13:=.T.
Local5:=.T.
Local3:=.T.
DO WHILE Local3
DO WHILE !Local1:STABILIZE()
IF NEXTKEY() <> 0
EXIT
ENDIF
ENDDO
IF (Local4:=INKEY()) == 0
IF Local5
Local3:=CALLUSER(Local1,Arg6,0)
DO WHILE !Local1:STABILIZE()
ENDDO
ENDIF
IF Local3 .AND. Static13
Local1:HILITE()
Local4:=INKEY(0)
Local1:DEHILITE()
IF (Local6:=SETKEY(Local4)) <> Nil
EVAL(Local6,PROCNAME(1),PROCLINE(1),"")
LOOP
ENDIF
ELSE
Static13:=.T.
ENDIF
ENDIF
Local5:=.T.
DO CASE
CASE Local4==0
CASE Local4==24
IF Static12
Local1:HITBOTTOM(.T.)
ELSE
Local1:DOWN()
ENDIF
CASE Local4==5
IF Static12
Local1:HITTOP(.T.)
ELSE
Local1:UP()
ENDIF
CASE Local4==3
IF Static12
Local1:HITBOTTOM(.T.)
ELSE
Local1:PAGEDOWN()
ENDIF
CASE Local4==18
IF Static12
Local1:HITTOP(.T.)
ELSE
Local1:PAGEUP()
ENDIF
CASE Local4==31
IF Static12
Local1:HITTOP(.T.)
ELSE
Local1:GOTOP()
ENDIF
CASE Local4==30
IF Static12
Local1:HITBOTTOM(.T.)
ELSE
Local1:GOBOTTOM()
ENDIF
CASE Local4==4
Local1:RIGHT()
CASE Local4==19
Local1:LEFT()
CASE Local4==1
Local1:HOME()
CASE Local4==6
Local1:END()
CASE Local4==26
Local1:PANLEFT()
CASE Local4==2
Local1:PANRIGHT()
CASE Local4==29
Local1:PANHOME()
CASE Local4==23
Local1:PANEND()
OTHERWISE
Local3:=CALLUSER(Local1,Arg6,Local4)
Local5:=.F.
ENDCASE
ENDDO
SETCURSOR(Local2)
Static12:=Local7[1]
Static13:=Local7[2]
RETURN .T.

********************************
FUNCTION DBEDSETUP(Arg1,Arg2,Arg3,Arg4,Arg5,Arg6,Arg7,Arg8,Arg9,Arg10,Arg11,Arg12)

LOCAL Local1,Local2,Local3,Local4,Local5,Local6,Local7,Local8

IF VALTYPE(Arg1) <> "N" .OR. Arg1 < 0
Arg1:=0
ENDIF
IF VALTYPE(Arg2) <> "N" .OR. Arg2 < 0
Arg2:=0
ENDIF
IF VALTYPE(Arg3) <> "N" .OR. Arg3 > MAXROW() .OR. Arg3 < Arg1
Arg3:=MAXROW()
ENDIF
IF VALTYPE(Arg4) <> "N" .OR. Arg4 > MAXCOL() .OR. Arg4 < Arg2
Arg4:=MAXCOL()
ENDIF
IF (Arg4-Arg2)*(Arg3-Arg1) > MAXROW()*MAXCOL()
Arg1:=Arg2:=0
Arg3:=MAXROW()
Arg4:=MAXCOL()
ENDIF
Local1:=TBROWSEDB(Arg1,Arg2,Arg3,Arg4)
IF ISARRAY(Arg5)
Local3:=LEN(Arg5)
Local2:=1
DO WHILE Local2 <= Local3
IF VALTYPE(Arg5[Local2]) <> "C" .OR. EMPTY(Arg5[Local2])
EXIT
ENDIF
Local2++
ENDDO
Local3:=Local2-1
ELSE
Local3:=FCOUNT()
ENDIF
IF Local3 == 0
RETURN .F.
ENDIF
Local1:HEADSEP("ÍÑÍ")
Local1:COLSEP(" ³ ")
Local4:=ARRAY(Local3,6)
IF ISARRAY(Arg5)
FOR Local2:=1 TO Local3
IF "->" $ Arg5[Local2]
Local6:=AT("->",Arg5[Local2])
Local4[Local2][3]:=SUBSTR(Arg5[Local2],1,Local6-1)
Local4[Local2][4]:=SUBSTR(Arg5[Local2],Local6+2)
Local4[Local2][1]:=Local4[Local2][3]+"->;"+Local4[Local2][4]
ELSE
Local4[Local2][3]:=Nil
Local4[Local2][4]:=Nil
Local4[Local2][1]:=Arg5[Local2]
ENDIF
Local4[Local2][2]:=Arg5[Local2]
NEXT
ELSEIF FCOUNT() > 0
FOR Local2:=1 TO Local3
Local4[Local2][3]:=Nil
Local4[Local2][4]:=Nil
Local4[Local2][1]:=FIELDNAME(Local2)
Local4[Local2][2]:=FIELDNAME(Local2)
NEXT
ELSE
RETURN .F.
ENDIF
FOR Local2:=1 TO Local3
Local5:=""
IF ISARRAY(Arg7)
IF LEN(Arg7) >= Local2 .AND. ISCHARACTER(Arg7[Local2]) .AND. !EMPTY(Arg7[Local2])
Local5:=Arg7[Local2]
ENDIF
ELSEIF ISCHARACTER(Arg7) .AND. !EMPTY(Arg7)
Local5:=Arg7
ENDIF
Local7:=Nil
IF ISMEMO(&(Local4[Local2][2]))
Local7:="{|| ' <Memo> '}"
ELSEIF EMPTY(Local5)
IF "->" $ Local4[Local2][2]
IF UPPER(Local4[Local2][3]) == "M"
Local7:=MEMVARBLOCK(Local4[Local2][2])
ELSEIF UPPER(Local4[Local2][3]) == "FIELD"
Local7:=FIELDWBLOCK(Local4[Local2][4],SELECT())
ELSE
Local7:=FIELDWBLOCK(Local4[Local2][4],SELECT(Local4[Local2][3]))
ENDIF
ELSEIF !EMPTY(FIELDPOS(Local4[Local2][2]))
Local7:=FIELDWBLOCK(Local4[Local2][2],SELECT())
ENDIF
ENDIF
IF ISNIL(Local7)
IF EMPTY(Local5)
Local7:="{||"+Local4[Local2][2]+"}"
ELSE
Local7:="{|| Transform("+Local4[Local2][2]+",'"+Local5+"')}"
ENDIF
ENDIF
IF ISCHARACTER(Local7)
Local4[Local2][2]:=&Local7
ELSEIF ISBLOCK(Local7)
Local4[Local2][2]:=Local7
ENDIF
IF ISARRAY(Arg8)
IF LEN(Arg8) >= Local2 .AND. ISCHARACTER(Arg8[Local2])
Local4[Local2][1]:=Arg8[Local2]
ENDIF
ELSEIF ISCHARACTER(Arg8)
Local4[Local2][1]:=Arg8
ENDIF
Local4[Local2][3]:=Nil
IF ISARRAY(Arg9)
IF LEN(Arg9) >= Local2 .AND. ISCHARACTER(Arg9[Local2])
Local4[Local2][3]:=Arg9[Local2]
ENDIF
ELSEIF ISCHARACTER(Arg9)
Local4[Local2][3]:=Arg9
ENDIF
Local4[Local2][4]:=Nil
IF ISARRAY(Arg10)
IF LEN(Arg10) >= Local2 .AND. ISCHARACTER(Arg10[Local2])
Local4[Local2][4]:=Arg10[Local2]
ENDIF
ELSEIF ISCHARACTER(Arg10)
Local4[Local2][4]:=Arg10
ENDIF
Local4[Local2][5]:=Nil
IF ISARRAY(Arg11)
IF LEN(Arg11) >= Local2 .AND. ISCHARACTER(Arg11[Local2])
Local4[Local2][5]:=Arg11[Local2]
ENDIF
ELSEIF ISCHARACTER(Arg11)
Local4[Local2][5]:=Arg11
ENDIF
Local4[Local2][6]:=Nil
IF ISARRAY(Arg12)
IF LEN(Arg12) >= Local2 .AND. ISCHARACTER(Arg12[Local2])
Local4[Local2][6]:=Arg12[Local2]
ENDIF
ELSEIF ISCHARACTER(Arg12)
Local4[Local2][6]:=Arg12
ENDIF
NEXT
FOR Local2:=1 TO Local3
Local8:=TBCOLUMNNEW(Local4[Local2][1],Local4[Local2][2])
IF Local4[Local2][3] <> Nil
Local8:HEADSEP(Local4[Local2][3])
ENDIF
IF Local4[Local2][4] <> Nil
Local8:COLSEP(Local4[Local2][4])
ENDIF
IF Local4[Local2][5] <> Nil
Local8:FOOTSEP(Local4[Local2][5])
ENDIF
IF Local4[Local2][6] <> Nil
Local8:FOOTING(Local4[Local2][6])
ENDIF
Local1:ADDCOLUMN(Local8)
NEXT
RETURN Local1

********************************
FUNCTION CALLUSER(Arg1,Arg2,Arg3)

LOCAL Local1,Local2,Local3,Local4
IF Arg3 <> 0
Local1:=4
ELSEIF !Static12 .AND. EMPTYFILE()
Local1:=3
ELSEIF Arg1:HITBOTTOM()
Local1:=2
ELSEIF Arg1:HITTOP()
Local1:=1
ELSE
Local1:=0
ENDIF
DO WHILE !Arg1:STABILIZE()
ENDDO
Local3:=RECNO()
IF VALTYPE(Arg2) <> "C" .OR. EMPTY(Arg2)
IF Arg3 == 13 .OR. Arg3 == 27
Local2:=0
ELSE
Local2:=1
ENDIF
ELSE
Local2:=&Arg2(Local1,Arg1:COLPOS())
ENDIF
Local4:=Local2 <> 0
IF !Static12 .AND. EOF() .AND. !EMPTYFILE()
SKIP -1
ENDIF
IF Local2 == 3
Static12:=!(Static12 .AND. EOF())
IF Static12
GOTO BOTTOM
Arg1:DOWN()
ELSE
Arg1:REFRESHCURRENT()
ENDIF
Static13:=.F.
ELSEIF Local2 == 2 .OR. Local3 <> RECNO()
IF Local4
Static12:=.F.
IF SET(_SET_DELETED) .AND. DELETED() .OR. !EMPTY(DBFILTER()) .AND. !&(DBFILTER())
SKIP
ENDIF
IF EOF()
GOTO BOTTOM
ENDIF
Local3:=RECNO()
Arg1:REFRESHALL()
DO WHILE !Arg1:STABILIZE()
ENDDO
DO WHILE Local3 <> RECNO()
Arg1:UP()
DO WHILE !Arg1:STABILIZE()
ENDDO
ENDDO
Static13:=.F.
ENDIF
ELSE
Arg1:REFRESHCURRENT()
ENDIF
RETURN Local4

********************************
FUNCTION SKIPPED(Arg1)

LOCAL Local1
Local1:=0
IF LASTREC() <> 0
IF Arg1 == 0
IF EOF() .AND. !Static12
SKIP -1
Local1:=-1
ELSE
SKIP 0
ENDIF
ELSEIF Arg1 > 0 .AND. RECNO() <> LASTREC()+1
DO WHILE Local1 < Arg1
SKIP
IF EOF()
IF Static12
Local1++
ELSE
SKIP -1
ENDIF
EXIT
ENDIF
Local1++
ENDDO
ELSEIF Arg1 < 0
DO WHILE Local1 > Arg1
SKIP -1
IF BOF()
EXIT
ENDIF
Local1--
ENDDO
ENDIF
ENDIF
RETURN Local1


FUNCTION EMPTYFILE

IF LASTREC() == 0
RETURN .T.
ENDIF
IF (EOF() .OR. RECNO() == LASTREC()+1) .AND. BOF()
RETURN .T.
ENDIF
RETURN .F.

********************************

Código: Selecionar todos

DBEDIT( 07, 06, 16, 73, , "LER_ARQ", , PSQ_NOME, "ÄÂÄ", " ³ ", "ÄÁÄ" )