PC Toledo

Código: Selecionar todos

@ 06,08 SAY " Nome Completo.........:" GET v_nome PICT "@!" WHEN FGMSG("Digite o nome completo") VALID (IF(VINI=.T.,VAL_NOM(v_nome),.T.))
read

FUNCTION VAL_NOM(v_nome)
VRET=.T.
IF EMPTY(ALLTRIM(v_nome))
   MENSAGEM("Informe o nome. N„o pode ficar em branco !",3)
   RETURN .F.
ENDIF
TELA_SEL:=SAVESCREEN(00,00,24,79)
VQREC=RECNO()
SET CURSOR OFF
SET ORDER TO 2
SEEK v_nome
DO WHILE (1->NOME)=v_nome
   IF (RECNO()=VQREC)
      SKIP
      LOOP
   ENDIF
   IF (1->NOME)=v_nome
      BEEP()
      MOSTRA_FICHA(" Ficha do Cliente (Nome Repetido)")
      RES_POSTA="S"
      PER_COR := SETCOLOR()
      CURSOR( DESLIGA )
      SIM_NAO := 1
      SETCOLOR(CONTECOR[11])
      @ 15,12 CLEAR TO 19,68
      SOMBRA(15,13,19,70)
      @ 16,15 SAY "Existe cliente com mesmo nome.  o mesmo cliente ?" COLOR CONTECOR[11]
      botao:ADD( 18, 25, "Sim     " )
      botao:ADD( 18, 46, "N„o     " )
      SIM_NAO := botao:RODA()
      RESTSCREEN(00,00,24,79,TELA_SEL)
      SETCOLOR( PER_COR )
      IF SIM_NAO=1
	 KEYBOARD CHR(25)
	 READUPDATED(.F.)
	 VRET=.F.
	 EXIT
      ELSE
	 VRET=.T.
      ENDIF
      SKIP
   ENDIF
ENDDO

SELE 3
SET ORDER TO 2
SEEK v_nome
DO WHILE (3->NOME)=v_nome
   BEEP()
   MOSTRA_FICHA(" Ficha do Cliente (Inativos)")
   RES_POSTA="S"
   PER_COR := SETCOLOR()
   CURSOR( DESLIGA )
   SIM_NAO := 1
   SETCOLOR(CONTECOR[11])
   @ 15,12 CLEAR TO 20,68
   SOMBRA(15,13,20,70)
   @ 16,15 SAY "Existe cliente com mesmo nome no arquivo de INATIVOS." COLOR CONTECOR[11]
   @ 17,20 SAY "Se ‚ o mesmo cliente, deseja recuperar ?" COLOR CONTECOR[11]
   botao:ADD( 19, 25, "Sim     " )
   botao:ADD( 19, 46, "N„o     " )
   SIM_NAO := botao:RODA()
   RESTSCREEN(00,00,24,79,TELA_SEL)
   SETCOLOR( PER_COR )

   IF SIM_NAO=1
      SELE 1
      VQR=RECNO()
      XCLI=VCLI
      VCL=(3->CLIENTE)
      VCLI=STRZERO(VCL,4,0)
      VARQ1:=VDIR+"\INATIVOS\MEMOS\OBS_"+VCLI+".TXT"
      VARQ2:=VDIR+"\MEMOS\OBS_"+VCLI+".TXT"
      IF FILE(VARQ1)
	 COPY FILE (VARQ1) TO (VARQ2)
	 DELETE FILE (VARQ1)
      ENDIF
      VARQ1:=VDIR+"\INATIVOS\MEMOS\REC_"+VCLI+".TXT"
      VARQ2:=VDIR+"\MEMOS\REC_"+VCLI+".TXT"
      IF FILE(VARQ1)
	 COPY FILE (VARQ1) TO (VARQ2)
	 DELETE FILE (VARQ1)
      ENDIF
      VQREC=RECNO()
      SELE 1
      SET ORDER TO 1
      SEEK STRZERO(VCL,4,0)
      IF FOUND()
	 JATEM=XCLI
      ELSE
	 JATEM=STRZERO(VCL,4,0)
      ENDIF
      RECUPCLI(VCL,JATEM)
      RECUPAUT(VCL,JATEM)

      VNCL=VAL(XCLI)
      VSUBDIR1="\FICH"+STRZERO((IF(((CEILING((VCL/100)))*100)>9999,0,((CEILING((VCL/100)))*100))),4,0)
      VSUBDIR2="\FICH"+STRZERO((IF(((CEILING((VNCL/100)))*100)>9999,0,((CEILING((VNCL/100)))*100))),4,0)
      DIRMAKE(VDIR+VSUBDIR2)
      VARQ1:=VDIR+"\INATIVOS"+VSUBDIR1+"\MOV"+STRZERO(VCL,4,0)+".DBF"
      VARQ2:=VDIR+VSUBDIR2+"\MOV"+STRZERO(VNCL,4,0)+".DBF"
      IF FILE(VARQ1)
	 COPY FILE (VARQ1) TO (VARQ2)
	 DELETE FILE (VARQ1)
      ENDIF
      VARQ1:=VDIR+"\INATIVOS"+VSUBDIR1+"\LOCA"+STRZERO(VCL,4,0)+".DBF"
      VARQ2:=VDIR+VSUBDIR2+"\LOCA"+STRZERO(VNCL,4,0)+".DBF"
      IF FILE(VARQ1)
	 COPY FILE (VARQ1) TO (VARQ2)
	 DELETE FILE (VARQ1)
      ENDIF
      SELE 3
      IF BLOQREG(20)
	 DELETE
         DESBLOQ()
      ENDIF
      // KEYBOARD CHR(25)
      // READUPDATED(.F.)
      VRET=.F.
      ALERT("Recupera‡„o do cliente, com sucesso !.")
      KEYBOARD CHR(27)+CHR(27)+CHR(27)
      EXIT
   ELSE
     VRET=.T.
   ENDIF
   SKIP
ENDDO
SELE 1
SET ORDER TO 1
SET CURSOR ON
GOTO VQREC
IF VRET=.T.
   v_nome=v_nome+CHR(255)
ENDIF
RETURN VRET

==============

IF VQMUDOU(XTIT1,XTIT2)=.F.
			    JANELA(06,08,19,72,"Mudan‡a de t¡tulo interrompida")
			    @ 19,16 SAY "Pressione qualquer tecla ou <F10> efetiva mudan‡a" COLOR CONTECOR[05]
			    @ 07,09 SAY PADR(" Este t¡tulo j  foi locado "+(IF(VVEZES=1,"uma vez",ALLTRIM(STR(VVEZES))+" vezes"))+", e a mudan‡a deste t¡tulo",63) COLOR "W+/R"
			    @ 08,09 SAY " pode implicar em resultados incorretos.                       " COLOR "W+/R"
			    @ 09,09 SAY " Como por exemplo, avisar que o filme j  foi locado  e n„o ser " COLOR "W+/R"
			    @ 10,09 SAY " o mesmo filme.                                                " COLOR "W+/R"
			    @ 11,09 SAY "                                                               " COLOR "W+/R"
			    @ 12,09 SAY " Devido que o sistema considera que o t¡tulo est  sendo mudado " COLOR "W+/R"
			    @ 13,09 SAY " radicalmente  e  caso deseje efetivar esta mudan‡a, pressione " COLOR "W+/R"
                            @ 14,09 SAY " <F10> para confirmar esta opera‡„o.                           " COLOR "W+/R"
			    @ 15,09 SAY " Por‚m, se o seu objetivo ‚ substituir este t¡tulo por  outro, " COLOR "W+/R"
			    @ 16,09 SAY " aconselhamos  a  deletar  este  t¡tulo  e fazer a inclus„o do " COLOR "W+/R"
			    @ 17,09 SAY " outro,   para   que  o  sistema  execute  o  procedimento  de " COLOR "W+/R"
			    @ 18,09 SAY " aproveitamento dos n£meros.                                   " COLOR "W+/R"
                            VK:=INKEY(0)
                            IF !(VK=-9)
                               XTIT2:=""
                            ENDIF
                         ENDIF
			 IF !(XTIT1==XTIT2) .AND. !EMPTY(ALLTRIM(XTIT2))
			    IF BLOQREG(20)
			       REPLACE TITULO WITH XTIT2
                               DESBLOQ()
			    ENDIF
			 ELSE
			    IF !(XTIT1==XTIT2)
			       BEEP()
			       MENSAGEM("Aten‡„o: N„o ‚ mais poss¡vel alterar este T¡tulo !",5)
			    ENDIF
			 ENDIF
		      ELSE
                         IF (14->NIVEL)=2
                            IF BLOQREG(20)
                               REPLACE TITULO WITH XTIT2
                               DESBLOQ()
                            ENDIF
                         ELSE
                            BEEP()
                            MENSAGEM("Altera‡„o do t¡tulo, n„o autorizada !",3)
                         ENDIF
		      ENDIF

FUNCTION VQMUDOU(VTIT1,VTIT2)
Local VPALA1,VPALA2,VQNEN,VTXT,VQTM
/*
Separar em palavras e contar as letras que nao coincidem
nas palavras nao achadas
*/
VQNEN:={}
VPALA1:={}
VENQUAN=.T.
VTXT:=ALLTRIM(VTIT1)
DO WHILE VENQUAN
   VP:=AT(" ",VTXT)
   IF VP=0
      VENQUAN=.F.
      IF LEN(VTXT)>0
	 AADD(VPALA1,VTXT)
	 AADD(VQNEN,0)
	 EXIT
      ENDIF
   ENDIF
   AADD(VPALA1,SUBSTR(VTXT,1,VP-1))
   AADD(VQNEN,0)
   VTXT:=ALLTRIM(SUBSTR(VTXT,VP,LEN(VTXT)))
ENDDO
VPALA2:={}
VENQUAN=.T.
VTXT:=ALLTRIM(VTIT2)
DO WHILE VENQUAN
   VP:=AT(" ",VTXT)
   IF VP=0
      VENQUAN=.F.
      IF LEN(VTXT)>0
	 AADD(VPALA2,VTXT)
	 IF LEN(VPALA2)>LEN(VPALA1)
	    // AADD(VQNEN,LEN(VPALA2))
	    AADD(VQNEN,0)
	 ENDIF
	 EXIT
      ENDIF
   ENDIF
   AADD(VPALA2,SUBSTR(VTXT,1,VP-1))
   IF LEN(VPALA2)>LEN(VPALA1)
      // AADD(VQNEN,LEN(VPALA2))
      AADD(VQNEN,0)
   ENDIF
   VTXT:=ALLTRIM(SUBSTR(VTXT,VP,LEN(VTXT)))
ENDDO
FOR VQ1=1 TO LEN(VPALA1)
    FOR VQ2=1 TO LEN(VPALA2)
	IF VPALA2[VQ2]=VPALA1[VQ1] .AND. VQNEN[VQ2]=0
	   VQNEN[VQ1]:=VQ2
	   EXIT
	ENDIF
    NEXT
NEXT

VQTM:=0
FOR VQI=1 TO LEN(VQNEN)
    IF VQNEN[VQI]=0
       VQQ=0
       FOR VQM=1 TO LEN(VPALA2[(LEN(VPALA2))])
	   IF LEN(VPALA1)>=VQI .AND. LEN(VPALA2)>=VQI
	      IF SUBSTR(VPALA1[VQI],1,VQM) $ VPALA2[VQI]
		 VQQ:=VQQ+1
	      ENDIF
	   ENDIF
       NEXT
       IF LEN(VPALA1)>=VQI
	  IF (LEN(VPALA1[VQI])/2)>1
	     IF (LEN(VPALA1[VQI])/2)>=VQQ
		VQNEN[VQI]:=VQI
	     ELSE
		VQTM:=VQTM+1
	     ENDIF
	  ELSE
	     VQTM:=VQTM+1
	  ENDIF
       ELSE
	  VQTM:=VQTM+1
       ENDIF
    ENDIF
NEXT
IF (LEN(VQNEN)/4)>=VQTM
   VRET:=.T.
ELSE
   VRET:=.F.
ENDIF
RETURN VRET