Il programma scritto secondo le specifiche XBASE - DBASE é stato compilato con il DBASE COMPILER

Frammenti... (1/20 del programma completo)

*********************************************************
* PROGRAMMA GESTIONE MAGAZZINO 15/2/90                    
* PARTE INIZIALE -UNOFE.PRG-
*********************************************************
CLEAR
SET CENTURY ON
SET EXCLUSIVE ON
SET LOCK OFF
SET STATUS OFF
**AGGIUNTA EURO
SET DECIMALS TO 5
**FINE EURO
SET FUNCTION F2 TO ";"
SET FUNCTION F3 TO ";"
SET FUNCTION F4 TO ";"
SET FUNCTION F5 TO ";"
SET FUNCTION F6 TO ";"
SET FUNCTION F7 TO ";"
SET FUNCTION F8 TO ";"
SET FUNCTION F9 TO ";"
SET FUNCTION F10 TO ";"
SET DATE ITALIAN
SET TALK OFF
SET SAFETY OFF
SET HEADING OFF
SET ESCAPE OFF
SET INTENSITY ON
SET SEPARATOR TO "."
SET POINT TO ","
_plength=64
SEGRETO=0
*************** INIZIO LOGO ***************************
SET COLOR TO W/B,N/G,B
CLEAR
SET CURSOR ON
*************** fine logo ******************************
USE INTESTA
GOTO RECORD 1
sspc2=sspc
II1=I1
II2=I2
CC1=TRIM(C1)
CC2="LAMA"
STORE " " TO COICE
STORE 0 TO SCELTA
DO WHILE COICE<>CC1.AND.COICE<>CC2
SET FORMAT TO
CLEAR
@ 1,0 SAY R1
@ 2,0 SAY R2
@ 3,0 SAY R3
@ 4,0 SAY R4
@ 5,0 SAY R5
@ 6,0 SAY R6
@ 8,2 SAY R7
@ 9,2 SAY R8
@ 10,2 SAY R9
@ 11,2 say R10
@ 12,11 SAY "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ Eseguito con DBase Compiler Borland"
@ 13,11 SAY "³ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³ Tutti i diritti riservati"
@ 14,11 SAY "³³MAG2000 ³ ³ "
@ 15,11 SAY "³³Programma ³ ³ "
@ 16,11 SAY "³³Gestione su P.C³ ³ "
@ 14,29 SAY "o"
@ 17,11 SAY "³ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³ "
@ 18,11 SAY "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
@ 18,18 SAY "Â"
@ 18,22 SAY "Â"
@ 19,15 SAY "ÚÄÄÙ ÀÄÄ¿"
@ 20,8 SAY "ÚÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄ¿"
@ 21,8 SAY "³ ÍÍÍÍÍ ³"
@ 22,8 SAY "³ ÍÍÍÍÍ ³"
@ 23,8 SAY "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
@ 19, 45 SAY "CODICE DI ACCESSO ====>"
@ 19, 69 GET COICE PICTURE "NNNNNNNNNN"
READ
IF COICE<>CC1.AND.COICE<>CC2
@ 20,60 SAY "Codice errato !!!"
endif
ENDDO
IF COICE="LAMA"
SEGRETO=1
ENDIF
******************** INIZIO FASE MENU'PRINCIPALE **********
L=1
RI=""
CONTO=""
DO WHILE L=1
CLEAR
@ 1,10 SAY "Data: "
@ 1,20 say DATE()
@ 1,55 SAY "Ore : "
@ 1,61 say time()
****************** MENU' POPUP *************************
@ 3,25 SAY "M E N U' P R I N C I P A L E"
@ 2,24 TO 4,54
@ 24,25 SAY "Selezione="+chr(24)+chr(25)+" Conferma="+chr(17)+"ÄÙ"
DEFINE POPUP P1 FROM 5,24 TO 23,54
DEFINE BAR 1 OF P1 PROMPT " 1 SCHEDE ARTICOLI"
DEFINE BAR 2 OF P1 PROMPT " 2 VENDITE"
IF SEGRETO=1
DEFINE BAR 3 OF P1 PROMPT " 3 DATA E ORA"
ELSE
DEFINE BAR 3 OF P1 PROMPT " 3 PROSPETTI"
ENDIF
DEFINE BAR 4 OF P1 PROMPT " 4 SCHEDE FORNITORI"
DEFINE BAR 5 OF P1 PROMPT " 5 SCHEDE CLIENTI"
DEFINE BAR 6 OF P1 PROMPT " 6 LISTE SELEZIONATE/ORDINI"
DEFINE BAR 7 OF P1 PROMPT " 7 FATTURE/BOLLE/PREVENTIVI"
DEFINE BAR 8 OF P1 PROMPT " 8 OPZIONI"
DEFINE BAR 9 OF P1 PROMPT " 9 PRIMA NOTA"
DEFINE BAR 10 OF P1 PROMPT " 10 COPIE RISERVA DATI"
DEFINE BAR 11 OF P1 PROMPT " 11 ELIMINA SCHEDE (F4)"
DEFINE BAR 12 OF P1 PROMPT " 12 INTESTAZIONE"
DEFINE BAR 13 OF P1 PROMPT " 13 RICOSTRUZIONE INDICI"
DEFINE BAR 14 OF P1 PROMPT " 14 ELIMINA BOLLE/FAT"
DEFINE BAR 15 OF P1 PROMPT " 15 TRASFERIMENTI"
DEFINE BAR 16 OF P1 PROMPT " 16 CONVERSIONI EURO<->LIRE"
DEFINE BAR 17 OF P1 PROMPT " 17 FINE LAVORO"
ON SELECTION POPUP P1 DO VAIP1
ACTIVATE POPUP P1
***************** inizio scelte **************************
IF SCELTA=1
SET PROCEDURE TO DUE
DO SCHEDE
CLOSE PROCEDURE
SCELTA=0
ENDIF
******************* SCELTA 2 ********************************
IF SCELTA=2
CLEAR
SET PROCEDURE TO TRE
DO VENDITE
CLOSE PROCEDURE
SCELTA=0
ENDIF
******************* SCELTA 3 *******************************
IF SCELTA=3
CLEAR
IF SEGRETO=1
CLEAR
SET FORMAT TO
@ 3,3 SAY "DATA"
@ 3,8 SAY DATE()
@ 3,18 SAY "/ ORA "
@ 3,26 SAY TIME()
WAIT "PREMERE UN TASTO PER PROSEGUIRE"
ELSE
SET PROCEDURE TO QUATTRO
DO PROSPETTI
CLOSE PROCEDURE
ENDIF
SCELTA=0
ENDIF
******************* SCELTA 6 ********************************
IF SCELTA=6
CLEAR
*WAIT "PROCEDURA DISATTIVATA PREMERE UN TASTO"
set procedure to OPZIONI
DO OPZIONI
CLOSE PROCEDURE
SCELTA=0
ENDIF
**********************
IF SCELTA=10
WAIT "-- INSERIRE UN NUOVO DISCO PER LA COPIA E PREMERE Invio/ A=Annulla -- " TO SP
CLEAR
IF SP<>"A".AND.SP<>"a"
USE
? RUN( .T.,"C:\VILLAF2\COPIA.BAT")
ENDIF
SCLETA=0
ENDIF
***********************
IF SCELTA=13
CLEAR
? "** RICOSTRUZIONE INDICI IN CORSO. Attendere..."
use schede index schedix,schedix2,schedix3
reindex
SCELTA=0
ENDIF
*********************
IF SCELTA=15
CLEAR
WAIT "PROCEDURA DA DEFINIRE"
*SET PROCEDURE TO TRASFER
*DO TRASFER
SCELTA=0
ENDIF
***********************
IF SCELTA=16
CLEAR
WAIT "PROCEDURA DA DEFINIRE"
SCELTA=0
ENDIF
*********************
IF SCELTA=17
RETURN
ENDIF
*********************
IF SCELTA=5
SET PROCEDURE TO CLIENTI
DO CLIENTI
CLOSE PROCEDURE
SCELTA=0
ENDIF
********************
IF SCELTA=4
SET PROCEDURE TO FORNITO
DO FORNITO
CLOSE PROCEDURE
ENDIF
********************
IF SCELTA=9
SET PROCEDURE TO NOTA
DO NOTA
CLOSE PROCEDURE
SCELTA=0
ENDIF
********************
IF SCELTA=8
CLEAR
SET PROCEDURE TO OPZIONI2
DO OPZIONI2
CLOSE PROCEDURE
SCELTA=0
ENDIF
********************
****************** ELIMINA IN BLOCCO BOLLE/FATTURE DA... A...
IF SCELTA=14
on key label f5 keyboard chr(23)
MFM=0
CLEAR
SET FORMAT TO
DIEL=SPACE(10)
DFEL=SPACE(10)
@ 4,4 SAY "Parametri per eliminazione bolle/fatture "
@ 6,4 say "Bolla / Fattura dalla data:"
@ 6,32 GET diel PICTURE "99-99-9999"
@ 6,42 SAY "A:"
@ 6,44 GET dfel PICTURE "99-99-9999"
@ 8,4 say "Indicare i parametri / F5 = Uscita"
@ 2,2 to 10,78 double
read
MFM=LASTKEY()
IF MFM<>23
rig_ri1=""
RIG_RI1B=""
if diel<>" ".and.dfel<>" "
rig_ri1=" DATA_BOLLA=>CtoD(DIEL).AND.data_BOLLA=<CtoD(DFEL)"
rig_ri1B=" DATA_F=>CtoD(DIEL).AND.data_F=<CtoD(DFEL)"
ELSE
RIG_RI1=""
endif
IF LEN(RIG_RI1)>1
USE BOL01
DELETE ALL FOR &RIG_RI1
DELETE ALL FOR &RIG_RI1B
CLEAR
SET FORMAT TO
WAIT "PREMERE UN TASTO PER VISUALIZZARE L'ELENCO DEI DOCUMENTI DA ELIMINARE"
DISPLAY ALL DEST,NUMERO_B,DATA_BOLLA,NUMERO_F,DATA_F FOR DELETED()
WAIT "CONFERMI L'ELIMINAZIONE DEFINITIVA S=S� / Altro tasto=Annulla" TO COCOSI
IF COCOSI="S".OR.COCOSI="s"
DO ELIMINA
ELSE
RECALL ALL
ENDIF
ENDIF
ENDIF
SCELTA=0
ON KEY
ENDIF
***********************

********* BOLLE FATTURE *********
IF SCELTA=7.AND.COICE=CC1
DAVENDITE=0
SET PROCEDURE TO ENZOS
DO ENZOS
CLOSE PROCEDURE
on key
set message to
SCELTA=0
ENDIF
********* SCELTA 11 PANNELLO DI CONTROLLO *********
IF SCELTA=11
*LIVEL =SPACE(5)
*CLEAR
*SET FORMAT TO
*@ 1,1 SAY "QUESTO LIVELLO E' PROTETTO INSERIRE IL CODICE "
*@ 1,47 GET LIVEL PICTURE "XXXXX"
*READ
*IF LIVEL="DANYX"
*SET PROCEDURE TO PANNELLO
*DO PANNELLO
*CLOSE PROCEDURE
*ENDIF
USE FORNITO INDEX FORNITOX
COUNT FOR DELETED() TO ELI
IF ELI>0
PACK
ENDIF
USE CLIENTI INDEX CLIENTIX
COUNT FOR DELETED() TO ELI
IF ELI>0
PACK
ENDIF
*USE SCHEDE INDEX SCHEDIX,SCHEDIX2,SCHEDIX3
*COUNT FOR DELETED() TO ELI
*IF ELI>0
*PACK
*ENDIF

SCLETA=0
ENDIF
******** SCELTA 12 GUIDA **************************
IF SCELTA=12
USE INTESTA
SET FORMAT TO INTESTA
EDIT RECORD 1
*SET PROCEDURE TO PRENOTA
*DO PRENOTA
*CLOSE PROCEDURE
SCELTA=0
ENDIF
IF SCELTA=14
CLEAR
TYPE GUIDA.TXT
WAIT
ENDIF
***************************************************
SCELTA=0
ENDDO
********************** PROCEDURA POPUP P1 MENU PRINCIPALE ******
PROCEDURE VAIP1
SCELTA=BAR()
DEACTIVATE POPUP
RETURN
*******************
PROCEDURE ELIMINA
**** ELIMINA LE SCHEDE BOLL
USE BOL01
COUNT FOR DELETED() TO ELI
IF ELI>0
USE ELBOL01
DELETE ALL
PACK
USE BOL01
COUNT ALL TO TOTBO01
CBO01=0
DO WHILE CBO01<TOTBO01
USE BOL01
CBO01=CBO01+1
GOTO RECORD CBO01
CCBO01=LTRIM(STR(CBO01))
FIBO01="BOL"+CCBO01+".DBF"
IF .NOT. DELETED()
USE ELBOL01
APPEND BLANK
REPLACE NOMEB WITH FIBO01
ELSE
ERASE &FIBO01
ENDIF
ENDDO
USE ELBOL01
GO TOP
DO WHILE .NOT. EOF()
BNOMEB=TRIM(NOMEB)
CELBO=LTRIM(STR(RECNO()))
FIELBO="BOL"+CELBO+".DBF"
RINO=BNOMEB+" TO "+FIELBO
IF BNOMEB<>FIELBO
RENAME &RINO
ENDIF
SKIP
ENDDO
USE BOL01
PACK
ENDIF
RETURN
**** FINE ELIMINA SCHEDE BOLLA
 

*****************************************************
* PROGRAMMA GESTIONE MAGAZZINO *
* PARTE VENDITE-TRE.PRG- *
*****************************************************
PROCEDURE VENDITE
set heading off
SET ESCAPE OFF
*SET FUNCTION 5 TO "@"
*SET FUNCTION 6 TO "#"
*SET FUNCTION 7 TO "$"
*set FUNCTION 8 TO ";"
USE
LL=1
MEM_STO=0
DO WHILE LL=1
DO WHILE LL=1
STORE SPACE(15) TO CODVA
STORE SPACE(30) TO CASVA
STORE SPACE(40) TO ARTVA
STORE 0 TO PREZZO
TESTO="CodiceÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ CasaÄÄÄÄÄÄ ArticoloÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ PrezzoÄÄÄÄ Quan."
clear
SET FORMAT TO
@ 3, 2 SAY "VENDITE ARTICOLI (P=Pezzi non in magazzino)"
@ 5, 3 SAY "Codice"
@ 5, 12 GET CODVA PICTURE "XXXXXXXXXXXXXXX"
@ 2, 1 TO 6,78
@ 12, 3 SAY "0=Ricerche su Casa e Articolo/F5ÄF6ÄF7=Conti 1Ä2Ä3/F4=Ritorno Menu'"
@ 13,3 SAY "F8=Conferma rapida"
READ
MFM=LASTKEY()
IF MFM=-3
CODVA="MENU "
ENDIF
IF MFM=-4
CODVA="@ "
ENDIF
IF MFM=-5
CODVA="# "
ENDIF
IF MFM=-6
CODVA="$ "
ENDIF
MEM_STO=0
******************* richiama procedura prenotazioni *************
*****************************************************************
IF CODVA="0 "
XVI=1
USE SCHEDE INDEX SCHEDIX2
DO WHILE XVI=1
@ 8, 3 SAY "Casa F4"
@ 8, 12 GET CASVA PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
@ 10, 3 SAY "Articolo"
@ 10, 12 GET ARTVA PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
READ
*************** NUOVA PROCEDURA ***
IF CASVA=SPACE(20).AND.ARTVA<>SPACE(30)
EXIT
ENDIF
MFM=LASTKEY()
XVI=0
IF MFM=-3
XVI=1
DO WHILE CASVA=CASA
IF EOF()
GO TOP
ELSE
SKIP
ENDIF
ENDDO
CASVA=CASA
ENDIF
IF MFM<>-3
GO TOP
IF CASVA=SPACE(20)
CASVA="XXXXXXXX"
ENDIF
FIND &CASVA
SET EXACT ON
IF CASVA<>CASA
CASVA=CASA
XVI=1
ENDIF
SET EXACT OFF
ENDIF
ENDDO
ENDIF
IF CODVA="P "
@ 5, 35 SAY "Prezzo " GET PREZZO PICTURE "9999999999.99999"
READ
ENDIF
IF CODVA=SPACE(15)
EXIT
ENDIF
IF CODVA<>"@ ".AND.CODVA<>"# ".AND.CODVA<>"$ "
IF CODVA="MENU "
LL=0
EXIT
ENDIF
USE SCHEDE INDEX SCHEDIX,SCHEDIX2,SCHEDIX3
SET FORMAT TO SCHEDE
************ Controlli su indicazioni generiche **************
IF CODVA="0 ".AND.ARTVA<>SPACE(40).AND.CASVA=SPACE(30)
wait "Invio = prezzo in EURO - L = prezzo in LIRE " TO ELLIEU
IF ELLIEU="L"
report form elencoa FOR trim(artva)$articolo
ELSE
report form elencoae FOR trim(artva)$articolo
ENDIF
WAIT"--- Prendere Nota del CODICE ! PREMERE UN TASTO ----" TO SP
EXIT
ENDIF
IF CODVA="0 ".AND.ARTVA=SPACE(40).AND.CASVA<>SPACE(30)
SET INDEX TO SCHEDIX2,SCHEDIX
RIGA=0
FIND &CASVA
IF EOF()
WAIT "--- Casa inesistente ! PREMERE UN TASTO ---" TO SP
EXIT
ENDIF
******
wait "Invio = prezzo in EURO - L = prezzo in LIRE " TO ELLIEU
if ellieu="L"
C_R_CA=0
?? "Codice---------" AT 0,;
"Cod.V.³Casa³Descrizione--------------------³Prezzo" AT 16,;
"V.-³Esistenza" AT 67
?
DO WHILE CASA=CASVA
C_R_CA=C_R_CA+1
IF C_R_CA=23
WAIT"--- Premere un tasto per continuare... ---"
C_R_CA=1
ENDIF
?? Cod picture "XXXXXXXXXXXXXXX" AT 0,;
RECNO() PICTURE "999,999" AT 15,;
"³" AT 22,;
Casa PICTURE "XXXX" AT 23,;
"³" AT 27,;
Articolo PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" AT 28,;
"³" AT 59,;
Prezzo_v PICTURE "99,999,999" AT 60,;
"³" AT 70,;
Disp_ma PICTURE "99,999.99" AT 71
?
SKIP
ENDDO
endif
***
if ellieu<>"L"
C_R_CA=0
?? "Codice---------" AT 0,;
"Cod.V.³Casa³Descrizione--------------------³Prezzo" AT 16,;
"V.-³Esistenza" AT 67
?
DO WHILE CASA=CASVA
C_R_CA=C_R_CA+1
IF C_R_CA=23
WAIT"--- Premere un tasto per continuare... ---"
C_R_CA=1
ENDIF
?? Cod picture "XXXXXXXXXXXXXXX" AT 0,;
RECNO() PICTURE "999,999" AT 15,;
"³" AT 22,;
Casa PICTURE "XXXX" AT 23,;
"³" AT 27,;
Articolo PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" AT 28,;
"³" AT 59,;
Prezzo_ve PICTURE "999,999.99" AT 60,;
"³" AT 70,;
Disp_ma PICTURE "99,999.99" AT 71
?
SKIP
ENDDO
endif

*report form elencoa for casa=trim(casva)
WAIT"--- Prendere Nota del CODICE ! PREMERE UN TASTO ----" TO SP
EXIT
ENDIF
IF CODVA="0 ".AND.ARTVA<>SPACE(40).AND.CASVA<>SPACE(30)
wait "Invio = prezzo in EURO - L = prezzo in LIRE " TO ELLIEU
IF ELLIEU="L"
report form elencoa FOR trim(artva)$articolo.AND.CASA=TRIM(CASVA)
ELSE
report form elencoae FOR trim(artva)$articolo.AND.CASA=TRIM(CASVA)
ENDIF
WAIT"--- Prendere Nota del CODICE ! PREMERE UN TASTO ----" TO SP
EXIT
ENDIF
******************** IL CODICE E' STATO DIGITATO ***********
SET EXACT OFF
FIND &CODVA
SET EXACT OFF
IF EOF()
CODTRO=0
IF VAL(CODVA)<>0
USE SCHEDE
GO BOTTOM
JJJ=RECNO()
JJJJ=VAL(CODVA)
USE SCHEDE INDEX SCHEDIX,SCHEDIX2,SCHEDIX3
SET FORMAT TO SCHEDE
IF JJJJ>JJJ.OR.JJJJ<1
WAIT"--- Codice inesistente ! PREMERE UN TASTO ---" TO SP
Exit
ENDIF
GOTO JJJJ
CODVA=COD
CODTRO=1
ENDIF
IF CODTRO=0
WAIT"--- Codice inesistente ! PREMERE UN TASTO ---" TO SP
Exit
ENDIF
ENDIF
?? "Codice---------" AT 0,;
"Cod.V.³Casa³Descrizione--------------------³Prezzo" AT 16,;
"V.-³Esistenza" AT 67
?
?? Cod picture "XXXXXXXXXXXXXXX" AT 0,;
RECNO() PICTURE "999,999" AT 15,;
"³" AT 22,;
Casa PICTURE "XXXX" AT 23,;
"³" AT 27,;
Articolo PICTURE "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" AT 28,;
"³" AT 59,;
Prezzo_v PICTURE "99,999,999" AT 60,;
"³" AT 70,;
Disp_ma PICTURE "99,999.99" AT 71
**AGGIUNTA EURO2000
?
?? " " AT 0,;
" " AT 15,;
"³" AT 22,;
" " AT 23,;
"³" AT 38,;
"Prezzo in Euro->" AT 39,;
Prezzo_ve PICTURE "9,999,999.99999" AT 55,;
"³" AT 70,;
" " AT 71
**FINE AGGIUNTA EURO2000
STO=0
QUA=1.00
VEN="W"
MEMO_P=Prezzo_v
****************** POPUP VENDITA ********************
IF LASTKEY()<>-7
ON KEY LABEL F5 DO KCINQUE
ON KEY LABEL F6 DO KSEI
ON KEY LABEL F7 DO KSETTE
IF VEN="W"
DEFINE POPUP P2 FROM 14,1 TO 22,13
DEFINE BAR 1 OF P2 PROMPT "F5 CONTO 1"
DEFINE BAR 2 OF P2 PROMPT "F6 CONTO 2"
DEFINE BAR 3 OF P2 PROMPT "F7 CONTO 3"
DEFINE BAR 4 OF P2 PROMPT "SCONTO "
DEFINE BAR 5 OF P2 PROMPT "QUANTITA'"
DEFINE BAR 6 OF P2 PROMPT "PREZZO A."
DEFINE BAR 7 OF P2 PROMPT "ANNULLA"
ON SELECTION POPUP P2 DO VAIP2
ACTIVATE POPUP P2
ENDIF
ELSE
VEN="ü"
ENDIF
*****************************************************
**** FINE SCONTO SU ARTICOLO SINGOLO ****
IF VEN="A"
ON KEY
Exit
ENDIF
IF VEN="ü"
CONTO="CONTO1"
on key
ENDIF
IF VEN="û"
CONTO="CONTO2"
on key
ENDIF
IF VEN="ú"
CONTO="CONTO3"
on key
ENDIF
******************** DICHIARAZIONE VARIABILI ***********
c2=recno()
C1=COD
CA1=CASA
AR1=ARTICOLO
AR2=ARTICOL2
UM1=UM
IV1=IVA
**AGGIUNTA EURO2000
PU1E=PREZZO_VE
**QUI BISOGNA TROVARE IL SISTEMA PER DISTINGUERE EURO DA LIRA
IF CODVA="P "
PU1E=prezzo
PR1E=PREZZO*QUA
GU1E=0
ELSE
IVA_AE=ROUND(PREZZO_AE/100*iv1,5)
IVA_VE=ROUND(PREZZO_VE/(100+iv1)*iv1,5)
DIF_IVAE=IVA_VE-IVA_AE
PR1E=PREZZO_VE*QUA
GU1E=(PREZZO_VE-(PREZZO_AE+IVA_AE)-DIF_IVAE)*QUA
ENDIF
IF STO<1
*** ARROTONDAMENTO SCONTO ****** PER LE LIRE ARROTONDA ALLE 50 LIRE... MI PARE
STOE=ROUND((PREZZO_VE/100*(-STO)),5)
*** FINE ARROTONDAMENTO ********
ENDIF
IF STOE>0
IVA_AE=ROUND(PREZZO_AE/100*iv1,5)
PR1E=(PREZZO_VE-STOE)
PU1E=PR1E
IVA_VE=ROUND(PR1E/(100+iv1)*iv1,5)
DIF_IVAE=IVA_VE-IVA_AE
GU1E=(PR1E-(PREZZO_AE+IVA_AE)-DIF_IVAE)*QUA
PR1E=PR1E*QUA
ENDIF
NU1E=QUA
DM1E=QUA
**FINE AGGIUNTA EURO2000
*************************LIRA
PU1=PREZZO_V
IF CODVA="P "
PU1=prezzo
PR1=PREZZO*QUA
GU1=0
ELSE
IVA_A=PREZZO_A/100*iv1
IVA_V=PREZZO_V/(100+iv1)*iv1
DIF_IVA=IVA_V-IVA_A
PR1=PREZZO_V*QUA
GU1=(PREZZO_V-(PREZZO_A+IVA_A)-DIF_IVA)*QUA
ENDIF
IF STO<1
*** ARROTONDAMENTO SCONTO ******
STOL=ROUND((PREZZO_V/100*(-STO)),0)
IF MEM_STO>0
STOL=MEM_STO
ENDIF
*** FINE ARROTONDAMENTO ********
ENDIF
IF STOL>0
IVA_A=PREZZO_A/100*iv1
PR1=(PREZZO_V-STOL)
PU1=PR1
IVA_V=PR1/(100+iv1)*iv1
DIF_IVA=IVA_V-IVA_A
GU1=(PR1-(PREZZO_A+IVA_A)-DIF_IVA)*QUA
PR1=PR1*QUA
ENDIF
NU1=QUA
DM1=QUA
**FINE LIRA
IF DISP_MA-QUA<0
WAIT"--- Non risulta in Archivio quantit… venduta ! PREMERE UN TASTO --" TO SP
EXIT
ENDIF
******************** SCRITTURA NEL CONTO *************
TOTALE=0
USE &CONTO
APPEND BLANK
REPLACE CODCO WITH C1,codco2 with c2,cACO WITH CA1,ARCO WITH AR1,ARCO2 WITH AR2,QUACO WITH NU1,RICO WITH PR1,GUACO WITH GU1,DMCO WITH DM1,IVCO WITH IV1,PUCO WITH PU1,UMCO WITH UM1
**AGGIUNTA EURO2000 ... RIGA MODIFICATA
REPLACE RICOE WITH PR1E,GUACOE WITH GU1E,PUCOE WITH PU1E
**FINE EURO2000
clear
ENDIF
*********** ENDIF DI 00 CODICE ********
CLEAR
IF CODVA="@ "
CONTO="CONTO1"
ENDIF
IF CODVA="# "
CONTO="CONTO2"
ENDIF
IF CODVA="$ "
CONTO="CONTO3"
ENDIF
USE &CONTO
SUM ALL RICO TO TOTALE
*SET COLOR TO +7,0,0
? "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
? "º "+CONTO+" º"
? "ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ"
?
?? "Codice---------" AT 0,;
"Cod.V.³Casa-----------³Descrizione---------³Importo---³Quantit…-" AT 16
CON_TA_RI=0
GO TOP
DO WHILE .NOT. EOF()
?
?? Codco AT 0,;
CODCO2 PICTURE "999,999" AT 15,;
"³" AT 22,;
Caco PICTURE "XXXXXXXXXXXXXXX" AT 23,;
"³" AT 38,;
Arco PICTURE "XXXXXXXXXXXXXXXXXXXX" AT 39,;
"³" AT 59,;
Rico PICTURE "99,999,999" AT 60,;
"³" AT 70,;
Quaco PICTURE "99,999.99" AT 71
**AGGIUNTA EURO2000
?
?? "EURO->" AT 48,;
RicoE PICTURE "9,999,999.99999" AT 55
**FINE EURO2000
CON_TA_RI=CON_TA_RI+2
IF CON_TA_RI=10
WAIT "Premi un tasto per Proseguire !"
con_ta_ri=0
clear
? "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
? "º "+CONTO+" º"
? "ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ"
?
?? "Codice---------" AT 0,;
"Cod.V.³Casa-----------³Descrizione---------³Importo---³Quantit…-" AT 16
?
endif
SKIP
ENDDO
? SPACE(60)+"ÄÄÄÄÄÄÄÄÄÄ"
? "TOTALE LIRE" at 48,;
totale picture "99,999,999" at 60
? "TOTALE EURO" at 48,;
round(totale/1936.27,2) picture "99,999,999.99" at 60
? "============================================================================"
******************** DECISIONI SU CONTO ***************
RI="W"
********************** POPUP VENDITE SECONDA VIDEATA P2B **********
DEFINE POPUP P2B FROM 17,20 TO 23,37
DEFINE BAR 1 OF P2B PROMPT "CONTINUA CONTO "
DEFINE BAR 2 OF P2B PROMPT "ALTRO CONTO "
DEFINE BAR 3 OF P2B PROMPT "STAMPA CONTO "
DEFINE BAR 4 OF P2B PROMPT "VARIA CONTO "
DEFINE BAR 5 OF P2B PROMPT "FATTURA/BOLLA"
ON SELECTION POPUP P2B DO VAIP2B
ACTIVATE POPUP P2B
**** FATTURE BLOCCA OPERAZIONE *****
IF RI="F".OR.RI="f"
DAVENDITE=1
SET PROCEDURE TO ENZOS
DO ENZOS
ON KEY
SET MESSAGE TO
DAVENDITE=0
CLEAR
RI="A"
USE &CONTO
ENDIF
**** FINE **************************
IF ASC(RI)=13
EXIT
ENDIF
IF RI="V".OR.RI="v"
CODVARIA=SPACE(15)
?
?
SET FORMAT TO
@ 24,1 SAY "Indicare il codice da variare (*)=TUTTI " GET CODVARIA PICTURE "XXXXXXXXXXXXXXX"
READ
IF CODVARIA="* "
DELETE ALL
PACK
EXIT
ENDIF
COUNT FOR CODCO=CODVARIA TO CEVARIA
IF CEVARIA>0
LOCATE FOR CODCO=CODVARIA
PASSA=1
DO WHILE CEVARIA>PASSA
CONTINUE
PASSA=PASSA+1
ENDDO
DELETE
PACK
EXIT
ENDIF
************* VARIA CON CODICE CODCO2
IF CEVARIA=0
codvarNU=VAL(trim(codvaria))
COUNT FOR CODCO2=CODVARNU TO CEVARIA
IF CEVARIA=0
*SET COLOR TO +7,0,0
WAIT "--- Codice non in elenco conto ! PREMERE UN TASTO ---"
EXIT
ENDIF
IF CEVARIA>0
LOCATE FOR CODCO2=CODVARNU
PASSA=1
DO WHILE CEVARIA>PASSA
CONTINUE
PASSA=PASSA+1
ENDDO
DELETE
PACK
EXIT
ENDIF
ENDIF
***************************
IF CEVARIA=0
*SET COLOR TO +7,0,0
WAIT "--- Codice non in elenco conto ! PREMERE UN TASTO ---"
EXIT
ENDIF
***************************
ENDIF
*********** FASE REGISTRAZIONE VENDITA **********
?
Y=24
STORE 0 TO SCONTO,RE,TOTSCO,PAGA
SET FORMAT TO
@ Y , 54 SAY "SCONTO L." GET SCONTO PICTURE "999,999,999"
READ
IF SCONTO<0
SCONTO=ROUND((TOTALE/100*(-SCONTO)),0)
*** ARROTONDAMENTO SCONTO ******
*SD100=SCONTO/100
*SDINT=INT(SCONTO/100)
*SDDIF=SD100-SDINT
*IF SDDIF>0
* IF SDDIF>0.50
* SCONTO=SCONTO-(SDDIF*100)+50
* ELSE
* SCONTO=SCONTO-(SDDIF*100)
* ENDIF
*ENDIF
*** FINE ARROTONDAMENTO ********
ENDIF
TOTSCO=TOTALE-SCONTO
*SET COLOR TO +7,0,0
?
? "TOTALE LIRE" AT 54,;
TOTSCO PICTURE "999,999,999" AT 63
? "TOTALE EURO" at 54,;
round(totSCO/1936.27,2) picture "999,999,999.99" at 63
?
SET FORMAT TO
@ 24, 54 SAY "PAGA CON" GET PAGA PICTURE "999,999,999"
READ
IF PAGA>0
RE=PAGA-TOTSCO
?
? "RESTO LIRE" AT 54,;
RE PICTURE "999,999,999" AT 63
ENDIF
***** ULTIMA CONFERMA PRIMA DI PASSARE A REGISTRAZIONE CONTO ****
FISC=""
?
?
WAIT " --- Return=PROSEGUE / (R)=RITORNA NEL CONTO ---" TO FISC
IF FISC="R".OR.FISC="r"
EXIT
ENDIF
**** FINE CONFERMA
********************* DATI SCONTRINO FISCALE ***********
USE
CDISCOD=CONTO+".DBF"
*COPY FILE &CDISCOD TO D:\&CDISCOD
*SET DIRECTORY TO D:\
USE &CONTO
COUNT ALL TO TTFI
TTFIP=0
USE FISCALE
DELETE ALL
PACK
APPEND BLANK
REPLACE FISCALE WITH "KXCL"
ERASE FCASSA.TXT
DO WHILE TTFIP<TTFI
TTFIP=TTFIP+1
USE &CONTO
GOTO RECORD TTFIP
IF QUACO>1
FI="KX"+LTRIM(STR(QUACO))+"* "
USE FISCALE
APPEND BLANK
REPLACE FISCALE WITH FI
USE &CONTO
GOTO RECORD TTFIP
ENDIF
FI="KX"+LTRIM(STR(PUCO))+"R1"
USE FISCALE
APPEND BLANK
REPLACE FISCALE WITH FI
ENDDO
USE FISCALE
APPEND BLANK
REPLACE FISCALE WITH "KXT1"
COPY TO FCASSA.TXT TYPE DELIMITED WITH BLANK
*SET DIRECTORY TO C:\mag
USE &CONTO
************************ INSERIMENTO PROCEDURA CALCOLA RICAVI DEI CONTI ****
SUM ALL QUACO TO QFX
SUM ALL RICO TO RFX
SUM ALL GUACO TO GFX
APPEND BLANK
REPLACE CODCO WITH CONTO,QUACO WITH QFX,DMCO WITH QFX,RICO WITH RFX,GUACO WITH GFX
****************************************************************************
IF SCONTO>0
APPEND BLANK
REPLACE CODCO WITH "SCONTO",RICO WITH -SCONTO,GUACO WITH -SCONTO,QUACO WITH 1
REPLACE RICOE WITH ROUND(-SCONTO/1936.27,2),GUACOE WITH ROUND(-SCONTO/1936.27,2)
ENDIF
IF RI="S".OR.RI="s"
*RUN RCASSA <==== DISABILITATO SERVE PER STAMPARE LO SCONTRINO
ENDIF
******* FINE STAMPA CONTO *******
KK=0
COUNT ALL TO EZZI
DO WHILE KK<EZZI
KK=KK+1
USE &CONTO
GOTO KK
CODICER=CODCO
NVGC=QUACO
GUC=GUACO
RIC=RICO
DISMC=DMCO
**AGGIUNTA EURO2000
GUCE=GUACOE
RICE=RICOE
**FINE EURO2000
USE SCHEDE INDEX SCHEDIX,SCHEDIX2,SCHEDIX3
FIND &CODICER
********** INIZIO REGISTRAZIONE *******
IF DATA_VE<>DATE()
IF MONTH(DATA_VE)=MONTH(DATE())
REPLACE N_VEND_S WITH N_VEND_S+N_VEND_G,RIC_S WITH RIC_S+RIC_G,GUA_S WITH GUA_S+GUA_G
REPLACE N_VEND_M WITH N_VEND_M+N_VEND_G,RIC_M WITH RIC_M+RIC_G,GUA_M WITH GUA_M+GUA_G
REPLACE N_VEND_G WITH 0,RIC_G WITH 0,GUA_G WITH 0
**AGGIUNTA EURO2000
REPLACE RIC_SE WITH RIC_SE+RIC_GE,GUA_SE WITH GUA_SE+GUA_GE
REPLACE RIC_ME WITH RIC_ME+RIC_GE,GUA_ME WITH GUA_ME+GUA_GE
REPLACE RIC_GE WITH 0,GUA_GE WITH 0
**FINE EURO2000
ENDIF
IF MONTH(DATA_VE)<>MONTH(DATE())
REPLACE N_VEND_A WITH N_VEND_A+N_VEND_M+N_VEND_G,RIC_A WITH RIC_A+RIC_M+RIC_G,GUA_A WITH GUA_A+GUA_M+GUA_G
REPLACE N_VEND_S WITH N_VEND_S+N_VEND_G,RIC_S WITH RIC_S+RIC_G,GUA_S WITH GUA_S+GUA_G
REPLACE N_VEND_M WITH 0,RIC_M WITH 0,GUA_M WITH 0
REPLACE N_VEND_G WITH 0,RIC_G WITH 0,GUA_G WITH 0
**AGGIUNTA EURO2000
REPLACE RIC_AE WITH RIC_AE+RIC_ME+RIC_GE,GUA_AE WITH GUA_AE+GUA_ME+GUA_GE
REPLACE RIC_SE WITH RIC_SE+RIC_GE,GUA_SE WITH GUA_SE+GUA_GE
REPLACE RIC_ME WITH 0,GUA_ME WITH 0
REPLACE RIC_GE WITH 0,GUA_GE WITH 0
**FINE EURO2000
ENDIF
REPLACE DATA_VE WITH DATE()
ENDIF
REPLACE DISP_MA WITH DISP_MA-DISMC
REPLACE N_VEND_G WITH N_VEND_G+NVGC,RIC_G WITH RIC_G+RIC,GUA_G WITH GUA_G+GUC
**AGGIUNTA EURO2000
REPLACE RIC_GE WITH RIC_GE+RICE,GUA_GE WITH GUA_GE+GUCE
**FINE EURO2000
********* FINE REGISTRAZIONE ****
ENDDO
****************************************************
* REGISTRA TUTTE LE VENDITE IN CONTOT.DBF *
****************************************************
*USE CONTOT
*APPEND FROM &CONTO
****************************************************
* FINE REGISTRAZIONE *
****************************************************
USE &CONTO
DELETE ALL
PACK
ENDDO
ENDDO
RETURN
************************************************
************************************************
*******************************************
* PROCEDURA BOLLE *
*******************************************
PROCEDURE BOLLE
STORE 0 TO COCLIE,BIANCO,RIPETI,TARTI2,S3B
QQQ=""
DO WHILE RIPETI=0
DO WHILE RIPETI=0
SET FORMAT TO
CLEAR
@ 2,1 TO 7,44
@ 3,2 SAY "COMPILAZIONE BOLLA"
@ 4,2 SAY "Codice Cliente "
@ 4,17 GET COCLIE PICTURE "999999"
@ 6,17 SAY "0=Annulla/-1=ELENCO CLIENTI"
READ
IF COCLIE=-1
USE CLIENTI INDEX CLIENTIX
? "Codice ClienteÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
DISPLAY ALL SPETTAC
wait "--- Prendere nota del CODICE ! PREMERE UN TASTO ---"
exit
endif
IF COCLIE=0
RETURN
ENDIF
USE CLIENTI INDEX CLIENTIX
COUNT TO TUTTIC
IF COCLIE>TUTTIC.OR.COCLIE<0
WAIT "--- Codice Cliente non trovato ! (B)=Bolla in bianco\(RETURN)=Ritenta ---" to SB
IF SB<>"B".AND.SB<>"b"
EXIT
ENDIF
IF SB="B".OR.SB="b"
BIANCO=1
ENDIF
ENDIF
************** APRE CLIENTI E VERSA DATI IN BOLLA ***************
RIPETI=1
ENDDO
ENDDO
IF BIANCO=0
USE CLIENTI INDEX CLIENTIX
GOTO RECORD COCLIE
SP=SPETTAC
ID=INDIRIZZOC
CI=CAP_CITTC
PI=PIVAC
USE BOLLE
COUNT ALL FOR TRIM(TIPO)="B".OR.TRIM(TIPO)="E" TO BBTT
APPEND BLANK
REPLACE DEST WITH SP,LUOGO WITH ID,CAP_CITTA WITH CI,PIVA WITH PI,C_CLI WITH COCLIE,DATA_BOLLA WITH DATE()
ORDATA=DTOC(DATE())+"-"+TIME()
REPLACE DAT_OR_T WITH ORDATA,CAP_CITTA2 WITH CI,LUOGO2 WITH ID,NUMERO_B WITH BBTT+1,TIPO WITH "B"
ENDIF
IF BIANCO=1
USE BOLLE
APPEND BLANK
ENDIF
USE &CONTO
COUNT TO TARTI
IF TARTI>0
DO WHILE TARTI2<TARTI
TARTI2=TARTI2+1
USE &CONTO
GOTO TARTI2
IF TARTI2<10
NA=STR(TARTI2,1,0)
ENDIF
IF TARTI2>9.AND.TARTI2<100
NA=STR(TARTI2,2,0)
ENDIF
IF TARTI2>99.AND.TARTI2<1000
NA=STR(TARTI2,3,0)
ENDIF
IF TARTI2>999.AND.TARTI2<10000
NA=STR(TARTI2,4,0)
ENDIF
CD=CODCO
A=ARCO
Q=QUACO
IVX=IVCO
P_SPR=(PUCO/(100+IVCO))*IVCO
if p_SPr<>int(p_SPr)
p_SPr=int(p_SPr)+1
endif
PR=PUCO-P_SPR
? STR(PR)
***** ARROTONDAMENTO PREZZO UNITARIO SCORPORATO IVA *****
**********************************************************
USE BOLLE
GO BOTTOM
HCAMBIA=" "+"CD"+NA+" WITH CD, A"+NA+" WITH A, Q"+NA+" WITH Q, P"+NA+" WITH PR, I"+NA+" WITH IVX"
REPLACE &HCAMBIA
ENDDO
ENDIF
USE BOLLE
GO BOTTOM
DO FATBOL
RETURN
*********************
* SCHEDA BOLLA *
*********************
********************************************************
* PROCEDURA BOLLA *
********************************************************
PROCEDURE FATBOL
********************************************************
IF SCELTA=7
SET HEADING OFF
STORE 0 TO NUMERBOL,COCLIBOL,S4B,S3B,TARTI2
DO WHILE S4B=0
DO WHILE S4B=0
STORE " " TO TIPBOL
SET FORMAT TO
CLEAR
@ 1,1 TO 10,35
@ 2,2 SAY "VISUALIZZA/VARIA BOLLE E FATTURE"
@ 3,2 say "Codice"
@ 3,17 get numerbol PICTURE "99999"
@ 5,2 SAY "Codice Cliente"
@ 5,17 GET COCLIBOL PICTURE "99999"
@ 7, 2 SAY "Tipo B/E/F"
@ 7,17 get TIPBOL PICTURE "XXX"
@ 9,2 SAY "Return Return Return= ANNULLA"
READ
IF NUMERBOL=0.AND.COCLIBOL=0.AND.TIPbol=" "
S4B=1
RETURN
ENDIF
IF NUMERBOL>0
USE BOLLE
GO BOTTOM
FFBB=RECNO()
IF NUMERBOL<FFBB+1.AND.NUMERBOL>0
GOTO RECORD NUMERBOL
ELSE
WAIT"--- Numero Bolla inesistente ! PREMERE UN TASTO ---"
Exit
ENDIF
S4B=1
Exit
ENDIF
IF NUMERBOL=0
? "Codice- Num.e data bolla--- Num.e data fattura-Codice e nominativo cliente- Tipo"
ENDIF
IF NUMERBOL=0.AND.COCLIBOL>0.AND.TIPBOL=" "
USE BOLLE
DISPLAY ALL NUMERO_B,DATA_BOLLA,NUMERO_F,DATA_F,C_CLI,SUBSTR(DEST,1,27),TIPO FOR C_CLI=COCLIBOL
WAIT"--- Prendere Nota del CODICE ! PREMERE UN TASTO ---"
EXIT
ENDIF
IF NUMERBOL=0.AND.COCLIBOL>0.AND.TIPBOL<>" "
USE BOLLE
DISPLAY ALL NUMERO_B,DATA_BOLLA,NUMERO_F,DATA_F,C_CLI,SUBSTR(DEST,1,27),TIPO FOR C_CLI=COCLIBOL.AND.TIPO=TRIM(TIPBOL)
IF TRIM(TIPBOL)<>"B"
WAIT"--- Prendere Nota del CODICE ! PREMERE UN TASTO ---"
ELSE
WAIT"--- Prendere nota del CODICE ! (R) PER RAGGRUPPARE LE BOLLE IN FATTURA --" TO WLJ
IF WLJ="R".OR.WLJ="r"
ghz=0
DO WHILE GHZ=0
DO FATBOL2
USE BOLLE
GO BOTTOM
? "*** CODICE DELLE BOLLE RAGGRUPPATE ===>"+STR(RECNO())
ENDDO
WAIT "--- Prendere Nota del CODICE ! PREMERE UN TASTO ---"
ENDIF
ENDIF
EXIT
ENDIF

IF NUMERBOL=0.AND.COCLIBOL=0.AND.TIPBOL<>" "
USE BOLLE
DISPLAY ALL NUMERO_B,DATA_BOLLA,NUMERO_F,DATA_F,C_CLI,SUBSTR(DEST,1,27),TIPO FOR TIPO=TRIM(TIPBOL)
WAIT"--- Prendere Nota del CODICE ! PREMERE UN TASTO ---"
EXIT
ENDIF
ENDDO
ENDDO
ENDIF
************** FINE PROCEDURA BOLLE RICHIAMATA DA MENU' PRINCIPALE *****
DO WHILE S3B=0
CLEAR
@ 2, 2 SAY "INSERIMENTO DATI BOLLA Codice Cliente"
@ 2, 40 GET BOLLE->C_CLI
@ 2, 48 SAY "Scheda Nø"
@ 2, 58 say recno()
@ 2, 72 SAY "Tipo"
@ 2, 77 get BOLLE->TIPO
@ 3, 3 SAY "Destinatario"
@ 3, 25 GET BOLLE->DEST
@ 4, 3 SAY "Indirizzo "
@ 4, 25 get bolle->LUOGO2
@ 5, 3 SAY "C.A.P. Citt…"
@ 5,25 get BOLLE->CAP_CITTA2
@ 6, 3 SAY "Luogo di destinazione"
@ 6, 25 GET BOLLE->LUOGO
@ 7, 3 SAY "C.A.P. Citt…"
@ 7, 25 get BOLLE->CAP_CITTA
@ 8, 3 SAY "Riferimento"
@ 8, 25 GET BOLLE->RIFER
@ 10, 3 SAY "Partita IVA"
@ 10, 15 GET BOLLE->PIVA
@ 10, 37 SAY "Numero bolla"
@ 10, 50 GET BOLLE->NUMERO_B
@ 10, 59 SAY "Data bolla"
@ 10, 70 GET BOLLE->DATA_BOLLA
@ 11, 37 SAY "Num. fattura"
@ 11, 50 get BOLLE->NUMERO_F
@ 11, 59 SAY "Data fatt."
@ 11, 70 get BOLLE->DATA_F
@ 12, 3 SAY "Aspetto esteriore"
@ 12, 25 GET BOLLE->ASPETTO
@ 14, 3 SAY "Causale"
@ 14, 25 GET BOLLE->CAUSALE
@ 16, 3 SAY "Porto"
@ 16, 25 GET BOLLE->PORTO
@ 16, 57 SAY "Nø Colli"
@ 16, 66 GET BOLLE->N_COLLI
@ 18, 3 SAY "Peso lordo"
@ 18, 25 GET BOLLE->PESO_L
@ 18, 38 SAY "Peso netto"
@ 18, 49 GET BOLLE->PESO_N
@ 18, 60 SAY "Volume"
@ 18, 67 GET BOLLE->VOLUME
@ 20, 3 SAY "Trasporto a cura "
@ 20, 20 GET BOLLE->A_CURA_DEL
@ 20, 51 SAY "Dat/ora i.tras."
@ 20, 66 GET BOLLE->DAT_OR_T PICTURE "XXXXXXXXXXXXXX"
@ 21, 3 say "Cond.pag."
@ 21, 12 get BOLLE->COND_PA
@ 22, 3 SAY "Banca "
@ 22, 12 get BOLLE->BANC_A
@ 23,3 SAY "Scadenze"
@ 23,12 GET BOLLE->SCADENZE
@ 24,3 SAY "Vettore "
@ 24,11 get BOLLE->NOTE
@ 24,35 SAY "Resa"
@ 24,40 get BOLLE->RESA
@ 24,65 SAY "Spese œ "
@ 24,73 get BOLLE->SPESE
READ
CLEAR
@ 1, 0 SAY "Codice--------- Descrizione-Articolo-------------------- Quant.- Iva Prezzo----"
@ 2, 0 GET BOLLE->CD1
@ 2, 16 GET BOLLE->A1
@ 2, 57 GET BOLLE->Q1
@ 2, 65 get BOLLE->I1
@ 2, 69 GET BOLLE->P1
@ 3, 0 GET BOLLE->CD2
@ 3, 16 GET BOLLE->A2
@ 3, 57 GET BOLLE->Q2
@ 3, 65 get BOLLE->I2
@ 3, 69 GET BOLLE->P2
@ 4, 0 GET BOLLE->CD3
@ 4, 16 GET BOLLE->A3
@ 4, 57 GET BOLLE->Q3
@ 4, 65 get BOLLE->I3
@ 4, 69 GET BOLLE->P3
@ 5, 0 GET BOLLE->CD4
@ 5, 16 GET BOLLE->A4
@ 5, 57 GET BOLLE->Q4
@ 5, 65 get BOLLE->I4
@ 5, 69 GET BOLLE->P4
@ 6, 0 GET BOLLE->CD5
@ 6, 16 GET BOLLE->A5
@ 6, 57 GET BOLLE->Q5
@ 6, 65 get BOLLE->I5
@ 6, 69 GET BOLLE->P5
@ 7, 0 GET BOLLE->CD6
@ 7, 16 GET BOLLE->A6
@ 7, 57 GET BOLLE->Q6
@ 7, 65 get BOLLE->I6
@ 7, 69 GET BOLLE->P6
@ 8, 0 GET BOLLE->CD7
@ 8, 16 GET BOLLE->A7
@ 8, 57 GET BOLLE->Q7
@ 8, 65 get BOLLE->I7
@ 8, 69 GET BOLLE->P7
@ 9, 0 GET BOLLE->CD8
@ 9, 16 GET BOLLE->A8
@ 9, 57 GET BOLLE->Q8
@ 9, 65 get BOLLE->I8
@ 9, 69 GET BOLLE->P8
@ 10, 0 GET BOLLE->CD9
@ 10, 16 GET BOLLE->A9
@ 10, 57 GET BOLLE->Q9
@ 10, 65 get BOLLE->I9
@ 10, 69 GET BOLLE->P9
@ 11, 0 GET BOLLE->CD10
@ 11, 16 GET BOLLE->A10
@ 11, 57 GET BOLLE->Q10
@ 11, 65 get BOLLE->I10
@ 11, 69 GET BOLLE->P10
@ 12, 0 GET BOLLE->CD11
@ 12, 16 GET BOLLE->A11
@ 12, 57 GET BOLLE->Q11
@ 12, 65 get BOLLE->I11
@ 12, 69 GET BOLLE->P11
@ 13, 0 GET BOLLE->CD12
@ 13, 16 GET BOLLE->A12
@ 13, 57 GET BOLLE->Q12
@ 13, 65 get BOLLE->I12
@ 13, 69 GET BOLLE->P12
@ 14, 0 GET BOLLE->CD13
@ 14, 16 GET BOLLE->A13
@ 14, 57 GET BOLLE->Q13
@ 14, 65 get BOLLE->I13
@ 14, 69 GET BOLLE->P13
@ 15, 0 GET BOLLE->CD14
@ 15, 16 GET BOLLE->A14
@ 15, 57 GET BOLLE->Q14
@ 15, 65 get BOLLE->I14
@ 15, 69 GET BOLLE->P14
@ 16, 0 GET BOLLE->CD15
@ 16, 16 GET BOLLE->A15
@ 16, 57 GET BOLLE->Q15
@ 16, 65 get BOLLE->I15
@ 16, 69 GET BOLLE->P15
@ 17, 0 GET BOLLE->CD16
@ 17, 16 GET BOLLE->A16
@ 17, 57 GET BOLLE->Q16
@ 17, 65 get BOLLE->I16
@ 17, 69 GET BOLLE->P16
@ 18, 0 GET BOLLE->CD17
@ 18, 16 GET BOLLE->A17
@ 18, 57 GET BOLLE->Q17
@ 18, 65 get BOLLE->I17
@ 18, 69 GET BOLLE->P17
@ 19, 0 GET BOLLE->CD18
@ 19, 16 GET BOLLE->A18
@ 19, 57 GET BOLLE->Q18
@ 19, 65 get BOLLE->I18
@ 19, 69 GET BOLLE->P18
@ 20, 0 GET BOLLE->CD19
@ 20, 16 GET BOLLE->A19
@ 20, 57 GET BOLLE->Q19
@ 20, 65 get BOLLE->I19
@ 20, 69 GET BOLLE->P19
@ 21, 0 GET BOLLE->CD20
@ 21, 16 GET BOLLE->A20
@ 21, 57 GET BOLLE->Q20
@ 21, 65 get BOLLE->I20
@ 21, 69 GET BOLLE->P20
*** IL P20 ERA P19
@ 22, 0 GET BOLLE->CD21
@ 22, 16 GET BOLLE->A21
@ 22, 57 GET BOLLE->Q21
@ 22, 65 get BOLLE->I21
@ 22, 69 GET BOLLE->P21
@ 23, 0 GET BOLLE->CD22
@ 23, 16 GET BOLLE->A22
@ 23, 57 GET BOLLE->Q22
@ 23, 65 get BOLLE->I22
@ 23, 69 GET BOLLE->P22
READ
******************* CONTEGGIO TOTALI PER IVA ***********************
STORE 0 TO PPTOT,PPTOT1,PPTOT2,PPTOT3,PPTOT4,PPTOT5,PPTIVA,PPIVA1,PPIVA2,PPIVA3,PPIVA4,PPIVA5,IQ
VCY=0
DO WHILE VCY<22
VCY=VCY+1
IF VCY<10
VCYB=STR(VCY,1,0)
ELSE
VCYB=STR(VCY,2,0)
ENDIF
JKCOD=" CD"+VCYB+" "
JKCAQ=" Q"+VCYB+" "
JKCAP="(P"+VCYB+" *"+JKCAQ+")"
IF &JKCAQ>0.OR.TRIM(&JKCOD)="Riferimento"
IQQQ="I"+VCYB+" "
IQ=&IQQQ
ELSE
VCY=22
ENDIF
IF IQ=0
PPTOT1=PPTOT1+&JKCAP
** PPIVA1=0
ENDIF
IF IQ=4
PPTOT2=PPTOT2+&JKCAP
** PPIVA2=PPTOT2/100*4
ENDIF
IF IQ=10
PPTOT3=PPTOT3+&JKCAP
** PPIVA3=PPTOT3/100*10
ENDIF
IF IQ=16
PPTOT4=PPTOT4+&JKCAP
** PPIVA4=PPTOT4/100*16
ENDIF
IF IQ=19
PPTOT5=PPTOT5+&JKCAP
** PPIVA5=PPTOT5/100*19
ENDIF
ENDDO
PPTOT=PPTOT1+PPTOT2+PPTOT3+PPTOT4+PPTOT5+SPESE
PPTOM=PPTOT1+PPTOT2+PPTOT3+PPTOT4+PPTOT5
PPIVA1=0
*** PPIVA2 4% E ARROTONDAMENTO
PPIVA2=PPTOT2/100*4
IF PPIVA2<>INT(PPIVA2)
PPIVA2=INT(PPIVA2)+1
ENDIF
*** PPIVA3 10% E ARROTONDAMENTO
PPIVA3=PPTOT3/100*10
IF PPIVA3<>INT(PPIVA3)
PPIVA3=INT(PPIVA3)+1
ENDIF
*** PPIVA4 16% E ARROTONDAMENTO
PPIVA4=PPTOT4/100*16
IF PPIVA4<>INT(PPIVA4)
PPIVA4=INT(PPIVA4)+1
ENDIF
*** PPIVA5 19%+SPESE E ARROTONDAMENTO
PPIVA5=(PPTOT5+SPESE)/100*19
IF PPIVA5<>INT(PPIVA5)
PPIVA5=INT(PPIVA5)+1
ENDIF
PPTIVA=PPIVA2+PPIVA3+PPIVA4+PPIVA5
PPTPI=PPTOT1+PPTOT2+PPTOT3+PPTOT4+PPTOT5+PPTIVA+SPESE
****************** FINE CONTEGGIO ***************************
@ 24,1 SAY "Importo LIRE"+str(pptot)+" IVA LIRE"+str(ppTiva)+" Tot. LIRE"+str(pptpi)
**************** POPUP VENDITE P2T *****************
S2B=""
DEFINE POPUP P2T FROM 17,20 TO 23,40
DEFINE BAR 1 OF P2T PROMPT " STAMPA BOLLA"
DEFINE BAR 2 OF P2T PROMPT " STAMPA FATTURA D"
DEFINE BAR 3 OF P2T PROMPT " STAMPA FATTURA A"
DEFINE BAR 4 OF P2T PROMPT " INIZIO BOLLA"
DEFINE BAR 5 OF P2T PROMPT " RITORNO MENU'"
ON SELECTION POPUP P2T DO VAIP2T
ACTIVATE POPUP P2T
IF S2B<>"I".AND.S2B<>"i"
EXIT
ENDIF
ENDDO
IF S2B="b".OR.S2B="B"
WAIT"--- PREPARARE LA STAMPANTE E PREMERE UN TASTO !! ---"

****************************************************************
* STAMPA B O L L A
****************************************************************
SET DEVICE TO PRINT
@ 0,0 SAY CHR(27)+CHR(64)
IF LEN (TRIM(LUOGO))>38
@ 10,3 SAY CHR(15)+LUOGO+CHR(18)
ELSE
@ 10,3 SAY TRIM(LUOGO)
ENDIF
IF LEN(TRIM(DEST))>38
@ 10,41 SAY CHR(15)+DEST+CHR(18)
ELSE
@ 10,41 SAY TRIM(DEST)
ENDIF
IF LEN(TRIM(CAP_CITTA))>38
@ 11,3 SAY CHR(15)+CAP_CITTA+CHR(18)
ELSE
@ 11,3 SAY TRIM(CAP_CITTA)
ENDIF
IF LEN(TRIM(LUOGO2))>38
@ 11,41 SAY CHR(15)+LUOGO2+CHR(18)
ELSE
@ 11,41 SAY TRIM(LUOGO2)
ENDIF
IF LEN(TRIM(CAP_CITTA2))>38
@ 12,41 SAY CHR(15)+CAP_CITTA2+CHR(18)
ELSE
@ 12,41 SAY TRIM(CAP_CITTA2)
ENDIF
@ 13,41 SAY "PART. IVA "+PIVA
@ 16,3 SAY RIFER
@ 16,41 SAY C_CLI
@ 16,51 SAY NUMERO_B
@ 16,66 SAY DATA_BOLLA
@ 16,76 SAY "1"
TGAA=RECNO()
********************* STAMPA ARTICOLI *****************
STORE 0 TO TARTI3,QQ,QQQ
DO WHILE TARTI3<22
TARTI3=TARTI3+1
IF TARTI3<10
NAA=STR(TARTI3,1,0)
ENDIF
IF TARTI3>9.AND.TARTI3<100
NAA=STR(TARTI3,2,0)
ENDIF
RIHH=17+TARTI3
HCAMBIA1=" CD"+NAA
HCAMBIA2=" A"+NAA
*******
********************************* FIN QUI VARIATO **********************************
UMISURA=SUBSTR(&HCAMBIA2,40,1)
IF SUBSTR(&HCAMBIA2,40,1)=" "
UMISURA="n"
endif
IF SUBSTR(&HCAMBIA2,40,1)="C"
UMISURA="cm"
ENDIF
IF SUBSTR(&HCAMBIA2,40,1)="K"
UMISURA="kg"
ENDIF
IF SUBSTR(&HCAMBIA2,40,1)="H"
UMISURA="hg"
ENDIF
IF SUBSTR(&HCAMBIA2,40,1)="G"
UMISURA="gr"
ENDIF
IF SUBSTR(&HCAMBIA2,40,1)="M"
UMISURA="m"
ENDIF

*******
HCAMBIA3=" Q"+NAA+" "
QQ=&HCAMBIA3
IF QQ<>0
@ RIHH,4 SAY &HCAMBIA1
@ RIHH,22 SAY chr(15)+SUBSTR(&HCAMBIA2,1,39)+chr(18)
@ RIHH,55 SAY UMISURA
@ RIHH,60 SAY CHR(15)+STR(QQ,7,0)
DO QUANTITA
@ RIHH,70 SAY CHR(15)+TRIM(QQQ)+CHR(18)
ENDIF
ENDDO
**** FINE STAMPA ARTICOLI **********
@ 51,3 SAY ASPETTO
@ 51,42 SAY CAUSALE
@ 53,3 SAY PORTO
@ 53,33 SAY N_COLLI
@ 53,44 SAY PESO_L
@ 53,57 SAY PESO_N
@ 53,70 SAY VOLUME
@ 55,3 SAY A_CURA_DEL
@ 55,34 SAY DAT_OR_T PICTURE "XXXXXXXXXXXXXX"
@ 57,3 SAY NOTE
@ 57,66 SAY DAT_OR_R
SET DEVICE TO SCREEN
EJECT
RETURN
ENDIF
******************************* SCELTA STAMPA FATTURA ****************
* F A T T U R A ACCOMPAGNATORIA *
* *
**********************************************************************
IF S2B="A"
WAIT"--- PREPARARE LA STAMPANTE E PREMERE UN TASTO !! ---"
QQQ=""
SET DEVICE TO PRINT
**** INTESTAZIONE *****
@ 1,2 SAY "FERRAMENTA ERRE Bi s.c.n."
@ 2,2 SAY "Via P.Amedeo,51 - Tel. 0121/35.38.79"
@ 3,2 say "FROSSASCO (TO)"
@ 4,2 SAY "P.I. 05866420010"
IF LEN (TRIM(LUOGO))>38
@ 12-2,3 SAY CHR(15)+LUOGO+CHR(18)
ELSE
@ 12-2,3 SAY TRIM(LUOGO)
ENDIF
IF LEN(TRIM(DEST))>38
@ 12-2,41 SAY CHR(15)+DEST+CHR(18)
ELSE
@ 12-2,41 SAY TRIM(DEST)
ENDIF
IF LEN(TRIM(CAP_CITTA))>38
@ 13-2,3 SAY CHR(15)+CAP_CITTA+CHR(18)
ELSE
@ 13-2,3 SAY TRIM(CAP_CITTA)
ENDIF
IF LEN(TRIM(LUOGO2))>38
@ 13-2,41 SAY CHR(15)+LUOGO2+CHR(18)
ELSE
@ 13-2,41 SAY TRIM(LUOGO2)
ENDIF
IF LEN(TRIM(CAP_CITTA2))>38
@ 14-2,41 SAY CHR(15)+CAP_CITTA2+CHR(18)
ELSE
@ 14-2,41 SAY TRIM(CAP_CITTA2)
ENDIF
************
*********** FINE INTESTAZIONE
@ 19-3, 58 SAY DATA_F
@ 19-3, 70 SAY STR(NUMERO_F,3,0)
@ 19-3, 79 SAY "1"
@ 21-3, 0 SAY C_CLI
@ 21-3, 32 SAY chr(15)+PIVA+chr(18)
@ 23-3, 2 SAY CHR(15)+COND_PA+CHR(18)
@ 23-3,55 SAY CHR(15)+BANC_A+CHR(18)
*********** FINE PRIMA DI ARTICOLI
STORE 0 TO TARTI3,QQ
DO WHILE TARTI3<22
TARTI3=TARTI3+1
IF TARTI3<10
QQ=STR(TARTI3,1,0)
ELSE
QQ=STR(TARTI3,2,0)
ENDIF
HC1=" CD"+QQ+" "
HC2=" Q"+QQ+" "
HC3=" A"+QQ+" "
HC4=" P"+QQ+" "
HC5="("+HC4+"* "+HC2+")"
HI=" I"+QQ+" "
PU=&HC4
IF &HC2>-1 .AND.&HC2<1.AND.TRIM(&HC1)<>"Riferimento"
TARTI3=23
ENDIF
IF TARTI3<>23
@ 23+TARTI3-2,1 SAY CHR(15)+&HC1+CHR(18)
@ 23+TARTI3-2,14 SAY CHR(15)+SUBSTR(&HC3,1,39)+CHR(18)
if trim(&hc1)<>"Riferimento"
UMISURA=SUBSTR(&HC3,40,1)
IF SUBSTR(&HC3,40,1)=" "
UMISURA="n"
endif
IF SUBSTR(&HC3,40,1)="C"
UMISURA="cm"
ENDIF
IF SUBSTR(&HC3,40,1)="K"
UMISURA="Kg"
ENDIF
IF SUBSTR(&HC3,40,1)="H"
UMISURA="hg"
ENDIF
IF SUBSTR(&HC3,40,1)="G"
UMISURA="gr"
ENDIF
IF SUBSTR(&HC3,40,1)="M"
UMISURA="m"
ENDIF

@ 23+TARTI3-2,34 SAY UMISURA
@ 23+TARTI3-2,36 SAY STR(&HC2,8,2)
qq=&hc2
do quantita
@ 23+tarti3-2,46 say CHR(15)+qqq+CHR(18)
***** PROCEDURA PUNTINI *****
IF PU<1000
@ 23+TARTI3-2,56 SAY PU PICTURE "9999999999"
ENDIF
IF PU>999.AND.PU<1000000
@ 23+TARTI3-2,56 SAY PU PICTURE "999999ú999"
ENDIF
IF PU>999999
@ 23+TARTI3-2,56 SAY PU PICTURE "99ú999ú999"
ENDIF
IF &HC5<1000
@ 23+TARTI3-2,65 SAY &HC5 PICTURE "9999999999"
ENDIF
IF &HC5>999.AND.&HC5<1000000
@ 23+TARTI3-2,65 SAY &HC5 PICTURE "999999ú999"
ENDIF
IF &HC5>999999
@ 23+TARTI3-2,65 SAY &HC5 PICTURE "99ú999ú999"
ENDIF
***** FINE PROCEDURA PUNTINI *****
@ 23+TARTI3-2,78 SAY &HI PICTURE "99"
ENDIF
ENDIF
ENDDO
************ FINE ARTICOLI
IF PPTOM<1000
@ 44-3,2 SAY PPTOM PICTURE "9999999999"
ENDIF
IF PPTOM>999.AND.PPTOM<1000000
@ 44-3,2 SAY PPTOM PICTURE "999999ú999"
ENDIF
IF PPTOM>999999
@ 44-3,2 SAY PPTOM PICTURE "99ú999ú999"
ENDIF
IF SPESE<1000
@ 44-3,68 SAY SPESE PICTURE "9999999999"
ENDIF
IF SPESE>999.AND.SPESE<1000000
@ 44-3,68 SAY SPESE PICTURE "999999ù999"
ENDIF
IF SPESE>999999
@ 44-3,68 SAY SPESE PICTURE "99ù999ù999"
ENDIF


@ 46-2,0 SAY " 4"
******* PROCEDURA PUNTINI ******
IF PPTOT2<1000
@ 46-2,5 SAY PPTOT2 PICTURE "9999999999"
ENDIF
IF PPTOT2>999.AND.PPTOT2<1000000
@ 46-2,5 SAY PPTOT2 PICTURE "999999ù999"
ENDIF
IF PPTOT2>999999
@ 46-2,5 SAY PPTOT2 PICTURE "99ù999ù999"
ENDIF
@ 46-2,16 SAY " 4"
IF PPIVA2<1000
@ 46-2,19 SAY PPIVA2 PICTURE "9999999999"
ENDIF
IF PPIVA2>999.AND.PPIVA2<1000000
@ 46-2,19 SAY PPIVA2 PICTURE "999999ù999"
ENDIF
IF PPIVA2>999999
@ 46-2,19 SAY PPIVA2 PICTURE "99ù999ù999"
ENDIF
*****
@ 47-2,0 SAY "10"
******* PROCEDURA PUNTINI ******
IF PPTOT3<1000
@ 47-2,5 SAY PPTOT3 PICTURE "9999999999"
ENDIF
IF PPTOT3>999.AND.PPTOT3<1000000
@ 47-2,5 SAY PPTOT3 PICTURE "999999ù999"
ENDIF
IF PPTOT3>999999
@ 47-2,5 SAY PPTOT3 PICTURE "99ù999ù999"
ENDIF
@ 47-2,16 SAY "10"
IF PPIVA3<1000
@ 47-2,19 SAY PPIVA3 PICTURE "9999999999"
ENDIF
IF PPIVA3>999.AND.PPIVA3<1000000
@ 47-2,19 SAY PPIVA3 PICTURE "999999ù999"
ENDIF
IF PPIVA3>999999
@ 47-2,19 SAY PPIVA3 PICTURE "99ù999ù999"
ENDIF
*****
@ 48-2,0 SAY "16"
******* PROCEDURA PUNTINI ******
IF PPTOT4<1000
@ 48-2,5 SAY PPTOT4 PICTURE "9999999999"
ENDIF
IF PPTOT4>999.AND.PPTOT4<1000000
@ 48-2,5 SAY PPTOT4 PICTURE "999999ù999"
ENDIF
IF PPTOT4>999999
@ 48-2,5 SAY PPTOT4 PICTURE "99ù999ù999"
ENDIF
@ 48-2,16 SAY "16"
IF PPIVA4<1000
@ 48-2,19 SAY PPIVA4 PICTURE "9999999999"
ENDIF
IF PPIVA4>999.AND.PPIVA4<1000000
@ 48-2,19 SAY PPIVA4 PICTURE "999999ù999"
ENDIF
IF PPIVA4>999999
@ 48-2,19 SAY PPIVA4 PICTURE "99ù999ù999"
ENDIF
*****
PPTOT6=PPTOT5+SPESE
@ 49-2,0 SAY "19"
IF PPTOT6<1000
@ 49-2,5 SAY PPTOT6 PICTURE "9999999999"
ENDIF
IF PPTOT6>999.AND.PPTOT6<1000000
@ 49-2,5 SAY PPTOT6 PICTURE "999999ù999"
ENDIF
IF PPTOT6>999999
@ 49-2,5 SAY PPTOT6 PICTURE "99ù999ù999"
ENDIF
@ 49-2,16 SAY "19"
IF PPIVA5<1000
@ 49-2,19 SAY PPIVA5 PICTURE "9999999999"
ENDIF
IF PPIVA5>999.AND.PPIVA5<1000000
@ 49-2,19 SAY PPIVA5 PICTURE "999999ù999"
ENDIF
IF PPIVA5>999999
@ 49-2,19 SAY PPIVA5 PICTURE "99ù999ù999"
ENDIF
***** fine % iva
IF PPTOT<1000
@ 54-3,5 SAY PPTOT PICTURE "9999999999"
ENDIF
IF PPTOT>999.AND.PPTOT<1000000
@ 54-3,5 SAY PPTOT PICTURE "999999ù999"
ENDIF
IF PPTOT>999999
@ 54-3,5 SAY PPTOT PICTURE "99ù999ù999"
ENDIF

IF PPTIVA<1000
@ 54-3,18 SAY PPTIVA PICTURE "9999999999"
ENDIF
IF PPTIVA>999.AND.PPTIVA<1000000
@ 54-3,18 SAY PPTIVA PICTURE "9999999ù999"
ENDIF
IF PPTIVA>999999
@ 54-3,18 SAY PPTIVA PICTURE "99ù999ù999"
ENDIF
IF PPTPI<1000
@ 54-3,68 SAY PPTPI PICTURE "9999999999"
ENDIF
IF PPTPI>999.AND.PPTPI<1000000
@ 54-3,68 SAY PPTPI PICTURE "999999ù999"
ENDIF
IF PPTPI>999999
@ 54-3,68 SAY PPTPI PICTURE "99ù999ù999"
ENDIF
***** DATI ACCOMPA
IF A_CURA_DEL ="M".OR.A_CURA_DEL="m"
@ 57-3,3 SAY "X"
ENDIF
IF A_CURA_DEL ="d".OR.A_CURA_DEL="D"
@ 57-3,11 SAY "X"
ENDIF
IF A_CURA_DEL ="V".OR.A_CURA_DEL="v"
@ 57-3,19 SAY "X"
ENDIF
@ 57-3,30 SAY CHR(15)+ASPETTO +CHR(18)
@ 57-3,47 SAY N_COLLI
@ 57-3,56 SAY PESO_L
**** FINE ACCOMPA
@ 61-3, 2 SAY NOTE
@ 61-3,36 SAY DAT_OR_T
IF PPTPI<1000
@ 61-3,68 SAY PPTPI PICTURE "9999999999"
ENDIF
IF PPTPI>999.AND.PPTPI<1000000
@ 61-3,68 SAY PPTPI PICTURE "999999ù999"
ENDIF
IF PPTPI>999999
@ 61-3,68 SAY PPTPI PICTURE "99ù999ù999"
ENDIF

SET DEVICE TO SCREEN
eject
ENDIF
************************** FINE SCELTA STAMPA ACCOMPAGNATORIA*****************
******************************* SCELTA STAMPA FATTURA ****************
* F A T T U R A DIFFERITA *
* *
**********************************************************************
IF S2B="F".OR.S2B="f"
WAIT"--- PREPARARE LA STAMPANTE E PREMERE UN TASTO !! ---"
QQQ=""
SET DEVICE TO PRINT
**** INTESTAZIONE *****
IF LEN(TRIM(DEST))>33
@ 2,46 SAY CHR(15)+DEST+CHR(18)
ELSE
@ 2,46 SAY TRIM(DEST)
ENDIF
IF LEN(TRIM(LUOGO))>38
@ 3,46 SAY CHR(15)+LUOGO+CHR(18)
ELSE
@ 3,46 SAY TRIM(LUOGO)
ENDIF
IF LEN(TRIM(CAP_CITTA))>38
@ 4,46 SAY CHR(15)+CAP_CITTA+CHR(18)
ELSE
@ 4,46 SAY TRIM(CAP_CITTA)
ENDIF
*********** FINE INTESTAZIONE
@ 11, 63 SAY STR(NUMERO_F,3,0)
@ 11, 70 SAY DATA_F
@ 11, 79 SAY "1"
@ 13, 2 SAY CHR(15)+BANC_A+CHR(18)
@ 13, 50 say "FATTURA"
@ 13, 63 SAY PIVA
@ 14, 2 SAY CHR(15)+COND_PA+CHR(18)
@ 14, 63 SAY C_CLI
*********** FINE PRIMA DI ARTICOLI
STORE 0 TO TARTI3,QQ
DO WHILE TARTI3<22
TARTI3=TARTI3+1
IF TARTI3<10
QQ=STR(TARTI3,1,0)
ELSE
QQ=STR(TARTI3,2,0)
ENDIF
HC1=" CD"+QQ+" "
HC2=" Q"+QQ+" "
HC3=" A"+QQ+" "
HC4=" P"+QQ+" "
HC5="("+HC4+"* "+HC2+")"
HI=" I"+QQ+" "
PU=&HC4
IF &HC2>-1 .AND.&HC2<1.AND.TRIM(&HC1)<>"Riferimento"
TARTI3=23
ENDIF
IF TARTI3<>23
@ 16+TARTI3,1 SAY CHR(15)+&HC1+CHR(18)
@ 16+TARTI3,10 SAY CHR(15)+SUBSTR(&HC3,1,39)+CHR(18)
if trim(&hc1)<>"Riferimento"
UMISURA=SUBSTR(&HC3,40,1)
IF SUBSTR(&HC3,40,1)=" "
UMISURA="n"
endif
IF SUBSTR(&HC3,40,1)="C"
UMISURA="cm"
ENDIF
IF SUBSTR(&HC3,40,1)="K"
UMISURA="Kg"
ENDIF
IF SUBSTR(&HC3,40,1)="H"
UMISURA="hg"
ENDIF
IF SUBSTR(&HC3,40,1)="G"
UMISURA="gr"
ENDIF
IF SUBSTR(&HC3,40,1)="M"
UMISURA="m"
ENDIF

@ 16+TARTI3,34 SAY UMISURA
@ 16+TARTI3,40 SAY STR(&HC2,8,2)

***** PROCEDURA PUNTINI *****
IF PU<1000
@ 16+TARTI3,47 SAY PU PICTURE "9999999999"
ENDIF
IF PU>999.AND.PU<1000000
@ 16+TARTI3,47 SAY PU PICTURE "999999ú999"
ENDIF
IF PU>999999
@ 16+TARTI3,47 SAY PU PICTURE "99ú999ú999"
ENDIF
IF &HC5<1000
@ 16+TARTI3,65 SAY &HC5 PICTURE "9999999999"
ENDIF
IF &HC5>999.AND.&HC5<1000000
@ 16+TARTI3,65 SAY &HC5 PICTURE "999999ú999"
ENDIF
IF &HC5>999999
@ 16+TARTI3,65 SAY &HC5 PICTURE "99ú999ú999"
ENDIF
***** FINE PROCEDURA PUNTINI *****
@ 16+TARTI3,78 SAY &HI PICTURE "99"
ENDIF
ENDIF
ENDDO
************ FINE ARTICOLI
IF PPTOM<1000
@ 46,2 SAY PPTOM PICTURE "9999999999"
ENDIF
IF PPTOM>999.AND.PPTOM<1000000
@ 46,2 SAY PPTOM PICTURE "999999ú999"
ENDIF
IF PPTOM>999999
@ 46,2 SAY PPTOM PICTURE "99ú999ú999"
ENDIF
IF SPESE<1000
@ 46,68 SAY SPESE PICTURE "9999999999"
ENDIF
IF SPESE>999.AND.SPESE<1000000
@ 46,68 SAY SPESE PICTURE "999999ù999"
ENDIF
IF SPESE>999999
@ 46,68 SAY SPESE PICTURE "99ù999ù999"
ENDIF


@ 48,1 SAY " 4"
******* PROCEDURA PUNTINI ******
IF PPTOT2<1000
@ 48,5 SAY PPTOT2 PICTURE "9999999999"
ENDIF
IF PPTOT2>999.AND.PPTOT2<1000000
@ 48,5 SAY PPTOT2 PICTURE "999999ù999"
ENDIF
IF PPTOT2>999999
@ 48,5 SAY PPTOT2 PICTURE "99ù999ù999"
ENDIF
@ 48,17 SAY " 4"
IF PPIVA2<1000
@ 48,19 SAY PPIVA2 PICTURE "9999999999"
ENDIF
IF PPIVA2>999.AND.PPIVA2<1000000
@ 48,19 SAY PPIVA2 PICTURE "999999ù999"
ENDIF
IF PPIVA2>999999
@ 48,19 SAY PPIVA2 PICTURE "99ù999ù999"
ENDIF
*****
@ 49,1 SAY "10"
******* PROCEDURA PUNTINI ******
IF PPTOT3<1000
@ 49,5 SAY PPTOT3 PICTURE "9999999999"
ENDIF
IF PPTOT3>999.AND.PPTOT3<1000000
@ 49,5 SAY PPTOT3 PICTURE "999999ù999"
ENDIF
IF PPTOT3>999999
@ 49,5 SAY PPTOT3 PICTURE "99ù999ù999"
ENDIF
@ 49,17 SAY "10"
IF PPIVA3<1000
@ 49,19 SAY PPIVA3 PICTURE "9999999999"
ENDIF
IF PPIVA3>999.AND.PPIVA3<1000000
@ 49,19 SAY PPIVA3 PICTURE "999999ù999"
ENDIF
IF PPIVA3>999999
@ 49,19 SAY PPIVA3 PICTURE "99ù999ù999"
ENDIF
*****
@ 50,1 SAY "16"
******* PROCEDURA PUNTINI ******
IF PPTOT4<1000
@ 50,5 SAY PPTOT4 PICTURE "9999999999"
ENDIF
IF PPTOT4>999.AND.PPTOT4<1000000
@ 50,5 SAY PPTOT4 PICTURE "999999ù999"
ENDIF
IF PPTOT4>999999
@ 50,5 SAY PPTOT4 PICTURE "99ù999ù999"
ENDIF
@ 50,17 SAY "16"
IF PPIVA4<1000
@ 50,19 SAY PPIVA4 PICTURE "9999999999"
ENDIF
IF PPIVA4>999.AND.PPIVA4<1000000
@ 50,19 SAY PPIVA4 PICTURE "999999ù999"
ENDIF
IF PPIVA4>999999
@ 50,19 SAY PPIVA4 PICTURE "99ù999ù999"
ENDIF
*****
PPTOT6=PPTOT5+SPESE
@ 51,1 SAY "19"
IF PPTOT6<1000
@ 51,5 SAY PPTOT6 PICTURE "9999999999"
ENDIF
IF PPTOT6>999.AND.PPTOT6<1000000
@ 51,5 SAY PPTOT6 PICTURE "999999ù999"
ENDIF
IF PPTOT6>999999
@ 51,5 SAY PPTOT6 PICTURE "99ù999ù999"
ENDIF
@ 51,17 SAY "19"
IF PPIVA5<1000
@ 51,19 SAY PPIVA5 PICTURE "9999999999"
ENDIF
IF PPIVA5>999.AND.PPIVA5<1000000
@ 51,19 SAY PPIVA5 PICTURE "999999ù999"
ENDIF
IF PPIVA5>999999
@ 51,19 SAY PPIVA5 PICTURE "99ù999ù999"
ENDIF
***** fine % iva
IF PPTOT<1000
@ 56,5 SAY PPTOT PICTURE "9999999999"
ENDIF
IF PPTOT>999.AND.PPTOT<1000000
@ 56,5 SAY PPTOT PICTURE "999999ù999"
ENDIF
IF PPTOT>999999
@ 56,5 SAY PPTOT PICTURE "99ù999ù999"
ENDIF

IF PPTIVA<1000
@ 56,18 SAY PPTIVA PICTURE "9999999999"
ENDIF
IF PPTIVA>999.AND.PPTIVA<1000000
@ 56,18 SAY PPTIVA PICTURE "9999999ù999"
ENDIF
IF PPTIVA>999999
@ 56,18 SAY PPTIVA PICTURE "99ù999ù999"
ENDIF
***** DATI ACCOMPA
*IF A_CURA_DEL ="M".OR.A_CURA_DEL="m"
*@ 57,3 SAY "X"
*ENDIF
*IF A_CURA_DEL ="d".OR.A_CURA_DEL="D"
*@ 57,11 SAY "X"
*ENDIF
*IF A_CURA_DEL ="V".OR.A_CURA_DEL="v"
*@ 57,19 SAY "X"
*ENDIF
* @ 57,30 SAY ASPETTO
* @ 57,47 SAY N_COLLI
* @ 57,56 SAY PESO_L
* @ 61, 2 SAY NOTE
* @ 61,38 SAY DAT_OR_T
**** FINE ACCOMPA
IF PPTPI<1000
@ 56,68 SAY PPTPI PICTURE "9999999999"
ENDIF
IF PPTPI>999.AND.PPTPI<1000000
@ 56,68 SAY PPTPI PICTURE "999999ù999"
ENDIF
IF PPTPI>999999
@ 56,68 SAY PPTPI PICTURE "99ù999ù999"
ENDIF
IF PPTPI<1000
@ 59,68 SAY PPTPI PICTURE "9999999999"
ENDIF
IF PPTPI>999.AND.PPTPI<1000000
@ 59,68 SAY PPTPI PICTURE "999999ù999"
ENDIF
IF PPTPI>999999
@ 59,68 SAY PPTPI PICTURE "99ù999ù999"
ENDIF
SET DEVICE TO SCREEN
eject
ENDIF
************************** FINE SCELTA STAMPA FATTURA ********************
IF S2B="M".OR.S2B="m"
RETURN
ENDIF
*************************** FINE BOLLE ****************************
**********************************
* PROCEDURE QUANTITA *
**********************************
PROCEDURE QUANTITA
IF QQ>0
CY0=0
QQ0=STR(QQ,8,2)
QQQ=""
DO WHILE CY0<8
CY0=CY0+1
LY0=SUBSTR(QQ0,CY0,1)
IF LY0=" "
QQQ=QQQ+" "
ENDIF
IF LY0=","
QQQ=QQQ+","
ENDIF
IF LY0="1"
QQQ=QQQ+"A"
ENDIF
IF LY0="2"
QQQ=QQQ+"E"
ENDIF
IF LY0="3"
QQQ=QQQ+"G"
ENDIF
IF LY0="4"
QQQ=QQQ+"H"
ENDIF
IF LY0="5"
QQQ=QQQ+"M"
ENDIF
IF LY0="6"
QQQ=QQQ+"P"
ENDIF
IF LY0="7"
QQQ=QQQ+"S"
ENDIF
IF LY0="8"
QQQ=QQQ+"T"
ENDIF
IF LY0="9"
QQQ=QQQ+"K"
ENDIF
IF LY0="0"
QQQ=QQQ+"Z"
ENDIF
ENDDO
RETURN
ENDIF
IF QQ=0
QQQ=0
ENDIF
RETURN
************************************************************************
***********************************************************************
PROCEDURE FATBOL2
***************** PROCEDURA CREA FATTURA ******************************
USE BOLLE
COUNT ALL FOR TRIM(TIPO)="F" TO TXF
COUNT ALL FOR C_CLI=COCLIBOL.AND.TRIM(TIPO)="B" TO TY
if ty=0
? "NON CI SONO BOLLE DA RAGGRUPPARE !!"
GHZ=1
return
endif
TYB=0
UL=1
DO WHILE TYB<TY
USE BOLLE
TYB=TYB+1
GOTO RECORD UL

DO WHILE C_CLI<>COCLIBOL.OR.TRIM(TIPO)<>"B"
SKIP+1
ENDDO
UL=RECNO()+1
TYT=0
IF TYB=1
COCLIE=C_CLI
SP=DEST
ID=LUOGO2
CI=CAP_CITTA2
PI=PIVA
ENDIF
REPLACE TIPO WITH "E"
********** RIFERIMENTI ***********
NBX=STR(NUMERO_B)
DBXX="Bolla nø"+nbx+" del "+DTOC(DATA_BOLLA)
USE FATTURA
APPEND BLANK
REPLACE CF WITH "Riferimento",AF WITH DBXX,PF WITH VAL(NBX)
*********** FINE RIFERIMENTI ***********
DO WHILE TYT<22
USE BOLLE
GOTO RECORD UL-1
TYT=TYT+1
IF TYT<10
NY=STR(TYT,1,0)
ELSE
NY=STR(TYT,2,0)
ENDIF
CDC=" CD"+NY+" "
IF &CDC<>SPACE(15)
AC=" A"+NY+" "
QC=" Q"+NY+" "
PC=" P"+NY+" "
IC=" I"+NY+" "
CCDC=&CDC
AAC=&AC
QQC=&QC
PPC=&PC
IIC=&IC
USE FATTURA
APPEND BLANK
REPLACE CF WITH CCDC,AF WITH AAC,QF WITH QQC,PF WITH PPC,IFA WITH IIC
ELSE
TYT=22
ENDIF
ENDDO
ENDDO
USE FATTURA
COUNT ALL TO NAC
********************* CONTROLLO SE ARTICOLI >22 ********************
GHZ=1
IF NAC>22
USE FATTURA
GO BOTTOM
FINEA1=RECNO()
FINEA2=FINEA1
GHZ=1
DO WHILE GHZ=1
USE FATTURA
GOTO RECORD FINEA1
IF TRIM(CF)="Riferimento"
VAIC=PF
USE BOLLE
LOCATE FOR NUMERO_B=VAIC
REPLACE TIPO WITH "B"
IF FINEA1<24
GHZ=0
ENDIF
ENDIF
FINEA1=FINEA1-1
ENDDO
USE FATTURA
GOTO RECORD FINEA1+1
DELETE NEXT FINEA2-FINEA1
PACK
COUNT ALL TO NAC
ENDIF
********************************************************************
USE BOLLE
APPEND BLANK
REPLACE DEST WITH SP,LUOGO WITH ID,CAP_CITTA WITH CI,PIVA WITH PI,C_CLI WITH COCLIE,DATA_BOLLA WITH DATE()
ORDATA=DTOC(DATE())+"-"+TIME()
REPLACE DAT_OR_T WITH ORDATA,CAP_CITTA2 WITH CI,LUOGO2 WITH ID,TIPO WITH "F",NUMERO_F WITH TXF+1,DATA_F WITH DATE()
TYT=0
DO WHILE TYT<22
TYT=TYT+1
IF TYT<10
NY=STR(TYT,1,0)
ELSE
NY=STR(TYT,2,0)
ENDIF
CDC=" CD"+NY+" "
AC=" A"+NY+" "
QC=" Q"+NY+" "
PC=" P"+NY+" "
IIC=" I"+NY+" "
IF TYT<NAC+1
USE FATTURA
GOTO RECORD TYT
CF2=CF
AF2=AF
QF2=QF
PF2=PF
IF2=IFA
USE BOLLE
GO BOTTOM
REPLACE &CDC WITH CF2,&AC WITH AF2,&QC WITH QF2,&PC WITH PF2,&IIC WITH IF2
ELSE
TYT=22
ENDIF
ENDDO
USE FATTURA
DELETE ALL
PACK
RETURN
********** PROCEDURA POPUP VENDITE P2 *********************
PROCEDURE VAIP2
DO CASE
CASE BAR()=2
VEN="û"
DEACTIVATE POPUP
CASE BAR()=3
VEN="ú"
DEACTIVATE POPUP
CASE BAR()=1
VEN="ü"
DEACTIVATE POPUP
CASE BAR()=4
*** SCONTO SU SINGOLO ARTICOLO ***
SET FORMAT TO
@ 18,15 say "Sconto da praticare in % FAR PRECEDERE DAL SEGNO - " GET STO PICTURE "999999"
READ
MEM_STO=0
IF STO>0
MEM_STO=STO
P_S_C=ROUND(100*STO/MEMO_P,0)
STO=-1*P_S_C
ENDIF
**** FINE SCONTO SU ARTICOLO SINGOLO ****
CASE BAR()=5
SET FORMAT TO
@ 19,15 SAY "Quantit… " GET QUA PICTURE "99999.99"
READ
CASE BAR()=6
SET FORMAT TO
@ 20,15 SAY PREZZO_A PICTURE "999,999,999"
CASE BAR()=7
VEN="A"
DEACTIVATE POPUP
ENDCASE
RETURN
****************** PROCEDURA POPUP VENDITE VAIP2B
PROCEDURE VAIP2B
DO CASE
CASE BAR()=1
RI=CHR(13)
DEACTIVATE POPUP
CASE BAR()=2
RI="A"
DEACTIVATE POPUP
CASE BAR()=3
RI="S"
DEACTIVATE POPUP
CASE BAR()=4
RI="V"
DEACTIVATE POPUP
CASE BAR()=5
RI="F"
DEACTIVATE POPUP
ENDCASE
RETURN
******************** PROCEDURE VAIP2T POPUP P2T ******************
PROCEDURE VAIP2T
DO CASE
CASE BAR()=1
S2B="B"
DEACTIVATE POPUP
CASE BAR()=2
S2B="F"
DEACTIVATE POPUP
CASE BAR()=3
S2B="A"
DEACTIVATE POPUP
CASE BAR()=4
S2B="I"
DEACTIVATE POPUP
CASE BAR()=5
S2B="M"
DEACTIVATE POPUP
ENDCASE
RETURN
************************* PROCEDURE TASTI F5 F6 F7
PROCEDURE KCINQUE
VEN="ü"
ON KEY
DEACTIVATE POPUP
RETURN
PROCEDURE KSEI
VEN="û"
ON KEY
DEACTIVATE POPUP
return
PROCEDURE KSETTE
VEN="ú"
ON KEY
DEACTIVATE POPUP
RETURN
****************************************************************************
*************** PROCEDURA VAIP8 ******
PROCEDURE VAIP8
NOMPA=PROMPT()
DEACTIVATE POPUP
RETURN