'
5 'g03b gestab
'INCLUDE contain a list of standard DECLARE
'$INCLUDE: 'qb4\incl\routB.bas'
'$INCLUDE: 'qb4\incl\routIX.bas'
'$INCLUDE: 'qb4\incl\writext.bas'
DECLARE SUB buildset (ow%, mm%, delanom%)
DECLARE FUNCTION amg$ (x$)
esc$ = CHR$(27)
gras$ = esc$ + "E": ngras$ = esc$ + "F": comp$ = CHR$(15): ncom$ = CHR$(18)
ON ERROR GOTO 25100
qx$(0) = "001": maxr% = 72: tcl% = 2: tms% = 4: sms% = 7
proc$ = "sa": iniproc proc$
tit$ = "Articles & Suppliers"
250 GOSUB opn
DIM mff$(5), ff$(7), msk$(3), psel(2), tt$(24), r$(50), kalt(100), dnrf(2)
DATA"Articles","Supplier","Prices": FOR i% = 1 TO 3: READ msk$(i%): NEXT
DATA"Articles","Suppliers"
DATA"Article Prices","Supplier Prices","Rebuild Chain"
FOR i% = 1 TO 5: READ mff$(i%): NEXT
DATA "Insert","Change","View","Print","Rebuild Index"
DATA "Delete": FOR i% = 1 TO 6: READ ff$(i%): NEXT
sm$ = "Software Madurini / DEMO - Managing "
900 x$ = sm$ + tit$
swfld% = 1: menu x$, mff$(), 5, 2, "", fzm%, cf%
IF cf% < 4 THEN GOSUB clo: END
swalf% = 0: IF fzm% < 3 THEN df1% = fzm%: GOTO 1000
IF fzm% = 5 THEN 6000
fo% = fzm% - 2: GOTO 5000
opn: openfl 1: openfl 2: openfl 3: IF dberr% > 0 THEN 40100
openix 1: openix 2: RETURN
clo: closix 1: closix 2: closfl 0: RETURN
1000 f1% = df1%: tr% = f1%: dtr% = tr%: tm% = tr%: dtm% = tr%
swhlp% = 0: GOSUB 38000
x$ = sm$ + nametrk$(tr%, 2) + "\" + STR$(nrec(f1%)) + "\" + STR$(ndel(f1%))
swfld% = 1: menu x$, ff$(), 6, 2, "", fz%, cf%: IF cf% < 4 THEN 900
swfld% = 2: t0$ = ff$(fz%) + " " + nametrk$(tr%, 1)
swalf% = 0: ON fz% GOTO 2000, 3000, 4000, 4000, 8910, 3000
2000 IF nrec(f1%) >= dnrf(f1%) THEN dnrf(f1%) = nrec(f1%) ELSE STOP
inibuf tr%: oldk$ = "": swshw% = 0
tx$ = t0$ + " ": w.invr = 1: GOTO 3050
2010 IF cf% < 4 THEN 1000 ELSE 2000
3000 CLS : rg% = 1: cl% = 10: f1% = df1%
x$ = t0$ + " n.": in$ = "": w.invr = 2: ff% = df1%
GOSUB 20050: IF cf% < 4 THEN 1000
swshw% = 1: k$ = curkey$(df1%): oldk$ = k$
3050 IF swshw% = 0 THEN swshw% = 1: GOSUB 18200: GOSUB 35000
3090 IF fz% = 6 THEN 3500
3100 p$ = "": GOSUB 15400: IF cf% = 1 THEN 3260
IF ok% = 0 THEN 1000
updarc fz%, f1%, oldk$, 0
IF dberr% > 0 THEN 1000
3250 GOSUB 18600
3260 IF fz% = 1 THEN 2010
GOTO 3000
3500 GOSUB 20190: IF x% = 0 THEN 3000
nextmm f1%, 3, 0
IF dberr% = 0 THEN x$ = msg$("Delete its prices first"): GOTO 1000
delix f1%: IF dberr% = 20 THEN 8900
IF dberr% > 0 THEN x$ = msg$("Operation NOT executed"): GOTO 1000
GOTO 3000
4000 f1% = df1%: tr% = dtr%: w.vs = fz% - 2: vs% = w.vs
titolo ff$(fz%)
4002 bounds df1%, 5, swkey%, k1$, k2$, psel(), nmax%, nk%, cf%: IF cf% < 4 THEN 1000
4030 x$ = nametrk$(dtr%, 2): l% = LEN(x$): l1% = LEN(k1$): l2% = LEN(k2$): tt% = l% + l1% + l2% + 25
k01$ = k1$: k02$ = k2$: lm% = 84 - w.vs * 5
IF tt% > lm% THEN
d% = tt% - lm%: d2% = l2% - d%
IF d2% > 2 THEN
k02$ = LEFT$(k2$, d2%)
ELSE
k02$ = LEFT$(k2$, 2)
d% = tt% - l2% + 2 - lm%: d1% = l1% - d%
IF d1% > 1 THEN k01$ = LEFT$(k1$, d1%) ELSE STOP'caso molto improbabile
END IF
END IF
tst$ = "List " + x$ + " from " + k01$ + " to " + k02$
tm% = dtm% + 10: GOSUB 38000
4040 w.vs = vs%
w.nr = 99: w.np = 0: ww$ = "": recpos% = 0: ntrov% = nk%: selez% = 0
4100 multiread df1%, swkey%, psel(), recpos%, ntrov%: IF recpos% = 9 THEN 4210
GOSUB 22050: IF ww$ <> "*" THEN 4100
4210 msn$ = "Read" + STR$(ntrov%) + " positions"
w.swtop = 0: w.swend = 1: GOSUB 22901: IF ww$ = "c" THEN 4000
GOTO 1000
5000 titolo mff$(fzm%)
rg% = 5: cl% = 10: ff% = fo%: tm% = fo%: GOSUB 38000
x$ = nametrk$(fo%, 1) + " n.": nm$ = x$: in$ = "": w.invr = 2: df1% = 3
t0$ = mff$(fzm%): GOSUB 20050: IF cf% < 4 THEN 900
innum1 15, 10, "1.Update, 2.View List, 3.Print List", 1, 3, "2", x%, cf%
IF cf% < 4 THEN 5000
IF x% = 1 THEN GOSUB 10000: GOTO 5000
curtm% = 0: w.vs = x% - 1
tst$ = "Prices " + nametrk$(fo%, 1) + " " + getfld$(fo%, 1) + " " + getfld$(fo%, 2)
tt$(1) = "Code N a m e" + SPACE$(30) + "Price Starting Date"
w.nrs = 1: w.nx = 1: w.nr = 99: w.np = 0: w.noqx = 1
strt% = 0: falt% = 3 - fo%
5100 nextmm fo%, 3, strt%: IF dberr% > 0 THEN 5200
ownmm falt%, 3: x$ = getfld$(falt%, 1) + SPACE$(falt%) + getfld$(falt%, 2)
FOR j% = 5 TO 1 STEP -1: prz# = VAL(getfldj$(3, 1, j%))
IF prz# > 0 THEN EXIT FOR
NEXT: dec$ = getfldj$(3, 2, j%)
r$(1) = x$ + ednum$(prz#, 15) + " " + dec$
GOSUB 22901: IF ww$ <> "*" THEN 5100
5200 msn$ = "": w.swtop = 0: w.swend = 1: GOSUB 22901: IF ww$ = "c" THEN 5000
GOTO 900
6000 titolo mff$(5) + " - start " + TIME$: GOSUB clo
buildset 1, 3, 0: buildset 2, 3, 0
buildset 0, 0, 0: GOSUB opn: GOTO 900
8900 BEEP: IF msg$("You MUST reorder the file") = "*" THEN 1000
8910 closix f1%: creind proc$, f1%
openix f1%: GOTO 1000
10000 rets% = 0
IF fo% = 1 THEN x$ = "ns" ELSE x$ = "sn"
p$ = "@" + x$ + "\"
10100 fm% = 3: mf$ = "o": tm% = 3: dtr% = 3: df1% = 3
updset fo%, fm%, mf$, rets%, cf%: IF rets% = 9 THEN RETURN
ON rets% GOTO 10110, 10120, 10130, 10140
10110 f1% = fm%: GOSUB 18200: invr% = 2: GOSUB 35000: GOTO 10100
10120 w.invr = 2: GOTO 10132
10130 w.invr = 1: GOSUB 18000: invr% = 1: GOSUB 35000
10132 GOSUB 15400: IF ok% = 0 OR cf% < 4 OR cf% = 6 AND w.invr = 1 THEN RETURN ELSE 10100
10140 GOSUB 18500: GOTO 10100
15400 ret% = 0: IF p$ = "" THEN p$ = "00"
w.swcic = 1: w.swcf6 = 0
15418 mskgen 4, p$, r$(), w, 0, ret%, in$, tr%, i%, j%: IF ret% < 10 THEN 16100
cf% = ret% - 10: IF cf% = 1 THEN ok% = 0: RETURN
GOSUB 17100: IF ok% = 1 OR sw$ = "*" THEN RETURN ELSE 15400
15428 ret% = 2: GOTO 15418
16000 x$ = "sn"
16001 ok% = 1: x% = INSTR(x$, in$): IF x% > 0 THEN 16002
ok% = 0
IF swhlp% = 1 THEN LOCATE 24, 1: PRINT h1$; : LOCATE 25, 1: PRINT h2$; : MID$(p$, 2, 1) = "1"
16002 swhlp% = 0: IF swret% = 1 THEN swret% = 0: RETURN
IF ok% = 0 THEN 15418 ELSE 15428
16100 IF df1% < 3 THEN 15428
IF tr% > 2 THEN 15428
x$ = RTRIM$(in$)
minkix tr%, x$: IF dberr% > 0 THEN 15418
cod$ = getfld$(tr%, 1):
x$ = getfld$(tr%, 2): mskputfld x$, 2, tr%: GOTO 15428
'final controls for various TRK
17100 ok% = 1: IF df1% < 3 THEN RETURN
IF VAL(getfld$(3, 1)) = 0 THEN x$ = "Missing data": GOTO 17900
max$ = "": FOR j% = 1 TO 5: x$ = RTRIM$(getfldj$(3, 2, j%))
IF x$ <> "" THEN x$ = amg$(x$): IF x$ > max$ THEN max$ = x$ ELSE x$ = "Reorder starting dates!": GOTO 17900
NEXT
'use to replace code in case it has been typed shorter
x% = 3 - fo%: mskputfld cod$, 1, x%: putfld x%, 1, cod$: RETURN
17900 ok% = 0: BEEP: sw$ = msg$(x$): RETURN
'integrate data after inibuf
18000 IF w.invr = 1 THEN x% = 3 - fo%: inibuf x%
RETURN
'integrate data before showing input form
18200 IF df1% = 3 THEN x% = 3 - fo%: ownmm x%, 3: oldow = currec(x%)
RETURN
'any connect not executed by updset
18500 IF fm% <> 3 THEN RETURN
x% = 3 - fo%: IF invr% = 1 THEN connmm x%, 3, 1, 0: RETURN
k = currec(x%)
IF k <> oldow THEN
rdnrec x%, oldow: discmm x%, 3
rdnrec x%, k: connmm x%, 3, 1, 0
END IF: RETURN
'complete update
18600 RETURN
20050 IF swalf% <> 0 THEN 20052
swkey% = 0
findpos rg%, cl%, ff%, x$, in$, swkey%, swalf%, dlk%, cf%: IF dberr% > 0 THEN 40100
IF cf% < 4 THEN RETURN
20052 k = currec(ff%): tx$ = t0$ + STR$(k)
GOSUB 18200: GOSUB 35000
SELECT CASE swalf%
CASE 0
sw% = 3
CASE 1
nexprix ff%, dlk%, sw%
END SELECT: ON sw% GOTO 20054, 20052, 20056
20054 swalf% = 0: cf% = 1
20056 RETURN
20190 insn 25, 50, "Confirm DELETION", "n", x$, x%, cf%: pulrig 25, 25: RETURN
22050 x% = f1%: ret% = 0: vs$ = ""
22060 textgen x%, w, ret%, vs$, r$()
IF ret% = 1 THEN GOSUB 37400: x% = sws%: ret% = 2: GOTO 22060
22901 w.rfog = maxr%: w.rutl = maxr% - 6
ww$ = writext$(r$(), tt$(), tst$, sel$, msn$, w): RETURN
25100 IF ERR = 24 OR ERR = 25 OR ERR = 27 THEN IF msg$("Turn on printer, please...") = "*" THEN RESUME 900 ELSE RESUME
IF ERR = 70 THEN RESUME
25110 PRINT "Error "; ERR; " at line "; ERL: STOP
35000 GOSUB 38000: ret% = 0: x$ = tx$
35010 mskshow x$, w, ret%: IF ret% = 9 THEN RETURN
GOSUB 37400: x$ = vs$: ret% = 2: GOTO 35010
37400 IF w.tb = 1 THEN vs$ = tx$ + SPACE$(60): RETURN
STOP
37900 msk2def "sa", msk$(tm%): GOTO 38810
38000 IF tm% = curtm% THEN RETURN ELSE curtm% = tm%
IF tm% < 10 THEN 37900
ON tm% - 10 GOTO 38110, 38120: STOP
'load: swcls%,sp%,swdop%,swcmp%,nrs%,ric$,rt%,rd%,nds%,tr%,i%,lus%,...
38110 RESTORE 38110: DATA 1,6,1,0,1,"nn",5,7,2,1,1,9,1,2,32: GOTO 38800
38120 RESTORE 38120: DATA 1,6,1,0,1,"nn",5,7,2,2,1,9,2,2,32: GOTO 38800
38800 ret% = 1: WHILE ret% < 99: READ x$: msk1def x$, ret%: WEND
38810 mskparm tt$(), w, x1$, x2$: RETURN
40100 x$ = msg$("Error dberr=" + STR$(dberr%) + " not foreseen"): closfl 0: END
'
