diff --git a/README b/README new file mode 100644 index 0000000..e69de29 diff --git a/master.prg b/master.prg new file mode 100644 index 0000000..0cde3a0 --- /dev/null +++ b/master.prg @@ -0,0 +1,2371 @@ +*ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ +*³šššššššššššššššššššššš MASTER.LIB - Vers„o 1.0 šššššššššššššššššššššš³ +*ĆÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ +*³ ³ +*³ ³ +*³ Autores............: Wagner Longo Castro, Osvaldo Santana Neto, ³ +*³ Eduardo Guimar„es Zola ³ +*³ ³ +*³ ³ +*³ Empresa............: Teenagers Associates ³ +*³ ³ +*³ ³ +*ĆÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ +*³ ³ ³ +*³ Data de Cria‡„o....: 15/05/92 ³ Ultima Atualiza‡„o.: 21/09/92 ³ +*³ ³ ³ +*ĆÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĮÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ +*³ ³ +*³ Biblioteca de Fun‡”es para Clipper ³ +*³ ³ +*ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ + + + +*---------------------> PROCEDURES E FUNCOES DE INTERFACE <-------------------* + +PROCEDURE LEFT_ARROW +KEYBOARD CHR(27)+CHR(19)+CHR(13) +RETURN + +PROCEDURE RIGHT_ARROW +KEYBOARD CHR(27)+CHR(4)+CHR(13) +RETURN + +FUNCTION MENU_1 +PRIVATE MDO,ELM_2,POS_1,ELM +PARAMETERS MDO,ELM_2,POS_1 +ELM = ROUND(ELM_2/(LEN(MTC)/(LY2-LY1+1)),0) +ELM = IF(ELM=0,1,ELM) +IF TYPE("ELM_1") = "L" + ELM_1 = ELM + SETCOLOR(CR0) + @ LY1,CXA SAY CHR(CR2) +ENDIF +SETCOLOR(CR4) +IF ELM_2 < 2 + @ LY1-1,CXA SAY CHR(25) +ELSE + @ LY1-1,CXA SAY CHR(24) +ENDIF +IF ELM_2 < LEN(MTC) + @ LY2+1,CXA SAY CHR(25) +ELSE + @ LY2+1,CXA SAY CHR(24) +ENDIF +SETCOLOR(CR3) +IF ELM <> 0 + @ ELM+(LY1-1),CXA SAY CHR(CR1) +ENDIF +IF ELM <> ELM_1 + SETCOLOR(CR0) + @ ELM_1+(LY1-1),CXA SAY CHR(CR2) +ENDIF +ELM_1 = ELM +SETCOLOR(CR0) +DO CASE + CASE LASTKEY() = 27 + RETURN(0) + CASE LASTKEY() = 13 + RETURN(1) +ENDCASE +RETURN (23) + +FUNCTION MENU_2 +PRIVATE MDO,PSA,PSR,V_L +PARAMETERS MDO,PSA,PSR +LST = LASTKEY() +DO CASE + CASE MDO = 0 + IF LST = 24 .AND. PSR = ANT + SCROLL(L1,C3,L2,C3,1) + @ L1+PSR,C3 SAY IF(MT2[PSA],SW1,SW2)+; + SPACE(SPC-LEN(IF(MT2[PSA],SW1,SW2))) + ELSEIF LST = 5 .AND. PSR = ANT + SCROLL(L1,C3,L2,C3,-1) + @ L1+PSR,C3 SAY IF(MT2[PSA],SW1,SW2)+; + SPACE(SPC-LEN(IF(MT2[PSA],SW1,SW2))) + ENDIF + ANT = PSR + V_L = 2 + CASE MDO = 1 + V_L = 2 + CASE MDO = 2 + V_L = 2 + CASE MDO = 3 + DO CASE + CASE LST = 19 .OR. LST = 4 + V_L = 2 + CASE LST >= 65 .AND. LST <= 122 + V_L = 3 + CASE LST = 32 + MT2[PSA] = .NOT. MT2[PSA] + @ L1+PSR,C3 SAY IF(MT2[PSA],SW1,SW2)+; + SPACE(SPC-LEN(IF(MT2[PSA],SW1,SW2))) + V_L = 2 + CASE LST = 13 + V_L = 1 + OTHERWISE + V_L = 0 + ENDCASE +ENDCASE +RETURN (V_L) + +PROCEDURE MENU_3 +PRIVATE SVT,KEY +X = X1 +Y = Y1 +DO WHILE .T. + SVT=SAVESCREEN(Y,X,Y2,X2) + KEY = INKEY(0) + DO CASE + CASE KEY = 5 .AND. Y1>0 + Y1=Y1-1 + Y3=Y3-1 + CASE KEY = 24 .AND. Y2<24 + Y1=Y1+1 + Y3=Y3+1 + CASE KEY = 4 .AND. X2<79 + X1=X1+1 + X3=X3+1 + CASE KEY = 19 .AND. X1>0 + X1=X1-1 + X3=X3-1 + CASE KEY = -9 + EXIT + ENDCASE + X2 = X1+DX + Y2 = Y1+DY + RESTORE SCREEN FROM TLX + RESTSCREEN(Y1,X1,Y2,X2,SVT) + X = X1 + Y = Y1 +ENDDO +X = X3 +Y = Y3 +KEYBOARD CHR(23) +RETURN + +PROCEDURE STAT_1 +PRIVATE SY,SX,OP +PARAMETERS SY,SX,OP +@ SY,SX SAY DTOC(DATE())+SPACE(64)+TIME() +RETURN + +FUNCTION BUTTON_1 +PRIVATE CV,CVT,Y,X +PARAMETERS Y,X +CV = TRIM(SUBSTR(CB,AT("/",CB)+1,3)) +CVT = CV+"/"+CV +SETCOLOR(CVT) +@ Y,X+3 SAY CHR(220) +@ Y+1,X+1 SAY REPLICATE(CHR(223),3) +SETCOLOR("N/"+CV) +INKEY(0.09) +@ Y,X+3 SAY CHR(220) +@ Y+1,X+1 SAY REPLICATE(CHR(223),3) +SETCOLOR(CB) +RETURN(.F.) + +FUNCTION PUSH +PRIVATE TCL +PARAMETERS TCL +IF READINSERT() = .T. + KEYBOARD CHR(22)+CHR(TCL)+CHR(22) +ELSE + KEYBOARD CHR(TCL) +ENDIF +RETURN(.F.) + +FUNCTION EXT_1 +PRIVATE VLR,V1,V2,V3,EXT +PARAMETER VLR +V1 = VAL(SUBSTR(STR(VLR,3),1,1)) +V2 = VAL(SUBSTR(STR(VLR,3),2,1)) +V3 = VAL(SUBSTR(STR(VLR,3),3,1)) +EXT = "" +IF V1 > 0 + EXT = IF(V1=1 .AND. (V2<>0 .OR. V3<>0),"CENTO",; + TRIM(SUBSTR(CNT,(V1-1)*12+1,12))) +ENDIF +IF V2 > 0 + EXT = IF(VLR>99,EXT+" E ",EXT) + EXT = EXT + IF(V2=1 .AND. V3>0,TRIM(SUBSTR(DZ2,(V3-1)*12+1,12)),; + TRIM(SUBSTR(DZ1,(V2-1)*12+1,12))) +ENDIF +IF V3 > 0 .AND. V2 <> 1 + EXT = IF(V1<>0 .OR. V2<>0,EXT+" E ",EXT) + TRIM(SUBSTR(UND,(V3-1)*12+1,12)) +ENDIF +RETURN(EXT) + +*********************-> FUNCOES ESPECIAIS - MASTER.LIB <-********************** + +* FUNCOES ESPECIAIS P/ TELAS * + +FUNCTION CENTER +PRIVATE LIN,MSG,COL,COL1,COL2 +IF PCOUNT() = 2 + PARAMETERS LIN,MSG + COL = INT((80-LEN(MSG))/2) +ELSEIF PCOUNT() = 4 + PARAMETERS LIN,MSG,COL1,COL2 + COL = COL1+INT((COL2-COL1+1-LEN(MSG))/2) +ENDIF +@ LIN,COL SAY MSG +RETURN(.F.) + +FUNCTION MOVESCREEN +PRIVATE L1,C1,L2,C2,L3,C3,TL,DW,LF,SCR1,TE +STORE 0 TO TE +PARAMETERS L1,C1,L2,C2,L3,C3,TL,TE +DW = IF(L1L3 .OR. C1<>C3 + RESTORE SCREEN FROM TL + IF L1 * DW < L3 * DW + L1 = L1 + DW + L2 = L2 + DW + ENDIF + IF C1 * LF < C3 * LF + C1 = C1 + LF + C2 = C2 + LF + ENDIF + RESTSCREEN(L1,C1,L2,C2,SCR1) + DELAY(TE) +ENDDO +RETURN (.F.) + +FUNCTION EXPLODE +PRIVATE L1,C1,L2,C2,FM,L3,C3,L4,C4,TP,EA,ESC,TE +STORE 1 TO TP +STORE 0 TO TE +PARAMETERS L1,C1,L2,C2,FM,ESC,TP,TE +L3 = (L2 - L1) + 1 +C3 = (C2 - C1) + 1 +EA = IF(L3>C3,L3/C3,C3/L3) +ESC = IF(TYPE("ESC")="U",1,IF(ESC=0,EA,ESC)) +L3 = L3/2 + L1 +C3 = C3/2 + C1 +L4 = L3 +C4 = C3 +DO CASE +CASE TP = 0 + @ L1,C1,L2,C2 BOX FM +CASE TP = 1 + DO WHILE L4<>L2 .OR. C4<>C2 .OR. L3<>L1 .OR. C3<>C1 + L3 = IF(L3-1>L1,L3-1,L1) + C3 = IF(C3-ESC>C1,C3-ESC,C1) + L4 = IF(L4+1L2 .OR. C3<>C2 + L3 = IF(L3+1L2 .OR. C3<>C1 + L3 = IF(L3+1C1,C3-ESC,C1) + @ L1,C3,L3,C2 BOX FM + DELAY(TE) + ENDDO +CASE TP = 4 + L3 = L2 + C3 = C1 + DO WHILE L3<>L1 .OR. C3<>C2 + L3 = IF(L3-1>L1,L3-1,L1) + C3 = IF(C3+ESCL1 .OR. C3<>C1 + L3 = IF(L3-1>L1,L3-1,L1) + C3 = IF(C3-ESC>C1,C3-ESC,C1) + @ L3,C3,L2,C2 BOX FM + DELAY(TE) + ENDDO +ENDCASE +RETURN (.F.) + +FUNCTION IMPLODE +PRIVATE L1,C1,L2,C2,FM,TL,L3,C3,ESC,TE,EA +STORE 0 TO TE +PARAMETERS L1,C1,L2,C2,FM,TL,ESC,TE +L3 = (L2 - L1) + 1 +C3 = (C2 - C1) + 1 +EA = IF(L3>C3,L3/C3,C3/L3) +ESC = IF(TYPE("ESC")="U",1,IF(ESC=0,EA,ESC)) +L3 = L3/2 + L1 +C3 = C3/2 + C1 +DO WHILE L1<>L3 .OR. C1<>C3 .OR. L2<>L3 .OR. C2<>C3 + L1 = IF(L1L3,L2-1,L3) + C2 = IF(C2-ESC>C3,C2-ESC,C3) + DELAY(TE/2) + IF LEN(TL) >= 3999 + RESTSCREEN(00,00,24,79,TL) + ELSE + RESTSCREEN(L1,C1,L2,C2,TL) + ENDIF + @ L1,C1,L2,C2 BOX FM + DELAY(TE/2) +ENDDO +IF LEN(TL) >= 3999 + RESTSCREEN(00,00,24,79,TL) +ELSE + RESTSCREEN(L1,C1,L2,C2,TL) +ENDIF +RETURN (.F.) + +FUNCTION EXPLODESCR +PRIVATE L1,C1,L2,C2,TL,L3,C3,L4,C4,TP,EA,ESC,TE +STORE 1 TO TP +STORE 0 TO TE +PARAMETERS L1,C1,L2,C2,TL,ESC,TP,TE +L3 = (L2 - L1) + 1 +C3 = (C2 - C1) + 1 +EA = IF(L3>C3,L3/C3,C3/L3) +ESC = IF(TYPE("ESC")="U",1,IF(ESC=0,EA,ESC)) +L3 = L3/2 + L1 +C3 = C3/2 + C1 +L4 = L3 +C4 = C3 +DO CASE +CASE TP = 0 + RESTSCREEN(L1,C1,L2,C2,SECTORSCR(TL,L1,C1,L2,C2)) +CASE TP = 1 + DO WHILE L4<>L2 .OR. C4<>C2 .OR. L3<>L1 .OR. C3<>C1 + L3 = IF(L3-1>L1,L3-1,L1) + C3 = IF(C3-ESC>C1,C3-ESC,C1) + L4 = IF(L4+1L2 .OR. C3<>C2 + L3 = IF(L3+1L2 .OR. C3<>C1 + L3 = IF(L3+1C1,C3-ESC,C1) + RESTSCREEN(INT(L1),INT(C3),INT(L3),INT(C2),; + SECTORSCR(TL,INT(L1),INT(C3),INT(L3),INT(C2))) + DELAY(TE) + ENDDO +CASE TP = 4 + L3 = L2 + C3 = C1 + DO WHILE L3<>L1 .OR. C3<>C2 + L3 = IF(L3-1>L1,L3-1,L1) + C3 = IF(C3+ESCL1 .OR. C3<>C1 + L3 = IF(L3-1>L1,L3-1,L1) + C3 = IF(C3-ESC>C1,C3-ESC,C1) + RESTSCREEN(INT(L3),INT(C3),INT(L2),INT(C2),; + SECTORSCR(TL,INT(L3),INT(C3),INT(L2),INT(C2))) + DELAY(TE) + ENDDO +ENDCASE +RETURN (.F.) + +FUNCTION IMPLODESCR +PRIVATE L1,C1,L2,C2,TLX,TL,L3,C3,ESC,TE,EA +STORE 0 TO TE +PARAMETERS L1,C1,L2,C2,TLX,TL,ESC,TE +L3 = (L2 - L1) + 1 +C3 = (C2 - C1) + 1 +EA = IF(L3>C3,L3/C3,C3/L3) +ESC = IF(TYPE("ESC")="U",1,IF(ESC=0,EA,ESC)) +L3 = L3/2 + L1 +C3 = C3/2 + C1 +DO WHILE L1<>L3 .OR. C1<>C3 .OR. L2<>L3 .OR. C2<>C3 + L1 = IF(L1L3,L2-1,L3) + C2 = IF(C2-ESC>C3,C2-ESC,C3) + DELAY(TE/2) + IF LEN(TL) >= 3999 + RESTSCREEN(00,00,24,79,TL) + ELSE + RESTSCREEN(L1,C1,L2,C2,TL) + ENDIF + RESTSCREEN(INT(L1),INT(C1),INT(L2),INT(C2),; + SECTORSCR(TLX,INT(L1),INT(C1),INT(L2),INT(C2))) + DELAY(TE/2) +ENDDO +IF LEN(TL) >= 3999 + RESTSCREEN(00,00,24,79,TL) +ELSE + RESTSCREEN(L1,C1,L2,C2,TL) +ENDIF +RETURN (.F.) + +FUNCTION TEXTBOX +PRIVATE L1,C1,L2,C2,TXT +PARAMETERS L1,C1,L2,C2,TXT +TXT = REPLICATE(TXT,(C2-C1+1)*(L2-L1)) +TMC = C2 - C1 + 1 +TML = L2 - L1 +FOR IC = 0 TO TMC-1 + @ L1,C1+IC SAY SUBSTR(TXT,IC+1,1) + @ L2,C2-IC SAY SUBSTR(TXT,TMC+TML+IC,1) +NEXT +FOR IC = 0 TO TML-1 + @ L1+IC,C2 SAY SUBSTR(TXT,TMC+IC,1) + @ L2-IC,C1 SAY SUBSTR(TXT,2*TMC+TML+IC-1,1) +NEXT +RETURN(.T.) + +FUNCTION RIGHTSCR +PRIVATE TL,TL2,Y1,Y2,X,PS,TL1 +PS = 5 +Y1 = 0 +Y2 = 24 +PARAMETERS TL,TL2,PS,Y1,Y2 +FOR X=0 TO 79 STEP PS + TL1=SECTORSCR(TL,Y1,0,Y2,79-X) + IF X<>0 + RESTSCREEN(Y1,0,Y2,X-1,SECTORSCR(TL2,Y1,80-X,Y2,79)) + ENDIF + RESTSCREEN(Y1,X,Y2,79,TL1) +NEXT +RESTSCREEN(Y1,0,Y2,79,SECTORSCR(TL2,Y1,0,Y2,79)) +RETURN(.F.) + +FUNCTION LEFTSCR +PRIVATE TL,TL2,Y1,Y2,X,PS,TL1 +PS = 5 +Y1 = 0 +Y2 = 24 +PARAMETERS TL,TL2,PS,Y1,Y2 +FOR X=79 TO 0 STEP -PS + TL1=SECTORSCR(TL2,Y1,0,Y2,79-X) + RESTSCREEN(Y1,0,Y2,X-1,SECTORSCR(TL,Y1,80-X,Y2,79)) + RESTSCREEN(Y1,X,Y2,79,TL1) +NEXT +RESTSCREEN(Y1,0,Y2,79,SECTORSCR(TL2,Y1,0,Y2,79)) +RETURN(.F.) + +FUNCTION SHADOW +PRIVATE CR0,CR1,L1,C1,L2,C2,ATTR,NLEN,SVT +CR0 = 7 +CR1 = 0 +PARAMETERS L1,C1,L2,C2,CR0,CR1 +ATTR = (CR1*16)+CR0 +NLEN = (C2 - C1 + 1) * (L2 - L1 + 1) + (C2 - C1) +IF NLEN > 960 + RETURN(.F.) +ENDIF +SVT = SAVESCREEN(L1,C1,L2,C2) +RESTSCREEN(L1,C1,L2,C2,TRANSFORM(SVT,REPLICATE("X"+CHR(ATTR),NLEN))) +RETURN (.T.) + +FUNCTION CCOLOR +PRIVATE SVT,RET,F,L1,C1,L2,C2,AT +PARAMETERS L1,C1,L2,C2,AT +SVT = SAVESCREEN(L1,C1,L2,C2) +RET = "" +FOR F = 1 TO LEN(SVT) STEP 2 + RET = RET + SUBSTR(SVT,F,1) + CHR(AT) +NEXT +RESTSCREEN(L1,C1,L2,C2,RET) +RETURN(.T.) + +FUNCTION BORDER +PRIVATE L1,C1,L2,C2,FT +STORE 8 TO FT +PARAMETERS L1,C1,L2,C2,FT +SHADOW(L1+1,C2+1,L2+1,C2+2,FT) +SHADOW(L2+1,C1+2,L2+1,C2+2,FT) +RETURN(.T.) + +FUNCTION SECTORSCR +PRIVATE TALL,Y1,X1,Y2,X2,LN,BUF +LN = 80 +PARAMETERS TALL,Y1,X1,Y2,X2,LN +LN = LN*2 +BUF = "" +D1 = X1*2+1 +D2 = (X2-X1+1)*2 +FOR Y3=Y1 TO Y2 + BUF=BUF+SUBSTR(TALL,Y3*LN+D1,D2) +NEXT +RETURN(BUF) + +FUNCTION WINDOWSCR +PRIVATE TELA,L1,C1,L2,C2,L3,C3,L4,C4,KEY,STAT +STORE "" TO STAT +PARAMETERS TELA,L3,C3,L4,C4,STAT +SET CURSOR OFF +L1 = 0 +C1 = 0 +L2 = L4-L3 +C2 = C4-C3 +KEYBOARD CHR(32) +DO WHILE .T. + KEY = INKEY(0) + DO CASE + CASE KEY = 5 .AND. L1 > 0 + L1 = L1 - 1 + L2 = L2 - 1 + CASE KEY = 24 .AND. L2 < 24 + L1 = L1 + 1 + L2 = L2 + 1 + CASE KEY = 19 .AND. C1 > 0 + C1 = C1 - 1 + C2 = C2 - 1 + CASE KEY = 4 .AND. C2 < 79 + C1 = C1 + 1 + C2 = C2 + 1 + CASE KEY = 13 .OR. KEY = 27 + EXIT + ENDCASE + RESTSCREEN(L3,C3,L4,C4,SECTORSCR(TELA,L1,C1,L2,C2)) + IF .NOT. EMPTY(STAT) + DO &STAT. WITH L1,C1,KEY + ENDIF +ENDDO +RETURN(.T.) + +FUNCTION GRAPHSCR +PRIVATE TL1,TL2,PRC,CMT,PCM,NCL,ESC,PCM_1,NM_1,NM_2,AT_1,NM_3,TMB +TMB = 7 +PCM = 100 +PARAMETERS TL1,TL2,PRC,CMT,PCM,NCL,TMB +ESC = PCM / 5 +PCM_1 = PCM +FOR NM_1 = 1 TO 20 STEP 4 + @ NM_1,0 SAY STR(PCM_1,4) + PCM_1 = PCM_1 - ESC +NEXT +FOR NM_1 = 1 TO 20 + @ NM_1,5 SAY CHR(179) +NEXT +@ NM_1,5 SAY CHR(192)+REPLICATE(CHR(196),(TMB+3)*NCL) +NM_2 = 7-(TMB+2) +FOR NM_1 = 1 TO NCL + AT_1 = 20 - (INT(PRC[NM_1] * 20 / PCM)) + 1 + @ 22,NM_2 + (TMB+2) SAY CMT[NM_1] + FOR NM_3 = 20 TO AT_1 STEP -1 + @ NM_3,NM_2 + (TMB+2) SAY REPLICATE(CHR(175+NM_1),TMB) + NEXT + @ NM_3,NM_2 + (TMB+2) SAY STR(PRC[NM_1],TMB) + NM_2 = NM_2 + (TMB+2) +NEXT +CENTER(23,TRIM(UPPER(TL1))) +CENTER(24,TRIM(UPPER(TL2))) +RETURN(0) + +FUNCTION WORDSCR +PRIVATE LN,CL,TL,ME,PI,F,ME,TE,TP +TP = 1 +PARAMETERS LN,CL,TL,TE,TP +ME = ROUND(LEN(TL)/2,0) +CL = CL + ME - 1 +PI = IF(LEN(TL)/2 = INT(LEN(TL)/2),1,0) +IF TP = 1 + FOR F = 1 TO ME + @ LN,CL-F+1 SAY LEFT(TL,F) + @ LN,CL+PI SAY RIGHT(TL,F) + DELAY(TE) + NEXT +ELSEIF TP = 2 + FOR F = 0 TO LEN(TRIM(TL)) + @ LN,CL+F SAY SUBSTR(TL,F+1,1) + DELAY(TE) + NEXT +ENDIF +RETURN(.T.) + +FUNCTION WRITESCR +PRIVATE MSG,Y,X,PO,ME,T,LETR,TE +TE = 0 +PARAMETERS MSG,Y,X,PO,TE +ME = ROUND(LEN(MSG)/2,0) +IF PO = 1 + @ Y,(X-ME)+1 SAY MSG + RETURN(0) +ENDIF +FOR T = 1 TO LEN(MSG) + LETR = SUBSTR(MSG,T,1) + DO CASE + CASE PO = 2 + @ (Y-ME)+T,(X-ME)+T SAY LETR + CASE PO = 3 + @ (Y-ME)+T,X SAY LETR + CASE PO = 4 + @ (Y-ME)+T,(X+ME)-T SAY LETR + CASE PO = 5 + @ Y,(X+ME)-T SAY LETR + CASE PO = 6 + @ (Y+ME)-T,(X+ME)-T SAY LETR + CASE PO = 7 + @ (Y+ME)-T,X SAY LETR + CASE PO = 8 + @ (Y+ME)-T,(X-ME)+T SAY LETR + ENDCASE + DELAY(TE) +NEXT +RETURN(0) + +FUNCTION ADDP +PRIVATE LX,LY,DEF +PARAMETERS LX,LY,DEF +IF .NOT. "A" $ TYPE("MST_PIC") + PUBLIC MST_PIC[30] +ENDIF +IF TYPE("MST_IPIC") <> "N" + PUBLIC MST_IPIC + MST_IPIC = 1 +ENDIF +IF MST_IPIC > 30 .OR. LX > 40 .OR. LY > 12 + RETURN(.F.) +ENDIF +MST_PIC[MST_IPIC] = STRZERO(LX,2)+STRZERO(LY,2)+DEF +MST_IPIC = MST_IPIC + 1 +RETURN(MST_IPIC - 1) + +FUNCTION SHOWP +PRIVATE Y1,X1,P_IDX,DEF,MNT,Y,X,LX,LY,LIN,ELM,CST1,CST2,CST3,CST4,CST5,ESCV,ESCH,Z +STORE "" TO CST1,CST2,CST3,CST4,CST5 +STORE 1 TO ESCV,ESCH +PARAMETERS Y1,X1,P_IDX,ESCV,ESCH,CST1,CST2,CST3,CST4,CST5 +STORE 1 TO X,Y +LX = VAL(LEFT(MST_PIC[P_IDX],2)) +LY = VAL(SUBSTR(MST_PIC[P_IDX],3,2)) +DEF = SUBSTR(MST_PIC[P_IDX],5) +MNT = "" +YC = 1 +FOR Y = 1 TO LY + LIN = SUBST(DEF,Y*LX-(LX-1),LX) + FOR X = 1 TO LX + ELM = SUBST(LIN,X,1) + DO CASE + CASE ELM = "0" + ELM = CHR(32) + CASE ELM = "1" + ELM = CHR(219) + CASE ELM = "2" + ELM = CHR(176) + CASE ELM = "3" + ELM = CHR(CST1) + CASE ELM = "4" + ELM = CHR(CST2) + CASE ELM = "5" + ELM = CHR(CST3) + CASE ELM = "6" + ELM = CHR(CST4) + CASE ELM = "7" + ELM = CHR(CST5) + ENDCASE + MNT = MNT + REPLICATE(ELM,ESCH) + NEXT + IF ESCV = 1 + @ Y1+Y-1,X1 SAY MNT + ELSE + FOR Z = 0 TO ESCV - 1 + @ Y1+YC+Z-1,X1 SAY MNT + NEXT + YC = YC + ESCV + ENDIF + MNT = "" +NEXT +RETURN(.T.) + +FUNCTION OPENBOX +PRIVATE L1,C1,L2,C2,TIT,MOLD,C_MP,C_PR,C_TIT,VF,TP,VD,SVT +IF TYPE("MST_IBOX") = "U" + PUBLIC MST_BOX[50],MST_IBOX + STORE 0 TO MST_IBOX +ENDIF +MST_IBOX = MST_IBOX + 1 +PARAMETERS L1,C1,L2,C2,TIT,MOLD,C_MP,C_PR,C_TIT,VF,TP,VD,TL1 +IF TYPE("L1") = "C" .AND. MST_IBOX = 1 + RETURN(.F.) +ELSEIF TYPE("L1") = "C" .OR. TYPE("L1") = "U" + VD = IF(TYPE("C_PR") = "U",0,C_PR) + TP = IF(TYPE("C_MP") = "U",1,C_MP) + VF = IF(TYPE("MOLD") = "U",.T.,MOLD) + C_TIT = IF(TYPE("TIT") = "U",GETCOLOR(2),TIT) + C_PR = IF(TYPE("C2") = "U",GETCOLOR(1),C2) + C_MP = IF(TYPE("L2") = "U",GETCOLOR(5),L2) + MOLD = IF(TYPE("C1") = "U",FRAMES(1,32),C1) + TIT = IF(TYPE("L1") = "U","",L1) + L1 = 02 + VAL(SUBSTR(MST_BOX[MST_IBOX-1],01,02)) + C1 = 04 + VAL(SUBSTR(MST_BOX[MST_IBOX-1],03,02)) + L2 = 02 + VAL(SUBSTR(MST_BOX[MST_IBOX-1],05,02)) + C2 = 04 + VAL(SUBSTR(MST_BOX[MST_IBOX-1],07,02)) +ELSEIF TYPE("L1") = "N" + VF = IF(TYPE("VF") = "U",.T.,VF) + TP = IF(TYPE("TP") = "U",1,TP) + VD = IF(TYPE("VD") = "U",0,VD) + C_MP = IF(TYPE("C_MP") = "U",GETCOLOR(5),C_MP) + C_PR = IF(TYPE("C_PR") = "U",GETCOLOR(1),C_PR) + C_TIT = IF(TYPE("C_TIT")= "U",GETCOLOR(2),C_TIT) + MOLD = IF(TYPE("MOLD") = "U",FRAMES(1,32),MOLD) + TIT = IF(TYPE("TIT") = "U","",TIT) +ENDIF +SAVE SCREEN TO TL1 +SVT = SETCOLOR() +MST_BOX[MST_IBOX] = STRZERO(L1,2) + STRZERO(C1,2) + STRZERO(L2,2) + STRZERO(C2,2); + + ALIGN(MOLD,"L",9) + ALIGN(C_MP,"L",6) + TL1 +SETCOLOR(C_MP) +EXPLODE(L1,C1,L2,C2,MOLD,0,TP,VD) +SETCOLOR(C_PR) +@ L1+1,C1+1 CLEAR TO L2-1,C2-1 +IF VF + BORDER(L1,C1,L2,C2,8) +ENDIF +SETCOLOR(C_TIT) +@ L1 , C1 + ROUND((C2 - C1 - LEN(TIT)) / 2,0) SAY TIT +SETCOLOR(SVT) +RETURN(.T.) + +FUNCTION CLOSEBOX +IF TYPE("MST_BOX[MST_IBOX]") = "U" + RELEASE MST_BOX,MST_IBOX + RETURN(.F.) +ENDIF +PRIVATE TE,SVT +TE = 0 +PARAMETERS TE +SVT = SETCOLOR(SUBSTR(MST_BOX[MST_IBOX],18,6)) +IMPLODE(VAL(SUBSTR(MST_BOX[MST_IBOX],01,02)),VAL(SUBSTR(MST_BOX[MST_IBOX],03,02)),; +VAL(SUBSTR(MST_BOX[MST_IBOX],05,02)),VAL(SUBSTR(MST_BOX[MST_IBOX],07,02)),; +SUBSTR(MST_BOX[MST_IBOX],09,09),SUBSTR(MST_BOX[MST_IBOX],24),0,TE) +SETCOLOR(SVT) +MST_IBOX = MST_IBOX - 1 +RETURN(.F.) + +* FUNCOES ESPECIAIS P/ STRINGS * + +FUNCTION UPPWORD +PRIVATE PLV +PARAMETERS PLV +RETURN(LEFT(UPPER(PLV),1)+RIGHT(LOWER(PLV),LEN(PLV)-1)) + +FUNCTION EXTENSE +PRIVATE NUM,UND,DZ1,DZ2,CNT,EXTEN,MO1,MO2,CN1,CN2,NRO,NR1,NR2,NR3,CEN +MO1 = "REAL " +MO2 = "REAIS " +CN1 = "CENTAVO " +CN2 = "CENTAVOS" +PARAMETER NUM,MO1,MO2,CN1,CN2 +UND = "UM "+; + "DOIS "+; + "TREIS "+; + "QUATRO "+; + "CINCO "+; + "SEIS "+; + "SETE "+; + "OITO "+; + "NOVE " +DZ1 = "DEZ "+; + "VINTE "+; + "TRINTA "+; + "QUARENTA "+; + "CINQUENTA "+; + "SESSENTA "+; + "SETENTA "+; + "OITENTA "+; + "NOVENTA " +DZ2 = "ONZE "+; + "DOZE "+; + "TREZE "+; + "QUATORZE "+; + "QUINZE "+; + "DEZESSEIS "+; + "DEZESSETE "+; + "DEZOITO "+; + "DEZENOVE " +CNT = "CEM "+; + "DUZENTOS "+; + "TREZENTOS "+; + "QUATROCENTOS"+; + "QUINHENTOS "+; + "SEISCENTOS "+; + "SETECENTOS "+; + "OITOCENTOS "+; + "NOVECENTOS " +EXTEN = " " +VAL = STR(NUM,12,2) +NRO = VAL(SUBSTR(VAL,1,3)) +NR1 = NRO +EXTEN = IF(NRO<>0,EXT_1(NRO)+IF(NRO>1," MILHOES"," MILHAO"),EXTEN) +NRO = VAL(SUBSTR(VAL,4,3)) +NR2 = NRO +EXTEN = IF(NRO<>0,IF(NR1<>0,EXTEN+", "+; + EXT_1(NRO)+" MIL",EXT_1(NRO)+" MIL"),EXTEN) +NRO = VAL(SUBSTR(VAL,7,3)) +NR3 = NRO +EXTEN = IF(NRO<>0,IF(NR1>0 .OR. NR2>0,EXTEN+", "+EXT_1(NRO),EXT_1(NRO)),EXTEN) +IF NR1 > 0 .OR. NR2 > 0 .OR. NR3 > 1 + EXTEN = EXTEN + " " + IF(NR1>0 .AND. NR2=0 .AND. NR3=0,"DE "+MO2,MO2) +ELSEIF NR3 = 1 .AND. NR1 = 0 .AND. NR2 = 0 + EXTEN = EXTEN + " " + MO1 +ENDIF +NRO = VAL(SUBSTR(VAL,11,2)) +IF NRO <> 0 + CEN = IF(NRO>1,CN2,CN1) + EXTEN = IF(NR1>0 .OR. NR2>0 .OR. NR3>0,EXTEN+" E "+; + EXT_1(NRO)+" "+CEN,EXTEN+EXT_1(NRO)+" "+CEN) +ENDIF +RETURN(EXTEN) + +FUNCTION FRAMES +PRIVATE PRE,NU,FRAME +NU = 0 +PARAMETERS NU,PRE +DO CASE + CASE NU = 1 + FRAME=CHR(218)+CHR(196)+CHR(191)+CHR(179)+CHR(217)+CHR(196)+CHR(192)+CHR(179) + CASE NU = 2 + FRAME=CHR(201)+CHR(205)+CHR(187)+CHR(186)+CHR(188)+CHR(205)+CHR(200)+CHR(186) + CASE NU = 3 + FRAME=CHR(213)+CHR(205)+CHR(184)+CHR(179)+CHR(190)+CHR(205)+CHR(212)+CHR(179) + CASE NU = 4 + FRAME=CHR(214)+CHR(196)+CHR(183)+CHR(186)+CHR(189)+CHR(196)+CHR(211)+CHR(186) + CASE NU = 5 + FRAME=REPLICATE(CHR(219),8) + CASE NU = 6 + FRAME=REPLICATE(CHR(176),8) + CASE NU = 7 + FRAME=REPLICATE("*",8) + CASE NU = 8 + FRAME="+-+|+-+|" + CASE NU = 9 + FRAME=CHR(176)+CHR(205)+CHR(176)+CHR(179)+CHR(176)+CHR(205)+CHR(176)+CHR(179) + CASE NU = 10 + FRAME=REPLICATE(".",8) + CASE NU = 11 + FRAME=CHR(218)+CHR(194)+CHR(191)+CHR(180)+CHR(217)+CHR(193)+CHR(192)+CHR(195) + CASE NU = 12 + FRAME=CHR(254)+CHR(176)+CHR(254)+CHR(176)+CHR(254)+CHR(176)+CHR(254)+CHR(176) + CASE NU = 13 + FRAME=CHR(201)+CHR(209)+CHR(187)+CHR(182)+CHR(188)+CHR(207)+CHR(200)+CHR(199) + CASE NU = 14 + FRAME=CHR(219)+CHR(223)+CHR(219)+CHR(219)+CHR(219)+CHR(220)+CHR(219)+CHR(219) + OTHERWISE + FRAME=" " +ENDCASE +IF TYPE("PRE") <> "U" + FRAME = FRAME + CHR(PRE) +ENDIF +RETURN(FRAME) + +FUNCTION MIDAT +PRIVATE VR,OC,NM,LN,PI,PO,CT,IC +PARAMETERS VR,OC,NM +PI = AT(OC,VR) +IF PI = 0 .OR. NM = 0 + RETURN(0) +ENDIF +LN = LEN(VR) +IC = 0 +FOR CT = PI TO LN + PO = AT(OC,SUBSTR(VR,CT)) + IF IC = NM .OR. PO = 0 + EXIT + ENDIF + IC = IC + 1 + CT = CT + PO +NEXT +RETURN(CT-2) + +FUNCTION CTAT +PRIVATE TLINE,OCOR,L,C,J +PARAMETERS TLINE,OCOR +L=LEN(TLINE) +STORE 0 TO C +IF AT(OCOR,TLINE) = 0 + RETURN(0) +ENDIF +FOR J=1 TO L + IF OCOR = SUBST(TLINE,J,LEN(OCOR)) + C = C + 1 + ENDIF +NEXT +RETURN (C) + +FUNCTION STACK +PRIVATE LINE,OC,LTR,TC,TJ,TP +OC = "," +PARAMETERS LINE,OC +IF TYPE("MST_ISTK") = "U" + PUBLIC MST_STK[500],MST_ISTK + AFILL(MST_STK,"") + STORE 1 TO MST_ISTK +ELSE + RETURN(.F.) +ENDIF +OC = LEFT(OC,1) +TJ = LEN(LINE) +TP = 1 +FOR TC = 1 TO TJ + LTR = SUBSTR(LINE,TC,1) + IF LTR <> OC + MST_STK[TP] = MST_STK[TP] + LTR + ELSE + TP = TP + 1 + ENDIF +NEXT +RETURN(.T.) + +FUNCTION READSTACK +PRIVATE TP,RET +PARAMETERS TP +IF TYPE("MST_ISTK") = "U" + RET = "" +ELSE + IF MST_ISTK > 500 + RET = "" + ELSEIF TYPE("MST_STK[MST_ISTK] ") <> "U" + IF TYPE("TP") = "U" + RET = MST_STK[MST_ISTK] + MST_ISTK = MST_ISTK + 1 + ELSE + MST_ISTK = TP + RET = MST_STK[MST_ISTK] + MST_ISTK = MST_ISTK + 1 + ENDIF + ELSE + RET = "" + ENDIF +ENDIF +RETURN (RET) + +FUNCTION CLEARSTACK +IF TYPE("MST_STK") = "U" .AND. TYPE("MST_ISTK") = "U" + RETURN(.F.) +ENDIF +RELEASE MST_STK,MST_ISTK +RETURN (.T.) + +FUNCTION ROTSTR +PRIVATE LINE,TM,LN,COL,ROW,PR,VL,PS,TC +PARAMETERS LINE,TM,VL +IF TYPE("LINE") <> "C" + RETURN ("") +ENDIF +SET CURSOR OFF +TM = IF( TYPE("TM")<>"N",78,TM) +VL = IF( TYPE("VL")<>"N",0,VL) +ROW = ROW() +COL = COL() +LN = LEN(LINE) +PR = LN + INT((TM - LN) / 2) +LINE = SPACE(TM) + LINE + SPACE(TM) +FOR PS = 1 TO (LEN(LINE) - TM + 1) + @ ROW,COL SAY SUBSTR(LINE,PS,TM) + TC = INKEY() + IF TC <> 0 + EXIT + ENDIF + DELAY(VL) + IF TM >= LN .AND. PS = PR + INKEY(2) + ENDIF +NEXT +RETURN(TC) + +FUNCTION VPEEK +PRIVATE LY,LX,CD +PARAMETERS LY,CX +RETURN(LEFT(SAVESCREEN(LY,CX,LY,CX),1)) + +FUNCTION GETCOLOR +PRIVATE P1,P2,SVT,RET,INC,POS +SVT = SETCOLOR() +P2 = 0 +PARAMETERS P1,P2,SVT +INC = MIDAT(SVT,",",P1-1)+1 +RET = SUBSTR(SVT,INC,IF(P1=5,LEN(SVT),MIDAT(SVT,",",P1)-1)-INC+1) +POS = AT("/",RET) +RET = IF(P2=0,RET,IF(P2=1,LEFT(RET,POS-1),SUBSTR(RET,POS+1))) +RETURN(RET) + +FUNCTION ALIGN +PRIVATE TL_1,AL_1,TM_1,TM_2,TL_2,NR_1 +PARAMETERS TL_1,AL_1,TM_1,NR_1 +IF TYPE("TL_1") <> "C" + RETURN "" +ENDIF +TM_1 = IF(TYPE("TM_1")="U",80,TM_1) +AL_1 = IF(TYPE("AL_1")="U","L",AL_1) +TL_1 = IF(LEN(TL_1) > TM_1,LEFT(TL_1,TM_1),TL_1) +TM_2 = LEN(TL_1) +DO CASE + CASE AL_1 = "L" + TL_2 = TL_1+SPACE(TM_1-TM_2) + CASE AL_1 = "R" + TL_2 = SPACE(TM_1-TM_2)+TL_1 + CASE AL_1 = "C" + TL_2 = LEFT(SPACE(ROUND((TM_1-TM_2)/2,0))+TL_1+SPACE(ROUND((TM_1-TM_2)/2,0)),TM_1) + CASE AL_1 = "J" + NR_1 = IF(TYPE("NR_1")="U",1,NR_1) + TL_2 = MEMOLINE(TL_1,TM_1,NR_1,8,.T.) + TL_2 = TL_2 + SPACE(TM_1-LEN(TL_2)) + OTHERWISE + TL_2 = "" +ENDCASE +RETURN(TL_2) + +* FUNCOES ESPECIAIS P/ ATIVIDADES DIVERSAS * + +FUNCTION DELAY +PRIVATE TE,TT,FT +FT = .F. +PARAMETERS TE,FT +TT = 0 +TI = SECONDS() +IF FT + DO WHILE TI+TE >= SECONDS() + TT = TT + 1 + ENDDO +ELSE + DO WHILE TT < TE + TT = TT + 1 + ENDDO +ENDIF +RETURN(TT) + +FUNCTION PLAY +PRIVATE SQ,F,M,D,N +PARAMETERS SQ +FOR F=1 TO LEN(SQ) STEP 2 + M=SUBST(SQ,F,1) + D=VAL(SUBST(SQ,F+1,1)) + DO CASE + CASE M = "C" + N = 130.80 + CASE M = "D" + N = 146.80 + CASE M = "E" + N = 164.80 + CASE M = "F" + N = 174.60 + CASE M = "G" + N = 196.00 + CASE M = "A" + N = 220.00 + CASE M = "B" + N = 246.90 + CASE M = "H" + N = 261.60 + CASE M = "J" + N = 293.60 + CASE M = "c" + N = 138.60 + CASE M = "d" + N = 155.60 + CASE M = "f" + N = 185.00 + CASE M = "g" + N = 207.70 + CASE M = "a" + N = 233.10 + OTHERWISE + RETURN(.F.) + ENDCASE + TONE(N,D*3) +NEXT +RETURN(.T.) + +* FUNCOES ESPECIAIS P/ PROTECAO DE SISTEMAS * + +FUNCTION PING +PRIVATE X,Y,DX,DY,LETR,TE +STORE 0 TO TE +PARAMETERS TE +SET CURSOR OFF +STORE 1 TO X,Y,DX,DY +DO WHILE .T. + LETR = SAVESCREEN(Y,X,Y,X) + @ Y,X SAY CHR(7) + DELAY (TE) + RESTSCREEN(Y,X,Y,X,LETR) + DELAY(TE/2) + X = X + DX + Y = Y + DY + IF X > 78 .OR. X < 2 + DX = DX * -1 + ENDIF + IF Y > 22 .OR. Y < 2 + DY = DY * -1 + ENDIF + IF INKEY() <> 0 + EXIT + ENDIF +ENDDO +RETURN(.F.) + +FUNCTION DAMAGE +PRIVATE ARQ_1,ARQGENT,BLOCK +BLOCK = SPACE(10) +PARAMETERS ARQ_1,BLOCK +ARQGENT = FOPEN(ARQ_1,1) +IF FERROR() <> 0 + RETURN(FERROR()) +ENDIF +FWRITE (ARQGENT,BLOCK,10) +FCLOSE (ARQGENT) +RETURN (.T.) + +FUNCTION KILL +PRIVATE DISK_1,NM,VECTOR,ARQ +PARAMETERS DISK_1 +NM = ADIR(DISK_1+"*.*") +DECLARE VECTOR[NM] +ADIR(DISK_1+"*.*",VECTOR) +FOR N = 1 TO NM + ARQ = DISK_1 + VECTOR[N] + DAMAGE(ARQ) + ERASE &ARQ +NEXT +RETURN(DOSERROR()) + +FUNCTION PROTECT +PRIVATE LOG,FB,NAME,FH +LOG = .F. +FB = SPACE(1) +PARAMETERS NAME,LOG +IF EMPTY(NAME) + RETURN(.F.) +ENDIF +FH = FOPEN(NAME,2) +IF FERROR() <> 0 + RETURN (.F.) +ENDIF +FSEEK(FH,0) +FB = FREADSTR(FH,1) +IF LOG .AND. (FB = CHR(3) .OR. FB = CHR(131)) + FB = IF(FB = CHR(03),CHR(13),CHR(141)) +ELSEIF .NOT. LOG .AND. (FB = CHR(13) .OR. FB = CHR(141)) + FB = IF(FB = CHR(13),CHR(03),CHR(131)) +ELSE + FCLOSE(FH) + RETURN(.T.) +ENDIF +FSEEK(FH,0) +FWRITE(FH,FB,1) +FCLOSE(FH) +RETURN(.T.) + +FUNCTION COPYRIGHT +PRIVATE CD_R,COP_R,C1_R,C2_R,L1,C1,SL,SC,AUT_R,SAV,SCR_R1,TL_1,SCR_R2 +PARAMETERS CD_R +COP_R = CHR(76)+CHR(79)+CHR(78)+CHR(71)+CHR(79)+" "+CHR(83)+CHR(65)+CHR(78)+; +CHR(84)+CHR(65)+CHR(78)+CHR(65)+" "+CHR(38)+" "+CHR(69)+CHR(71)+CHR(90)+" "+; +CHR(83)+CHR(79)+CHR(70)+CHR(84)+CHR(87)+CHR(65)+CHR(82)+CHR(69) +IF TYPE("CD_R") = "U" + RETURN(COP_R) +ENDIF +C1_R = VAL(LEFT(DTOC(DATE()),2))+10 +C2_R = VAL(SUBST(DTOC(DATE()),4,2))+1 +IF CD_R = STRZERO(C2_R,2) + "-" + STRZERO(C1_R,2) + STORE 0 TO L1,C1 + STORE 5 TO SL + STORE 16 TO SC + AUT_R = CHR(87)+CHR(97)+CHR(103)+CHR(110)+CHR(101)+CHR(114)+" "+CHR(76)+; + CHR(111)+CHR(110)+CHR(103)+CHR(111)+" "+CHR(67)+CHR(97)+CHR(115)+CHR(116)+; + CHR(114)+CHR(111)+CHR(44)+" "+CHR(79)+CHR(115)+CHR(118)+CHR(97)+CHR(108)+; + CHR(100)+CHR(111)+" "+CHR(83)+CHR(97)+CHR(110)+CHR(116)+CHR(97)+CHR(110)+; + CHR(97)+" "+CHR(78)+CHR(101)+CHR(116)+CHR(111)+" "+CHR(101)+" "+CHR(69)+; + CHR(100)+CHR(117)+CHR(97)+CHR(114)+CHR(100)+CHR(111)+" "+CHR(71)+CHR(117)+; + CHR(105)+CHR(109)+CHR(97)+CHR(114)+CHR(132)+CHR(101)+CHR(115)+" "+CHR(90)+; + CHR(111)+CHR(108)+CHR(97) + SAV = SETCOLOR() + SET CURSOR OFF + SAVE SCREEN TO SCR_R1 + CLEAR SCREEN + DO WHILE L1 < 20 + SET COLOR TO W/B + @ L1,C1 CLEAR TO L1+SL,C1+SC + @ 24-(L1+SL),C1 CLEAR TO 24-L1,C1+SC + @ L1,79-(C1+SC) CLEAR TO L1+SL,79-C1 + @ 24-(L1+SL),79-(C1+SC) CLEAR TO 24-L1,79-C1 + SET COLOR TO N/W + @ L1,C1 TO L1+SL,C1+SC + @ 24-(L1+SL),C1 TO 24-L1,C1+SC + @ L1,79-(C1+SC) TO L1+SL,79-C1 + @ 24-(L1+SL),79-(C1+SC) TO 24-L1,79-C1 + L1 = L1 + 1 + C1 = C1 + 1 + ENDDO + SET COLOR TO W+/B + @ 21,21 SAY LEFT(COP_R,13) + @ 22,24 SAY RIGHT(COP_R,8) + @ 02,21 SAY UPPER(SUBST(AUT_R,45,7)+" "+RIGHT(AUT_R,4)) + @ 03,24 SAY RIGHT(COP_R,8) + @ 21,46 SAY UPPER(SUBST(AUT_R,45,7)+" "+RIGHT(AUT_R,4)) + @ 22,49 SAY RIGHT(COP_R,8) + @ 02,46 SAY LEFT(COP_R,13) + @ 03,49 SAY RIGHT(COP_R,8) + SET COLOR TO N/W + SAVE SCREEN TO TL_1 + EXPLODE(07,00,17,34,CHR(218)+CHR(196)+" "+CHR(196)+CHR(192)+CHR(179)+" ") + SET COLOR TO W/B + @ 08,01 CLEAR TO 16,34 + SET COLOR TO N/W + MOVESCREEN(07,00,17,34,07,06,TL_1) + SAVE SCREEN TO TL_1 + EXPLODE(07,45,17,79," "+CHR(196)+CHR(191)+CHR(179)+CHR(217)+CHR(196)+" ") + SET COLOR TO W/B + @ 08,45 CLEAR TO 16,78 + SET COLOR TO N/W + MOVESCREEN(07,45,17,79,07,39,TL_1) + @ 07,06,17,73 BOX FRAMES(1,32) + RELEASE TL_1 + SHADOW(08,74,18,75,8) + SHADOW(18,08,18,75,8) + SET COLOR TO W/B + @ 08,07 CLEAR TO 16,72 + SET COLOR TO W+/B + CENTER(09,COP_R) + CENTER(15,"Autores: "+LEFT(AUT_R,43)) + CENTER(16,SUBST(AUT_R,44)) + SET COLOR TO W/B + CENTER(11,"apresenta") + SET COLOR TO W+/BG + DO WHILE LASTKEY() <> 27 + @ 13,27 SAY ROTSTR("Biblioteca de Funcoes Especiais para Clipper Summer'87 - MASTER.LIB",250) + ENDDO + SAVE SCREEN TO SCR_R2 + SET COLOR TO &SAV + SET CURSOR OFF + RIGHTSCR(SCR_R2,SCR_R1) + RETURN("") +ELSE + RETURN(COP_R) +ENDIF + +FUNCTION CODE +PRIVATE CODE1,CD1,CD2,CR1,CT,XP1,XP2,VT,MODE +MODE = .T. +PARAMETERS CODE1,MODE +IF MODE + CD1 = "ABCDEFGHIJLMNOPQRSTUVXZ0987654321KWY@#$%&" + CD2 = "~`'][{}+=)\|^;:><,zxvutsrqponmljihgfedcba" +ELSE + CD1 = "~`'][{}+=)\|^;:><,zxvutsrqponmljihgfedcba" + CD2 = "ABCDEFGHIJLMNOPQRSTUVXZ0987654321KWY@#$%&" +ENDIF +FOR CT = 1 TO 41 + XP1 = SUBSTR(CD1,CT,1) + XP2 = SUBSTR(CD2,CT,1) + CODE1 = STRTRAN(CODE1,XP1,XP2) +NEXT +RETURN(CODE1) + +FUNCTION ENCRYPT +PRIVATE CODE1,KEY,TM,EST +KEY = 0 +CR1 = "" +EST = .T. +PARAMETERS CODE1,KEY,EST +TM = LEN(CODE1) +FOR CT = 1 TO TM + CR1 = CR1 + CHR(ASC(SUBSTR(CODE1,CT,1))+KEY) +NEXT +RETURN(CR1) + +* FUNCOES ESPECIAIS P/ MENUS E ENTRADAS DE DADOS * + +FUNCTION OPTIONS +PRIVATE MTC,LY1,LX1,LY2,LX2,CXA,CR0,CR1,CR2,CR3,CR4,LOP,ELM_1 +PARAMETERS MTC,LY1,LX1,LY2,LX2,CXA,CR1,CR2 +CR0 = SETCOLOR() +CR3 = GETCOLOR(5) +CR4 = GETCOLOR(2) +SETCOLOR(CR4) +@ LY1-1,CXA SAY CHR(25) +@ LY2+1,CXA SAY CHR(25) +SETCOLOR(CR0) +FOR LOP = LY1 TO LY2 + @ LOP,CXA SAY CHR(CR2) +NEXT +SETCOLOR(CR3) +@ LY1,CXA SAY CHR(CR1) +SETCOLOR(CR0) +ELM_1 = .F. +RETURN(ACHOICE(LY1,LX1,LY2,LX2,MTC,.T.,"MENU_1")) + +FUNCTION ARROWS +PRIVATE AR +AR = .F. +PARAMETERS AR +IF AR + SET KEY 19 TO LEFT_ARROW + SET KEY 4 TO RIGHT_ARROW +ELSE + SET KEY 19 TO + SET KEY 4 TO +ENDIF +RETURN(.T.) + +FUNCTION MOVEMENU +PRIVATE MAT,Y1,X1,Y2,X2,Y3,X3,TLX,X,Y,DX,DY,OP_1,F,UDF +PARAMETERS MAT,Y1,X1,Y2,X2,Y3,X3,TLX,UDF +SET CURSOR OFF +X = X3 +Y = Y3 +DX = X2-X1 +DY = Y2-Y1 +OP_1 = 1 +SET KEY -9 TO MENU_3 +DO WHILE .T. + FOR F = 0 TO LEN(MAT)-1 + @ Y+F,X PROMPT MAT[F+1] + NEXT + MENU TO OP_1 + IF LASTKEY() <> 23 + EXIT + ENDIF +ENDDO +RETURN (OP_1) + +FUNCTION PROMPT +PRIVATE LY,CX,LABEL,MESS,TX,TX1,HOTK,SVT +SET CURSOR OFF +STORE "" TO MESS +STORE 0 TO HOTK +PARAMETERS LY,CX,LABEL,HOTK,MESS +SVT = SETCOLOR() +IF TYPE("MST_IMNU") <> "N" + PUBLIC MST_MNU[100],MST_IMNU + AFILL(MST_MNU,"") + STORE 0 TO MST_IMNU +ENDIF +MST_IMNU = MST_IMNU + 1 +MST_MNU[MST_IMNU] = STRZERO(LY,2)+STRZERO(CX,2)+; +ALIGN(LABEL,"L",80)+STRZERO(LEN(LABEL),2)+ALIGN(MESS,"L",80)+; +STRZERO(LEN(MESS),2)+STRZERO(HOTK,2) +RETURN(.T.) + +FUNCTION MENUTO +PRIVATE CR0,CR1,CR2,CR3,STAT,OPC,KEY,TX,BS,LST,D1,D2 +STORE 1 TO BS,OPC +STORE 2 TO LST +SET CURSOR OFF +STAT = "STAT_1" +PARAMETERS D1,D2,STAT +CR0 = SETCOLOR() +CR1 = GETCOLOR(2) +CR2 = GETCOLOR(5) +CR3 = LEFT(CR2,AT("/",CR2))+SUBSTR(CR1,AT("/",CR1)+1) +FOR TX = 2 TO MST_IMNU + IF VAL(SUBSTR(MST_MNU[TX],3,2)) = VAL(SUBSTR(MST_MNU[1],3,2)) + BS = BS + 1 + ENDIF + HT1 = VAL(RIGHT(MST_MNU[TX],2)) + LY1 = VAL(LEFT(MST_MNU[TX],2)) + LX1 = VAL(SUBSTR(MST_MNU[TX],3,2)) + EL1 = LEFT(SUBSTR(MST_MNU[TX],5,80),VAL(SUBSTR(MST_MNU[TX],85,2))) + @ LY1,LX1 SAY LEFT(EL1,HT1-1) + SETCOLOR(CR2) + @ LY1,COL() SAY IF(HT1=0,"",UPPER(SUBSTR(EL1,HT1,1))) + SETCOLOR(CR0) + @ LY1,COL() SAY SUBSTR(EL1,HT1+1) +NEXT +SETCOLOR(CR0) +KEYBOARD CHR(32) +DO WHILE .T. + KEY = INKEY() + DO CASE + CASE KEY = 5 .AND. OPC > 1 + OPC = OPC - 1 + CASE KEY = 24.AND. OPC < MST_IMNU + OPC = OPC + 1 + CASE KEY = 19 .AND. OPC - BS > 0 + OPC = OPC - BS + CASE KEY = 4 .AND. OPC + BS < MST_IMNU + 1 + OPC = OPC + BS + CASE KEY = 13 + EXIT + CASE KEY = 27 + OPC = 0 + EXIT + CASE VAL(RIGHT(MST_MNU[OPC],2)) <> 0 + IF KEY >= 48 .AND. KEY <= 90 + FOR TX = 1 TO MST_IMNU + IF UPPER(SUBSTR(SUBSTR(MST_MNU[TX],5,80),; + VAL(RIGHT(MST_MNU[TX],2)),1)) = CHR(KEY) + OPC = TX + EXIT + ENDIF + NEXT + ENDIF + ENDCASE + HT1 = VAL(RIGHT(MST_MNU[OPC],2)) + LY1 = VAL(LEFT(MST_MNU[OPC],2)) + LX1 = VAL(SUBSTR(MST_MNU[OPC],3,2)) + EL1 = LEFT(SUBSTR(MST_MNU[OPC],5,80),VAL(SUBSTR(MST_MNU[OPC],85,2))) + HT2 = VAL(RIGHT(MST_MNU[LST],2)) + LY2 = VAL(LEFT(MST_MNU[LST],2)) + LX2 = VAL(SUBSTR(MST_MNU[LST],3,2)) + EL2 = LEFT(SUBSTR(MST_MNU[LST],5,80),VAL(SUBSTR(MST_MNU[LST],85,2))) + IF OPC <> LST + SETCOLOR(CR0) + IF HT2 <> 0 + @ LY2,LX2 SAY LEFT(EL2,HT2-1) + SETCOLOR(CR2) + @ LY2,COL() SAY UPPER(SUBSTR(EL2,HT2,1)) + SETCOLOR(CR0) + @ LY2,COL() SAY SUBSTR(EL2,HT2+1) + ELSE + @ LY2,LX2 SAY EL2 + ENDIF + ENDIF + SETCOLOR(CR1) + IF HT1 = 0 + @ LY1,LX1 SAY EL1 + ELSE + @ LY1,LX1 SAY LEFT(EL1,HT1-1) + SETCOLOR(CR3) + @ LY1,COL() SAY UPPER(SUBSTR(EL1,HT1,1)) + SETCOLOR(CR1) + @ LY1,COL() SAY SUBSTR(EL1,HT1+1) + ENDIF + SETCOLOR(CR0) + LST = OPC + DO &STAT WITH OPC,KEY,LEFT(SUBSTR(MST_MNU[OPC],87,80),; + VAL(SUBSTR(MST_MNU[OPC],167,2))) +ENDDO +RELEASE MST_IMNU,MST_MNU +SETCOLOR(CR0) +RETURN (OPC) + +FUNCTION SWITCH +PRIVATE L1,C1,L2,C2,C3,MT1,MT2,SW1,SW2,T,SPC,ANT,TL +PARAMETERS L1,C1,L2,C2,C3,MT1,MT2,SW1,SW2 +TL = IF(LEN(MT2)>L2-L1,L2-L1,LEN(MT2)) +FOR T = 0 TO TL + @ L1+T,C3 SAY IF(MT2[T+1],SW1,SW2) +NEXT +ANT = -1 +SPC = MAX(LEN(SW1),LEN(SW2)) +RETURN(ACHOICE(L1,C1,L2,C2,MT1,.T.,"MENU_2")) + +FUNCTION POPUP +PRIVATE L1,C1,L2,C2,MT1,UDF,M,TL,SEL,NS,PT1,PT2,PM1,PM2,OP +SEL = "N/W" +NS = "W/N" +PARAMETERS L1,C1,L2,C2,MT1,UDF,SEL,NS,KEY +FOR M = 1 TO LEN(MT1) + MT1[M] = MT1[M] + SPACE(C2-C1-LEN(MT1[M])+1) +NEXT +@ L1,C1 CLEAR TO L2,C2 +TL = IF(LEN(MT1)>L2-L1+1,L2-L1+1,LEN(MT1)) +FOR M = 1 TO TL + @ L1+(M-1),C1 SAY MT1[M] +NEXT +SET CURSOR OFF +PT1 = 0 +PM1 = 1 +PT2 = 1 +PM2 = 2 +SETCOLOR(SEL) +@ L1,C1 SAY MT1[1] +KEYBOARD CHR(32) +DO WHILE .T. + KEY = INKEY() + DO CASE + CASE KEY = 5 .AND. PM1 > 1 + IF PT1 = 0 + @ L1+PT1,C1 SAY MT1[PM1] + SCROLL(L1+1,C1,L2,C2,-1) + @ L1+PT1+1,C1 SAY MT1[PM2] + PM1 = PM1 - 1 + ELSE + PT1 = PT1 - 1 + PM1 = PM1 - 1 + ENDIF + CASE KEY = 24 .AND. PM1 < LEN(MT1) + IF PT1 = L2-L1 + @ L1+PT1,C1 SAY MT1[PM1] + SCROLL(L1,C1,L2-1,C2,+1) + @ L1+PT1-1,C1 SAY MT1[PM2] + PM1 = PM1 + 1 + ELSE + PT1 = PT1 + 1 + PM1 = PM1 + 1 + ENDIF + CASE KEY = 13 + OP = PM1 + EXIT + CASE KEY = 27 + OP = 0 + EXIT + ENDCASE + DO &UDF WITH PM1,PT1,PM2,PT2 + IF PM1=PM2 + LOOP + ENDIF + SETCOLOR(NS) + @ L1+PT2,C1 SAY MT1[PM2] + SETCOLOR(SEL) + @ L1+PT1,C1 SAY MT1[PM1] + SETCOLOR(NS) + PT2 = PT1 + PM2 = PM1 +ENDDO +RETURN(OP) + +FUNCTION BUTTON +PRIVATE Y,X,STR,NST +PARAMETERS Y,X,STR,NST +IF TYPE("MST_IBUT") = "U" + PUBLIC MST_IBUT,MST_BUT[50] + MST_IBUT = 0 +ENDIF +CR0 = GETCOLOR(2) +CR1 = GETCOLOR(5) +CR2 = SETCOLOR() +SETCOLOR(CR0) +@ Y,X SAY STR +SETCOLOR(CR1) +@ Y,X+NST-1 SAY UPPER(SUBSTR(STR,NST,1)) +SETCOLOR(CR2) +@ Y+1,X+1 SAY REPLICATE(CHR(223),LEN(STR)) +@ Y,X+LEN(STR) SAY CHR(220) +MST_IBUT = MST_IBUT + 1 +MST_BUT[MST_IBUT] = STRZERO(Y,2)+STR(X,2)+ALIGN(STR,"L",80)+; +STRZERO(LEN(STR),2)+STRZERO(NST,2) +RETURN(.T.) + +FUNCTION READBUTTON +DECLARE MTY[MST_IBUT],MTX[MST_IBUT],MTL[MST_IBUT],MTS[MST_IBUT],MTN[MST_IBUT] +PRIVATE MTC[MST_IBUT],ELM,KEY,Y1,X1,X2,SCR +FOR T = 1 TO MST_IBUT + MTY[T] = VAL(LEFT(MST_BUT[T],2)) + MTX[T] = VAL(SUBSTR(MST_BUT[T],3,2)) + MTL[T] = VAL(SUBSTR(MST_BUT[T],85,2)) + MTS[T] = SUBSTR(MST_BUT[T],5,MTL[T]) + MTN[T] = VAL(SUBSTR(MST_BUT[T],87,2)) + MTC[T] = UPPER(SUBSTR(MTS[T],MTN[T],1)) +NEXT +ELM = 0 +BEGIN SEQUENCE + DO WHILE ELM = 0 + KEY = INKEY(0) + ELM = ASCAN(MTC,CHR(KEY)) + IF KEY = 27 + BREAK + ENDIF + ENDDO + Y1 = MTY[ELM] + X1 = MTX[ELM] + X2 = X1 + MTL[ELM] + SCR = SAVESCREEN(Y1,X1,Y1+1,X2+1) + @ Y1+1,X1+1 SAY REPLICATE(" ",MTL[ELM]) + @ Y1,X2 SAY " " + RESTSCREEN(Y1,X1+1,Y1,X2+1,SAVESCREEN(Y1,X1,Y1,X2)) + @ Y1,X1 SAY " " + DELAY(0.2,.T.) + LST = KEY + DO WHILE KEY = LST + LST = INKEY(0.1) + ENDDO + RESTSCREEN(Y1,X1,Y1+1,X2+1,SCR) +END SEQUENCE +RELEASE MST_IBUT,MST_BUT +RETURN(ELM) + +FUNCTION PASSWORD +PRIVATE Y,X,CR0,CR1,TAM,KEY,RET,LET +PARAMETERS Y,X,CR0,CR1,TAM +IF PCOUNT() < 2 + RETURN("") +ENDIF +SET CURSOR OFF +CR0 = IF(TYPE("CR0")="U","*",CR0) +CR1 = IF(TYPE("CR1")="U"," ",CR1) +TAM = IF(TYPE("TAM")="U",010,TAM) +LET = 0 +RET = "" +@ Y,X SAY REPLICATE(CR1,TAM) +DO WHILE LET <> TAM + KEY = INKEY(0) + DO CASE + CASE KEY = 8 .AND. LET > 0 + X = X - 1 + LET = LET - 1 + RET = LEFT(RET,LEN(RET)-1) + @ Y,X SAY CR1 + CASE KEY = 13 + EXIT + CASE KEY = 27 + RET = "" + EXIT + CASE KEY <> 8 + @ Y,X SAY CR0 + LET = LET + 1 + RET = RET + CHR(KEY) + X = X + 1 + ENDCASE +ENDDO +RETURN(RET) + +* FUNCOES ESPECIAIS P/ ARQUIVOS * + +FUNCTION LOADVARS +PRIVATE PRF,SL,F,VARII,VAR +PARAMETERS PRF,SL +SELECT(IF(TYPE("SL")<>"N",SELECT(),SL)) +PRF = IF(TYPE("PRF")<>"C","X",PRF) +IF .NOT. USED() + RETURN(.F.) +ENDIF +FOR F=1 TO FCOUNT() + VARII = TRIM(FIELD(F)) + VAR = ALLTRIM(PRF + VARII) + PUBLIC &VAR + DO CASE + CASE TYPE("&VARII") = "N" + &VAR = 0 + CASE TYPE("&VARII") = "C" .OR. TYPE("&VARII") = "M" + &VAR = SPACE(LEN(&VARII)) + CASE TYPE("&VARII") = "D" + &VAR = CTOD(" / / ") + CASE TYPE("&VARII") = "L" + &VAR = .F. + ENDCASE +NEXT +RETURN(.T.) + +FUNCTION COPYVARS +PRIVATE PRF,SL,F,VARII,VAR +PARAMETERS PRF,SL +SELECT(IF(TYPE("SL")<>"N",SELECT(),SL)) +PRF = IF(TYPE("PRF")<>"C","X",PRF) +IF .NOT. USED() + RETURN(.F.) +ENDIF +FOR F=1 TO FCOUNT() + VARII = TRIM(FIELD(F)) + VAR = PRF + VARII + PUBLIC &VAR + &VAR = &VARII +NEXT +RETURN(.T.) + +FUNCTION SAVEVARS +PRIVATE PRF,SL,F,VARII,VAR +PARAMETERS PRF,SL +SELECT(IF(TYPE("SL")<>"N",SELECT(),SL)) +PRF = IF(TYPE("PRF")<>"C","X",PRF) +IF .NOT. USED() + RETURN(.F.) +ENDIF +FOR F=1 TO FCOUNT() + VARII = TRIM(FIELD(F)) + VAR = PRF + VARII + IF TYPE("&VAR") = "U" + EXIT + ENDIF + REPLACE &VARII WITH &VAR +NEXT +RETURN(.T.) + +* FUNCOES ESPECIAIS P/ VARIAVEIS * + +FUNCTION VARS +PRIVATE NAME,TYPE,LEN +PARAMETERS NAME,TYPE,LEN +PUBLIC &NAME +DO CASE + CASE TYPE = "C" + IF TYPE ("LEN")="U" + LEN=1 + ENDIF + &NAME = SPACE(LEN) + CASE TYPE = "N" + &NAME = 0 + CASE TYPE = "L" + &NAME = .F. + OTHERWISE + &NAME = .F. +ENDCASE +RETURN(.T.) + +FUNCTION DIM +PRIVATE IDX,TX,TY,IDX +IDX = 2 +PARAMETERS TX,TY,IDX +RETURN ((TX-1)*IDX)+TY + +FUNCTION ACENTER +PRIVATE MATRIZ,LENGTH,JH,L,SPC +PARAMETERS MATRIZ,LENGTH +FOR JH = 1 TO LEN(MATRIZ) + L = LEN(MATRIZ[JH]) + SPC = SPACE((LENGTH-L)/2) + MATRIZ[JH] = SPC + MATRIZ[JH] + SPC + DO WHILE LEN(MATRIZ[JH]) < LENGTH + MATRIZ[JH] = MATRIZ[JH] + " " + ENDDO +NEXT +RETURN(.T.) + +FUNCTION EVAL +PRIVATE P1,P2,BLK,FUN,PR,SP,PM1,PM2,RS +STORE 0 TO P1,P2 +PARAMETERS BLK,P1,P2 +IF LEFT(BLK,3) = "{||" + FUN = SUBST(BLK,4,LEN(BLK)-4) +ELSE + PR = SUBST(BLK,3,MIDAT(BLK,"|",2)-2) + SP = AT(",",PR) + SP = IF(SP = 0,AT("|",PR),SP) + PM1 = LEFT(PR,SP-1) + PM2 = SUBST(PR,SP+1,AT("|",PR)-(SP+1)) + FUN = SUBST(BLK,MIDAT(BLK,"|",2)+1,LEN(BLK)-(LEN(PR)+3)) + STORE P1 TO &PM1 + IF .NOT. EMPTY(PM2) + STORE P2 TO &PM2 + ENDIF +ENDIF +RS = &FUN +RETURN(RS) + +FUNCTION SWAP +PRIVATE V1,V2,V3 +PARAMETERS V1,V2 +V3 = V1 +V1 = V2 +V2 = V3 +RETURN(.T.) + +FUNCTION AADD +PRIVATE STR,TMP,LCL +PARAMETERS MAT,STR,LCL +STR = IF(TYPE("STR")="U","",STR) +IF LEN(MAT)=1 .AND. TYPE("MAT[1]")="U" + PUBLIC MAT[1] + MAT[1] = STR +ELSE + DECLARE TMP[LEN(MAT)+1] + ACOPY(MAT,TMP) + IF TYPE("LCL")="U" + LCL = LEN(TMP) + ELSE + AINS(TMP,LCL) + ENDIF + TMP[LCL] = STR + PUBLIC MAT[LEN(TMP)] + ACOPY(TMP,MAT) +ENDIF +RETURN(.T.) + +* FUNCOES ESPECIAIS P/ CALCULOS * + +FUNCTION RND +PRIVATE TM_1,NM_1,T_1,T_2 +PARAMETERS TM_1 +STORE (VAL(SUBST(TIME(),7))/4.591) TO T_1,T_2 +NM_1 = INT((T_1 - INT(T_2))*10^TM_1) +INKEY(1) +RETURN(NM_1) + +FUNCTION IFB +PRIVATE CD +PARAMETERS CD +RETURN(IF(CD,1,0)) + +FUNCTION GRAPHBAR +PRIVATE Y1,X1,Y2,X2,DAD,ESC1,ESC2,VLI,C,DADMAX,ESC1,ESC2,Y,K,YC,X +PARAMETERS Y1,X1,Y2,X2,DAD,ESC1,ESC2,VLI +C = 1 +DADMAX = DAD[1] +DO WHILE C < LEN(DAD)+1 + IF DAD[C] > DADMAX + DADMAX = DAD[C] + ENDIF + C = C + 1 +ENDDO +ESC1=IF(TYPE("ESC1")="U",DADMAX/((Y2-1)-Y1),ESC1) +ESC2=IF(TYPE("ESC2")="U",1,ESC2) +VLI=IF(TYPE("VLI")="U",1,VLI) +FOR Y = Y1 TO Y2-2 + @ Y,X1+LENNUM(DADMAX) SAY CHR(180) + @ Y,X1 SAY STR(ROUND(DADMAX - (Y-Y1) * ESC1,0),LENNUM(DADMAX)) +NEXT +X1 = X1 + LENNUM(DADMAX) +@ Y,X1 SAY CHR(197) +K = VLI +C = 1 +FOR X = X1+1 TO X2-1 STEP 3 + @ Y2-1,X SAY CHR(196)+CHR(194)+CHR(196) + @ Y2,X SAY STRZERO(K,2) + K = K + ESC2 + Y = INT((Y2-2) - ((Y2-2) - Y1) * DAD[C] / DADMAX) + C = C + IFB(C < LEN(DAD)) + FOR YC = Y2-2 TO Y+1 STEP -1 + @ YC,X SAY REPL(CHR(219),2) + NEXT + @ YC,X SAY REPL(CHR(220),2) + IF Y = Y2-2 + SET COLOR TO N/B + @ Y2-2,X+2 SAY CHR(220) + SET COLOR TO W/B + ELSE + SHADOW(YC+1,X+2,Y2-2,X+2) + ENDIF +NEXT +RETURN(0) + +FUNCTION PERCENT +PRIVATE TUP,TMX,VLP,LIN,COL,TAM,TIP,TY,IND1,IND2,PRC +TIP = 1 +PARAMETERS TUP,TMX,LIN,COL,TAM,TIP +VLP = ROUND(TUP*100/TMX,0) +IND1 = ROUND(TAM*VLP/100,0) +IND2 = TAM - IND1 +PRC = IF(VLP=100,"100%",STRZERO(VLP,2)+"% ") +IF TIP = 1 + @ LIN,COL SAY REPLICATE(CHR(219),IND1)+REPLICATE(CHR(176),IND2) + @ LIN+1,INT(TAM/2)+COL-2 SAY PRC +ELSEIF TIP = 2 + FOR TY = LIN TO LIN-TAM STEP -1 + @ TY,COL+1 SAY IF(LIN-TY<=IND1,CHR(219)+CHR(219),CHR(176)+CHR(176)) + NEXT + @ TY-1,COL SAY PRC +ELSEIF TIP = 3 + @ LIN,COL-TAM SAY REPLICATE(CHR(176),IND2)+REPLICATE(CHR(219),IND1)+" "+PRC +ELSEIF TIP = 4 + FOR TY = LIN TO LIN+TAM + @ TY,COL+1 SAY IF(TY-LIN<=IND1,CHR(219)+CHR(219),CHR(176)+CHR(176)) + NEXT + @ TY+1,COL SAY PRC +ENDIF +RETURN(VLP) + +* FUNCOES ESPECIAIS P/ CALCULOS TRIGONOMETRICOS * + +FUNCTION PI +RETURN (3.1415926535897932384626433) + +FUNCTION SIN +PRIVATE ANG,SN,INC,FR,FLAG,SENX,DT +PARAMETERS ANG +SN = IF(ANG > 0,1,-1) +ANG = ABS(ANG) +IF INT(ANG/180)/2 = INT(INT(ANG/180)/2) + SN = SN * -1 +ENDIF +ANG = ANG - (INT(ANG/180)*180) +DO WHILE .T. + ANG = ANG - 180 + IF ANG <= 0 + EXIT + ENDIF +ENDDO +ANG = ANG * PI()/180 +INC = 0 +FR = 1 +FLAG = 1 +SENX = 0 +FOR DT = 1 TO 15 STEP 2 + DO WHILE INC > 0 + FR = FR * INC + INC = INC - 1 + ENDDO + SENX = SENX + FLAG * ((ANG^DT)/FR) + FR = 1 + FLAG = IF(FLAG=1,-1,1) + INC = DT + 2 +NEXT +SENX = SENX * SN +RETURN (SENX) + +FUNCTION COS +PRIVATE ANG,SN,INC,FR,FLAG,COSX,DT +PARAMETERS ANG +SN = IF(ANG > 0,1,-1) +ANG = ABS(ANG) +IF INT(ANG/180)/2 = INT(INT(ANG/180)/2) + SN = SN * -1 +ENDIF +ANG = ANG - (INT(ANG/180)*180) +DO WHILE .T. + ANG = ANG - 180 + IF ANG <= 0 + EXIT + ENDIF +ENDDO +ANG = ANG * PI()/180 +INC = 0 +FR = 1 +FLAG = 1 +COSX = 0 +FOR DT = 0 TO 15 STEP 2 + DO WHILE INC > 0 + FR = FR * INC + INC = INC - 1 + ENDDO + COSX = COSX + FLAG * ((ANG^DT)/FR) + FR = 1 + FLAG = IF(FLAG=1,-1,1) + INC = DT + 2 +NEXT +COSX = COSX * SN +RETURN (COSX) + +* FUNCOES ESPECIAIS P/ MANIPULACAO DE DATAS * + +FUNCTION GMONTH +PRIVATE NMES,TMES +PARAMETERS NMES +TMES = "JANEIRO "+; + "FEVEREIRO"+; + "MARCO "+; + "ABRIL "+; + "MAIO "+; + "JUNHO "+; + "JULHO "+; + "AGOSTO "+; + "SETEMBRO "+; + "OUTUBRO "+; + "NOVEMBRO "+; + "DEZEMBRO " +RETURN(SUBSTR(TMES,(NMES-1)*9+1,9)) + +FUNCTION CTDAY +PRIVATE DIA,DATA,RET +PARAMETERS DIA,DATA +STORE "" TO RET +FOR T = 1 TO 31 + IF DOW(CTOD(STRZERO(T,2)+"/"+DATA)) = DIA + RET = RET + STRZERO(T,2) + " " + ENDIF +NEXT +RETURN(RTRIM(RET)) + +FUNCTION EXTDAY +PRIVATE DIA,TDIA +PARAMETERS DIA +TDIA = "DOMINGO"+; + "SEGUNDA"+; + "TERCA "+; + "QUARTA "+; + "QUINTA "+; + "SEXTA "+; + "SABADO " +RETURN(SUBSTR(TDIA,(DIA-1)*7+1,7)) + +FUNCTION DMONTH +PRIVATE MES,NDIAS,ANO,MSS +PARAMETERS MES,ANO +MSS = "312831303130313130313031" +NDIAS = IF(TYPE("ANO")<>"U",; + IF(MES=2,IF(VYEAR(ANO),29,28),VAL(SUBSTR(MSS,MES*2-1,2))),; + VAL(SUBSTR(MSS,MES*2-1,2))) +RETURN(NDIAS) + +FUNCTION VYEAR +PRIVATE ANO +PARAMETERS ANO +RETURN(INT(ANO/4)=ANO/4) + +FUNCTION DATEXT +PRIVATE DT,D_1,M_1,Y_1 +PARAMETERS DT +D_1 = SUBST(DTOC(DT),1,2) +Y_1 = SUBSTR(DTOC(DT),7,8) +M_1 = GMONTH(VAL(SUBSTR(DTOC(DT),4,5))) +DT = D_1 + " DE " + M_1 + " DE " + "19" + Y_1 +RETURN(DT) + +* FUNCOES ESPECIAIS P/ VALIDACAO * + +FUNCTION VDATE +PRIVATE DATA,MES +PARAMETERS DATA +MES = VAL(LEFT(DATA,2)) +RETURN (MES > 0 .AND. MES < 13 .AND. VAL(RIGHT(DATA,2)) <> 0) + +FUNCTION VCGC +PRIVATE XC_1,XN_1,XN_2,XN_3 +PARAMETERS XC_1 +XC_1 = SUBST(XC_1,2,2)+SUBSTR(XC_1,5,3)+SUBSTR(XC_1,9,3)+SUBSTR(XC_1,13,4)+SUBSTR(XC_1,18,2) +XN_1 = SUBST(XC_1,1,1)+SUBSTR(XC_1,3,1)+SUBSTR(XC_1,5,1)+SUBSTR(XC_1,7,1) +XN_1 = LTRIM(STR(VAL(XN_1)*2,5)) +XN_1 = VAL(SUBSTR(XN_1,1,1))+VAL(SUBSTR(XN_1,2,1))+VAL(SUBSTR(XN_1,3,1))+VAL(SUBSTR(XN_1,4,1))+VAL(SUBST(XN_1,5,1)) +XN_2 = LTRIM(SUBSTR(XC_1,2,1)+SUBSTR(XC_1,4,1)+SUBSTR(XC_1,6,1)+SUBSTR(XC_1,8,1)) +XN_2 = VAL(SUBSTR(XN_2,1,1))+VAL(SUBSTR(XN_2,2,1))+VAL(SUBSTR(XN_2,3,1))+VAL(SUBSTR(XN_2,4,1)) +XN_3 = XN_1 + XN_2 +RETURN( IIF( XN_3 <> INT(XN_3/10)*10,.F.,.T.)) + +* FUNCOES ESPECIAIS P/ IMPRESSAO * + +FUNCTION PRTSC +PRIVATE TL_1,J,L,C +SAVE SCREEN TO TL_1 +PARAMETERS TL_1 +IF .NOT. ISPRINTER() + RETURN(.F.) +ENDIF +SETPRC(0,0) +SET CONSOLE OFF +SET PRINT ON +STORE 0 TO L,C +FOR J=1 TO 3999 STEP 2 + IF PCOL() = 79 + ? + ELSE + ?? SUBST(TL_1,J,1) + ENDIF +NEXT +SET CONSOLE ON +SET PRINT OFF +RETURN(.T.) + +* FUNCOES ESPECIAIS P/ CAMPOS MEMO * + +FUNCTION MEMOASC +PRIVATE KEY +IF TYPE("MST_MEM") = "U" + PUBLIC MST_MEM + STORE SPACE(1) TO MST_MEM +ENDIF +KEY = LASTKEY() +IF (KEY = 39 .OR. KEY = 96 .OR. KEY = 126 .OR. KEY = 94) + MST_MEM = CHR(KEY) + KEYBOARD CHR(19) + RETURN(0) +ENDIF +IF MST_MEM <> " " + KEY = INKEY(0) + PUSH(KEY) + DO CASE + CASE KEY = 97 + IF MST_MEM = "'" + PUSH(160) + ELSEIF MST_MEM = "`" + PUSH(133) + ELSEIF MST_MEM = "~" + PUSH(132) + ELSEIF MST_MEM = "^" + PUSH(131) + ENDIF + CASE KEY = 101 + IF MST_MEM = "'" + PUSH(130) + ELSEIF MST_MEM = "^" + PUSH(136) + ENDIF + CASE KEY = 105 + IF MST_MEM = "'" + PUSH(161) + ENDIF + CASE KEY = 111 + IF MST_MEM = "'" + PUSH(162) + ELSEIF MST_MEM = "~" + PUSH(148) + ELSEIF MST_MEM = "^" + PUSH(147) + ENDIF + CASE KEY = 117 + IF MST_MEM = "'" + PUSH(163) + ELSEIF MST_MEM = "~" + PUSH(129) + ENDIF + CASE KEY = 65 + IF MST_MEM = "'" + PUSH(143) + ELSEIF MST_MEM = "~" + PUSH(142) + ENDIF + CASE KEY = 69 + IF MST_MEM = "'" + PUSH(144) + ENDIF + CASE KEY = 79 + IF MST_MEM = "~" + PUSH(153) + ENDIF + CASE KEY = 85 + IF MST_MEM = "~" + PUSH(154) + ENDIF + CASE KEY = 99 + IF MST_MEM = "'" .OR. MST_MEM = "`" .OR. MST_MEM = "~" .OR. MST_MEM = "^" .OR. MST_MEM = ":" + PUSH(135) + ENDIF + CASE KEY = 67 + IF MST_MEM = "'" .OR. MST_MEM = "`" .OR. MST_MEM = "~" .OR.; + MST_MEM = "^" .OR. MST_MEM = ":" + PUSH(128) + ENDIF + CASE KEY = 110 + IF MST_MEM = "'" .OR. MST_MEM = "`" .OR. MST_MEM = "~" .OR.; + MST_MEM = "^" .OR. MST_MEM = ":" + PUSH(164) + ENDIF + CASE KEY = 78 + IF MST_MEM = "'" .OR. MST_MEM = "`" .OR. MST_MEM = "~" .OR.; + MST_MEM = "^" .OR. MST_MEM = ":" + PUSH(165) + ENDIF + CASE KEY = 39 .OR. KEY = 96 .OR. KEY = 126 .OR. KEY = 94 + IF READINSERT() + KEYBOARD CHR(22)+CHR(KEY)+CHR(0)+CHR(22) + ELSE + KEYBOARD CHR(KEY)+CHR(0) + ENDIF + ENDCASE + STORE SPACE(1) TO MST_MEM +ENDIF +RETURN(.T.) + +* FUNCOES ESPECIAIS P/ OPERACOES ON-LINE * + +FUNCTION CALC +PRIVATE CB,CL,SCR_1,CX,A_1,R,X,Y,CV,B_1,C1_1,R,C2_2,C3_3,C4_4,C5_5,C6_6,VH,VH2 +CB = "W/B" +CL = "W+/BG" +PARAMETERS CB,CL +SAVE SCREEN TO SCR_1 +CX = SETCOLOR() +SET CURSOR OFF +SET COLOR TO &CB +@ 1,44 CLEAR TO 18,78 +@ 1,44 TO 18,78 DOUBLE +@ 2,46 TO 04,57 +@ 3,50 SAY CHR(179)+SPACE(2)+CHR(179) +@ 2,50 SAY CHR(194)+REPLICATE(CHR(196),2)+CHR(194) +@ 4,50 SAY CHR(193)+REPLICATE(CHR(196),2)+CHR(193) +@ 2,59 TO 04,77 +@ 5,44 SAY CHR(204)+REPLICATE(CHR(205),33)+CHR(185) +@ 3,76 SAY "0" +SET COLOR TO &CL +@ 1,56 SAY " CALCULADORA " +SET COLOR TO &CB +@ 05,61 SAY CHR(203) +A_1 = 0 +R="789/*M456+-R123%EC0.=" +FOR X=06 TO 16 STEP 03 + FOR Y=46 TO 76 STEP 05 + IF Y=61 + SET COLOR TO &CB + @ X,Y TO X+3,Y DOUBLE + Y=63 + ENDIF + A_1=A_1+1 + SET COLOR TO &CL + @ X,Y SAY " "+SUBSTR(R,A_1,1)+" " + CV = TRIM(SUBST(CB,AT("/",CB)+1,3)) + SET COLOR TO N/&CV + @ X,Y+3 SAY CHR(220) + @ X+1,Y+1 SAY REPLICATE(CHR(223),3) + NEXT Y +NEXT X +SET COLOR TO &CB +@ 18,61 SAY CHR(202) +@ 15,62,17,77 BOX FRAMES(1,32) +@ 16,66 SAY "F10 = FIM" +FOR X=1 TO 6 + A_1="C"+LTRIM(STR(X))+"_"+LTRIM(STR(X)) + &A_1="" +NEXT X +A_1 = 0 +R = .F. +DO WHILE .T. + B_1=A_1 + A_1=INKEY(0) + IF R + C1_1="" + R=.F. + ENDIF + DO CASE + CASE A_1 = -9 + EXIT + CASE A_1 = 77 .OR. A_1 = 109 + BUTTON_1(6,73) + C6_6=C1_1 + LOOP + CASE (A_1 = 82 .OR. A_1 = 114) .AND. C1_1 = "" + BUTTON_1(9,73) + C1_1=C6_6 + CASE (A_1 = 67 .OR. A_1 = 99) .OR. (A_1 = 69 .OR. A_1 = 101) + C1_1="" + IF A_1=67 .OR. A_1 = 99 + BUTTON_1(12,73) + C2_2="" + C3_3="" + ELSE + BUTTON_1(12,68) + ENDIF + @ 3,60 SAY SPACE(16)+"0" + LOOP + CASE A_1 = 8 .AND. LEN(C1_1) > 0 + C1_1=LEFT(C1_1,LEN(C1_1)-1) + CASE A_1 = 46 .AND. AT(".",C1_1) <> 0 + LOOP + CASE A_1 = 37 .AND. VAL(C1_1) > 0 .AND. VAL(C2_2)>0 .AND. C5_5>")" .AND. C5_5<"." + BUTTON_1(12,63) + C4_4=STR(VAL(C1_1))+"*"+STR(VAL(C2_2))+"/100" + C4_4=&C4_4 + IF C5_5="+" .OR. C5_5="-" + C4_4=STR(VAL(C2_2))+C5_5+STR(C4_4) + C4_4=&C4_4 + ENDIF + C1_1=LTRIM(STR(C4_4)) + @ 3,60 SAY SPACE(17-LEN(C1_1))+C1_1 + C2_2=C1_1 + R = .T. + LOOP + CASE LEN(C1_1)=0 .AND. A_1=45 .AND. B_1<>61 .AND. B_1<>13 .AND. B_1<>37 .AND. LEFT(C1_1,1)<>"-" + BUTTON_1(9,68) + C1_1="-"+C1_1 + A_1=0 + ENDCASE + C2_2 = IF(B_1=61 .AND. A_1>42 .AND. A_1<48,"",C2_2) + DO CASE + CASE A_1=42 .OR. A_1=43 .OR. A_1=45 .OR. A_1=47 .OR. A_1=61 .OR. A_1=13 + BUTTON_1( 6 * IFB(A_1=42 .OR. A_1=47) + 9 * IFB(A_1=43 .OR. A_1=45) + 15 * ; + IFB(A_1=61 .OR. A_1=13) , 56 * IFB(A_1=61 .OR. A_1=13) + 63 * IFB(A_1=43 .OR. A_1=47) + 68 *; + IFB(A_1=42 .OR. A_1=45)) + C1_1 = IF(A_1=B_1 .AND. A_1<>61 .AND. A_1<>13,C3_3,C1_1) + IF VAL(C2_2)<>0 .AND. VAL(C1_1)<>0 + C4_4=STR(VAL(C2_2))+C5_5+STR(VAL(C1_1)) + C4_4=LTRIM(STR(&C4_4)) + C2_2=C4_4 + C1_1=C4_4 + C1_1=IF(LEN(C4_4)>17," E",C1_1) + @ 3,60 SAY SPACE(17-LEN(C1_1))+C1_1 + IF LTRIM(C1_1)="E" + STORE "" TO C1_1,C2_2,C3_3 + LOOP + ENDIF + ENDIF + R=.T. + C2_2=IF(LEN(C2_2)=0,C1_1,C2_2) + C5_5 = IF(A_1<>61 .AND. A_1<>13,CHR(A_1),C5_5) + LOOP + CASE A_1>45 .AND. A_1<58 .AND. A_1<>47 .AND. LEN(C1_1)<17 + VH = A_1 - 48 + VH2 = 41 + 5 * IF(VH > 6,VH-6,IF(VH > 3,VH-3,IF(VH = 0,1,VH))) + BUTTON_1(15 - 3 * INT((A_1-46)/3) , IF( VH2 < 46,51,VH2)) + C1_1=C1_1+CHR(A_1) + ENDCASE + C3_3=C1_1 + IF LEN(C1_1) > 0 + @ 3,60 SAY SPACE(17-LEN(C1_1))+C1_1 + ELSE + @ 3,60 SAY SPACE(16)+"0" + ENDIF +ENDDO +RESTORE SCREEN FROM SCR_1 +SET CURSOR ON +SET COLOR TO &CX +RETURN(0) + +FUNCTION CALENDARY +PRIVATE Y,X,MAT,ANO,MES,DIA,T,KEY,KO,DAT,ND,SVT,CAL,TLX,SX,SY,SV1 +PARAMETERS Y,X +SET CURSOR OFF +SX = COL() +SY = ROW() +SET DATE BRITISH +SAVE SCREEN TO CAL +SVT = SETCOLOR(GETCOLOR(2)) +SV1 = GETCOLOR(5) +@ Y,X TO Y+16,X+28 +BORDER(Y,X,Y+16,X+28) +SETCOLOR(SVT) +@ Y+1,X+1 CLEAR TO Y+15,X+27 +DECLARE MAT[4] +MAT[1] = LEFT(REPL(REPL(CHR(196),3)+CHR(194),7),27) +MAT[2] = "Dom"+CHR(179)+"Seg"+CHR(179)+"Ter"+CHR(179)+"Qua"+CHR(179)+"Qui"+CHR(179)+"Sex"+CHR(179)+"Sab" +MAT[3] = LEFT(REPL(REPL(CHR(196),3)+CHR(197),7),27) +MAT[4] = LEFT(REPL(" "+CHR(179),7),27) +ANO = YEAR(DATE()) +MES = MONTH(DATE()) +@ Y+2,X+1 SAY MAT[1] +@ Y+3,X+1 SAY MAT[2] +FOR T=Y+4 TO Y+14 STEP 2 + @ T,X+1 SAY MAT[3] + @ T+1,X+1 SAY MAT[4] +NEXT +SETCOLOR(SV1) +CENTER(Y," CALENDARIO ",X,X+28) +SETCOLOR(SVT) +SAVE SCREEN TO TLX +DO WHILE .T. + RESTORE SCREEN FROM TLX + KO = Y+5 + @ Y+1,X+2 SAY ALIGN(UPPWORD(GMONTH(MES)),"L",13)+" de "+RIGHT(STR(ANO),4) + ND = DMONTH(MES,ANO) + FOR DIA = 1 TO ND + MDAT = CTOD(STR(DIA)+"/"+STR(MES)+"/"+STR(ANO)) + PO = (X+DOW(MDAT)*4)-2 + DAT = IF(PO=0,"",RIGHT(STR(DIA),2)) + KO = IF(DOW(MDAT)=1 .AND. DIA>1,KO+2,KO) + @ KO,PO SAY DAT + NEXT + KEY = INKEY(0) + DO CASE + CASE KEY = 24 .AND. ANO < 2100 + ANO = ANO + 1 + CASE KEY = 5 .AND. ANO > 1700 + ANO = ANO - 1 + CASE KEY = 4 .AND. MES < 12 + MES = MES + 1 + CASE KEY = 19 .AND. MES > 1 + MES = MES - 1 + CASE KEY = 18 .AND. ANO > 1710 + ANO = ANO - 10 + CASE KEY = 3 .AND. ANO < 2090 + ANO = ANO + 10 + CASE KEY = 1 + MES = 1 + CASE KEY = 6 + MES = 12 + CASE KEY = 27 + RET = "" + EXIT + CASE KEY = 13 + RET = STRZERO(MES,2)+"/"+STRZERO(ANO,4) + EXIT + ENDCASE +ENDDO +@ SY,SX SAY "" +SET CURSOR ON +RESTORE SCREEN FROM CAL +RETURN(RET) + \ No newline at end of file