bas/BAS/TPV.BAS
2021-09-03 17:42:07 +02:00

2102 lines
57 KiB
QBasic
Raw Blame History

'
' Q B a s i c P e r s o n a l F i n a n c i a l
'
' Copyright (C) Microsoft Corporation 1990
'Set default data type to integer for faster operation
DEFINT A-Z
'Sub and function declarations
DECLARE SUB ScrollUp ()
DECLARE SUB ScrollDown ()
DECLARE SUB Initialize ()
DECLARE SUB center (Row%, text$)
DECLARE SUB FancyCls (dots%, Background%)
DECLARE SUB LoadState ()
DECLARE SUB SaveState ()
DECLARE SUB MenuSystem ()
DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%)
DECLARE SUB PrintHelpLine (help$)
DECLARE SUB ImpRef (po%)
DECLARE SUB ImpComp (so%)
DECLARE SUB Vende (r%)
DECLARE SUB Elif ()
DECLARE SUB Staul ()
DECLARE SUB Ticket (e%)
DECLARE SUB Stock (EE%)
DECLARE SUB Balan (EEE%)
DECLARE FUNCTION Cvit$ (x%)
DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, Choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%)
DECLARE FUNCTION GetString$ (Row%, Col%, start$, end$, vis%, max%)
DECLARE FUNCTION Trim$ (x$)
'Constants
CONST true = -1
CONST false = NOT true
'User-defined types
TYPE AccountType
Title AS STRING * 20
AType AS STRING * 1
Desc AS STRING * 50
END TYPE
TYPE Recordtype
Date AS STRING * 8
Ref AS STRING * 10
Desc AS STRING * 50
Fig1 AS DOUBLE
Fig2 AS DOUBLE
END TYPE
'Global variables
DIM SHARED Account(1 TO 19) AS AccountType 'Stores the 19 account titles
DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors
DIM SHARED ScrollUpAsm(1 TO 7) 'Assembly Language Routines
DIM SHARED ScrollDownAsm(1 TO 7)
DIM SHARED Fecha$(1), fech$(1)
COMMON SHARED Account() AS AccountType, ColorPref, colors(), ScrollUpAsm(), ScrollDownAsm(), printerr AS INTEGER, Choice, SubChoice
DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock
KeyFlags = PEEK(1047)
POKE 1047, &H0
DEF SEG
'Open money manager data file. If it does not exist in current directory,
' goto error handler to create and initialize it.
ON ERROR GOTO ErrorTrap
OPEN "Personal.cfg" FOR INPUT AS #1
CLOSE
ON ERROR GOTO 0 'Reset error handler
Initialize 'Initialize program
MenuSystem 'This is the main program
COLOR 7, 0 'Clear screen and end
CLS
DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states
POKE 1047, KeyFlags
DEF SEG
END
' Error handler for program
' If data file not found, create and initialize a new one.
ErrorTrap:
SELECT CASE ERR
' If data file not found, create and initialize a new one.
CASE 53
CLOSE
ColorPref = 1
FOR A = 1 TO 19
Account(A).Title = ""
Account(A).AType = ""
Account(A).Desc = ""
NEXT A
SaveState
RESUME
CASE 24, 25
printerr = true
Box 8, 13, 14, 69
center 11, "La impresora no responde ..."
center 12, "Presione Barra espaciadora para continuar"
WHILE INKEY$ <> "": WEND
RESUME NEXT
CASE ELSE
END SELECT
RESUME NEXT
ErrorCaj:
OPEN "Caja.cfg" FOR OUTPUT AS #1
PRINT #1, "N"
CLOSE
RESUME NEXT
'The following data defines the color schemes available via the main menu.
'
' scrn dots bar back title shdow choice curs cursbk shdow
DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0
DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0
DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0
DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0
'The following data is actually a machine language program to
'scroll the screen up or down very fast using a BIOS call.
DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB
DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB
SUB Balan (EE%)
END SUB
'Box:
' Draw a box on the screen between the given coordinates.
SUB Box (Row1, Col1, Row2, Col2) STATIC
BoxWidth = Col2 - Col1 + 1
LOCATE Row1, Col1
PRINT "<22>"; STRING$(BoxWidth - 2, "<22>"); "<22>";
FOR A = Row1 + 1 TO Row2 - 1
LOCATE A, Col1
PRINT "<22>"; SPACE$(BoxWidth - 2); "<22>";
NEXT A
LOCATE Row2, Col1
PRINT "<22>"; STRING$(BoxWidth - 2, "<22>"); "<22>";
END SUB
'Center:
' Center text on the given row.
SUB center (Row, text$)
LOCATE Row, 41 - LEN(text$) / 2
PRINT text$;
END SUB
'Cvit$:
' Convert an integer to a string WITHOUT a leading space.
FUNCTION Cvit$ (x)
Cvit$ = RIGHT$(STR$(x), LEN(STR$(x)) - 1)
END FUNCTION
SUB Elif
END SUB
'FancyCls:
' Clears screen in the right color, and draws nice dots.
SUB FancyCls (dots, Background)
VIEW PRINT 2 TO 24
COLOR dots, Background
CLS 2
FOR A = 95 TO 1820 STEP 45
Row = A / 80 + 1
Col = A MOD 80 + 1
LOCATE Row, Col
PRINT CHR$(250);
NEXT A
VIEW PRINT
END SUB
'GetString$:
' Given a row and col, and an initial string, edit a string
' VIS is the length of the visible field of entry
' MAX is the maximum number of characters allowed in the string
FUNCTION GetString$ (Row, Col, start$, end$, vis, max)
Curr$ = Trim$(LEFT$(start$, max))
IF Curr$ = CHR$(8) THEN Curr$ = ""
LOCATE , , 1
finished = false
DO
GOSUB GetStringShowText
GOSUB GetStringGetKey
IF LEN(kbd$) > 1 THEN
finished = true
GetString$ = kbd$
ELSE
SELECT CASE kbd$
CASE CHR$(13), CHR$(27), CHR$(9)
finished = true
GetString$ = kbd$
CASE CHR$(8)
IF Curr$ <> "" THEN
Curr$ = LEFT$(Curr$, LEN(Curr$) - 1)
END IF
CASE " " TO "}"
IF LEN(Curr$) < max THEN
Curr$ = Curr$ + kbd$
ELSE
BEEP
END IF
CASE ELSE
BEEP
END SELECT
END IF
LOOP UNTIL finished
end$ = Curr$
LOCATE , , 0
EXIT FUNCTION
GetStringShowText:
LOCATE Row, Col
IF LEN(Curr$) > vis THEN
PRINT RIGHT$(Curr$, vis);
ELSE
PRINT Curr$; SPACE$(vis - LEN(Curr$));
LOCATE Row, Col + LEN(Curr$)
END IF
RETURN
GetStringGetKey:
kbd$ = ""
WHILE kbd$ = ""
kbd$ = INKEY$
WEND
RETURN
END FUNCTION
SUB ImpComp (so%)
'Stores info about each column
'Array to keep the current balance at all the transactions
REDIM Col(6), Balance#(1000)
mes$ = MID$(DATE$, 1, 2)
an$ = MID$(DATE$, 7, 4)
comes$ = mes$ + "-" + an$
gf = 0
Box 17, 5, 21, 75
center 18, "Por Favor Introduzca Mes y a<>o"
center 19, "para imprimir gastos."
PrintHelpLine "Mes y A<>o: mm-aaaa"
DO
emp$ = GetString$(20, 7, comes$, end$, 10, 10)
Fecha$ = end$
mes$ = MID$(Fecha$, 1, 2)
IF VAL(mes$) <= 12 THEN gf = 1
IF LEN(Fecha$) < 7 THEN gf = 0
LOOP WHILE gf = 0
gf = 0
mes$ = MID$(Fecha$, 1, 2)
an$ = MID$(Fecha$, 4, 4)
center 18, "Imprimiendo Fecha Seleccionada"
center 19, "Por favor, espere ..."
'Open random access file
file$ = "E-" + mes$ + an$ + "." + Cvit$(so%)
OPEN file$ FOR RANDOM AS #1 LEN = 59
FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$
FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$
GET #1, 1
IF valid$ <> "SI" THEN
center 18, "Este mes, esta vacio, verifique esto."
center 19, "--> Pulse una tecla <--"
SLEEP
EXIT SUB
END IF
MaxRecord = VAL(IoMaxRecord$)
Balance#(0) = 0
A = 1
WHILE A <= MaxRecord
GET #1, A + 1
p# = VAL(IoPvp$)
p1# = VAL(IoUnd$)
p2# = VAL(IoCC$)
p3# = VAL(IoPc$)
Balance#(A) = p# * p1# * p2# - p1# * p2# * p3#
BalTotal# = BalTotal# + Balance#(A)
A = A + 1
WEND
DO
printerr = false
ON ERROR GOTO ErrorTrap
LPRINT
kdb$ = INKEY$
WHILE kdb$ = "": kdb$ = INKEY$: WEND
IF kdb$ = CHR$(27) THEN EXIT SUB
LOOP WHILE printerr = true
Box 8, 13, 14, 69
LPRINT SPACE$(80);
LPRINT "Empresa: " + Trim$(Account(so%).Title);
GOSUB ObtMes
LPRINT TAB(63); "Fecha: " + Fecha$;
LPRINT
LPRINT "Dia<69> Ref# <20> Concepto <20> Und <20>Und/C<> P.V.P. <20> P.C. <20> Beneficios ";
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
LPRINT " <20> <20> <20> <20> <20> <20> <20> ";
u2$ = "##,###,###"
u3$ = "####,###,###"
u5$ = "###"
u6$ = "######"
u9$ = "#,###,###,###,###"
Curlip = 3
A = 1
Curlip = 0
WHILE A <= MaxRecord
GET #1, A + 1
Curlip = Curlip + 1
IF Curlip = 50 THEN GOSUB PausePage
dia$ = IoDia$
r# = VAL(IoRef$)
D$ = IoDesc$
p# = VAL(IoPvp$)
p1# = VAL(IoUnd$)
p2# = VAL(IoCC$)
p3# = VAL(IoPc$)
Balance#(A) = p# * p1# * p2# - p1# * p2# * p3#
IF LEN(dia$) = 1 THEN LPRINT TAB(3); dia$ + "<22>"; ELSE LPRINT TAB(2); dia$ + "<22>";
IF r# <> 0 THEN LPRINT USING u6$; r#; ELSE LPRINT " ";
IF RTRIM$(LTRIM$(D$)) <> "" THEN LPRINT "<22>" + D$; ELSE LPRINT "<22> ";
IF p1# <> 0 THEN LPRINT "<22> "; : LPRINT USING u5$; p1#; : LPRINT " "; ELSE LPRINT "<22> ";
IF p2# <> 0 THEN LPRINT "<22> "; : LPRINT USING u5$; p2#; : LPRINT " "; ELSE LPRINT "<22> ";
IF p3# <> 0 THEN LPRINT "<22>"; : LPRINT USING u2$; p3#; ELSE LPRINT "<22> ";
IF p2# <> 0 THEN LPRINT "<22>"; : LPRINT USING u2$; p2#; ELSE LPRINT "<22> ";
LPRINT "<22>";
LPRINT USING u3$; Balance#(A);
A = A + 1
WEND
LPRINT "<22><>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
LPRINT " Balance total:"; USING u9$; BalTotal#;
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
LPRINT "<22><>ܳ<EFBFBD><DCB3><EFBFBD><EFBFBD><EFBFBD>ܳ<EFBFBD><DCB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ܳ<EFBFBD><DCB3><EFBFBD><EFBFBD>ܳ<EFBFBD><DCB3><EFBFBD><EFBFBD>ܳ<EFBFBD><DCB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ܳ<EFBFBD><DCB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ܳ<EFBFBD><DCB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
LPRINT "Programa Realizado por J.D. para Guill<6C>n Dominguez s.l"
EXIT SUB
PausePage:
center 18, "Inserte una hoja en la impresora"
center 19, "Y pulse una tecla... "
SLEEP
DO
kop = 0
printerr = false
ON ERROR GOTO ErrorTrap
LPRINT
kdb$ = INKEY$
WHILE kdb$ = "": kdb$ = INKEY$: WEND
IF kdb$ = CHR$(27) THEN EXIT SUB
Box 8, 13, 14, 69
LOOP WHILE printerr <> true
center 18, "Imprimiendo Fecha Seleccionada"
center 19, "Por favor, espere ..."
RETURN
ObtMes:
SELECT CASE VAL(mes$)
CASE 1: Fecha$ = "Enero, " + an$
CASE 2: Fecha$ = "Febr., " + an$
CASE 3: Fecha$ = "Marzo, " + an$
CASE 4: Fecha$ = "Abril, " + an$
CASE 5: Fecha$ = "Mayo, " + an$
CASE 6: Fecha$ = "Junio, " + an$
CASE 7: Fecha$ = "Julio, " + an$
CASE 8: Fecha$ = "Agost, " + an$
CASE 9: Fecha$ = "Sept., " + an$
CASE 10: Fecha$ = "Octu., " + an$
CASE 11: Fecha$ = "Nov., " + an$
CASE 12: Fecha$ = "Dicc., " + an$
END SELECT
RETURN
END SUB
SUB ImpRef (po%)
REDIM CurrFig#(5), CurrString$(1)
file$ = "Ref#." + Cvit$(po%)
OPEN file$ FOR RANDOM AS #1 LEN = 54
FIELD #1, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$
FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$
GET #1, 1
IF valid$ <> "SI" THEN
center 18, "Al parecer esta empresa no tiene ref."
center 19, "Verifique estos datos. PAK"
SLEEP
EXIT SUB
END IF
MaxRecord = VAL(IoMaxRecord$)
Box 17, 5, 21, 75
center 18, "Imprimiendo Referencias"
center 19, "Por favor, espere ..."
DO
printerr = false
ON ERROR GOTO ErrorTrap
LPRINT
kdb$ = INKEY$
WHILE kdb$ = "": kdb$ = INKEY$: WEND
IF kdb$ = CHR$(27) THEN EXIT SUB
LOOP WHILE printerr = true
LPRINT "Referencias de la Empresa: " + Trim$(Account(po%).Title);
LPRINT " "
LPRINT " Ref# <20> Concepto <20> Und/C <20> P.V.P. <20> P.C. ";
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
LPRINT " <20> <20> <20> <20> "
u1x$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
u2$ = "##,###,###"
u5$ = "###"
u6$ = "######"
A = 1
WHILE A <= MaxRecord
GET #1, A + 1
CurrFig#(2) = VAL(IoRef$)
CurrString$(1) = IoDesc$
CurrFig#(3) = VAL(IoCC$)
CurrFig#(4) = VAL(IoPvp$)
CurrFig#(5) = VAL(IoPc$)
ds = ds + 1
IF ds = 50 THEN GOSUB finpage
IF CurrFig#(2) <> 0 THEN LPRINT " "; : LPRINT USING u6$; CurrFig#(2); ELSE LPRINT " ";
IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN LPRINT "<22> " + CurrString$(1); ELSE LPRINT "<22> ";
IF CurrFig#(3) <> 0 THEN LPRINT " <20> "; : LPRINT USING u5$; CurrFig#(3); : LPRINT " "; ELSE LPRINT " <20> ";
IF CurrFig#(4) <> 0 THEN LPRINT "<22> "; : LPRINT USING u5$; CurrFig#(4); : LPRINT " "; ELSE LPRINT "<22> ";
IF CurrFig#(5) <> 0 THEN LPRINT "<22> "; : LPRINT USING u2$; CurrFig#(5) ELSE LPRINT "<22> "
A = A + 1
WEND
EXIT SUB
finpage:
center 18, "Inserte una hoja en la impresora"
center 19, "Y pulse una tecla... "
SLEEP
DO
kop = 0
printerr = false
ON ERROR GOTO ErrorTrap
LPRINT
kdb$ = INKEY$
WHILE kdb$ = "": kdb$ = INKEY$: WEND
IF kdb$ = CHR$(27) THEN EXIT SUB
Box 8, 13, 14, 69
LOOP WHILE printerr <> true
center 18, "Imprimiendo Fecha Seleccionada"
center 19, "Por favor, espere ..."
RETURN
END SUB
'Initialize:
' Read colors in and set up assembly routines
SUB Initialize
WIDTH , 25
VIEW PRINT
FOR ColorSet = 1 TO 4
FOR x = 1 TO 10
READ colors(x, ColorSet)
NEXT x
NEXT ColorSet
LoadState
p = VARPTR(ScrollUpAsm(1))
DEF SEG = VARSEG(ScrollUpAsm(1))
FOR i = 0 TO 13
READ J
POKE (p + i), J
NEXT i
p = VARPTR(ScrollDownAsm(1))
DEF SEG = VARSEG(ScrollDownAsm(1))
FOR i = 0 TO 13
READ J
POKE (p + i), J
NEXT i
DEF SEG
END SUB
'LoadState:
' Load color preferences and account info from Personal.cfg
SUB LoadState
OPEN "Personal.cfg" FOR INPUT AS #1
INPUT #1, ColorPref
FOR A = 1 TO 10
LINE INPUT #1, Account(A).Title
NEXT A
CLOSE
END SUB
'Menu:
' Handles Menu Selection for a single menu (either sub menu, or menu bar)
' currChoiceX : Number of current choice
' maxChoice : Number of choices in the list
' choice$() : Array with the text of the choices
' itemRow() : Array with the row of the choices
' itemCol() : Array with the col of the choices
' help$() : Array with the help text for each choice
' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style
'
' Returns the number of the choice that was made by changing currChoiceX
' and returns the scan code of the key that was pressed to exit
'
FUNCTION Menu (CurrChoiceX, MaxChoice, Choice$(), ItemRow(), ItemCol(), help$(), BarMode)
currChoice = CurrChoiceX
'if in bar mode, color in menu bar, else color box/shadow
'bar mode means you are currently in the menu bar, not a sub menu
IF BarMode THEN
COLOR colors(7, ColorPref), colors(4, ColorPref)
LOCATE 1, 1
PRINT SPACE$(80);
ELSE
IF boorra <> 0 THEN FancyCls colors(2, ColorPref), colors(1, ColorPref)
COLOR colors(7, ColorPref), colors(4, ColorPref)
Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(Choice$(1)) + 1
COLOR colors(10, ColorPref), colors(6, ColorPref)
FOR A = 1 TO MaxChoice + 1
LOCATE ItemRow(1) + A - 1, ItemCol(1) + LEN(Choice$(1)) + 2
PRINT CHR$(178); CHR$(178);
NEXT A
LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2
PRINT STRING$(LEN(Choice$(MaxChoice)) + 2, 178);
END IF
'print the choices
COLOR colors(7, ColorPref), colors(4, ColorPref)
FOR A = 1 TO MaxChoice
LOCATE ItemRow(A), ItemCol(A)
PRINT Choice$(A);
NEXT A
finished = false
WHILE NOT finished
GOSUB MenuShowCursor
GOSUB MenuGetKey
GOSUB MenuHideCursor
SELECT CASE kbd$
CASE CHR$(0) + "H": GOSUB MenuUp
CASE CHR$(0) + "P": GOSUB MenuDown
CASE CHR$(0) + "K": GOSUB MenuLeft
CASE CHR$(0) + "M": GOSUB MenuRight
CASE CHR$(13): GOSUB MenuEnter
CASE CHR$(27): GOSUB MenuEscape
CASE ELSE: BEEP
END SELECT
WEND
Menu = currChoice
EXIT FUNCTION
MenuEnter:
finished = true
RETURN
MenuEscape:
currChoice = 0
finished = true
RETURN
MenuUp:
IF BarMode THEN
BEEP
ELSE
currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
END IF
RETURN
MenuLeft:
IF BarMode THEN
currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1
ELSE
currChoice = -2
finished = true
END IF
RETURN
MenuRight:
IF BarMode THEN
currChoice = (currChoice) MOD MaxChoice + 1
ELSE
currChoice = -3
finished = true
END IF
RETURN
MenuDown:
IF BarMode THEN
finished = true
ELSE
currChoice = (currChoice) MOD MaxChoice + 1
END IF
RETURN
MenuShowCursor:
COLOR colors(8, ColorPref), colors(9, ColorPref)
LOCATE ItemRow(currChoice), ItemCol(currChoice)
PRINT Choice$(currChoice);
PrintHelpLine help$(currChoice)
RETURN
MenuGetKey:
kbd$ = ""
WHILE kbd$ = ""
kbd$ = INKEY$
WEND
RETURN
MenuHideCursor:
COLOR colors(7, ColorPref), colors(4, ColorPref)
LOCATE ItemRow(currChoice), ItemCol(currChoice)
PRINT Choice$(currChoice);
RETURN
END FUNCTION
'MenuSystem:
' Main routine that controls the program. Uses the MENU function
' to implement menu system and calls the appropriate function to handle
' the user's selection
SUB MenuSystem
boorra = 1
DIM Choice$(20), menuRow(20), menuCol(20), help$(20)
LOCATE , , 0
Choice = 1
finished = false
WHILE NOT finished
GOSUB MenuSystemMain
SubChoice = -1
WHILE SubChoice < 0
SELECT CASE Choice
CASE 1: GOSUB MenuSystemFile
CASE 2: GOSUB MenuSystemEdit
CASE 3: GOSUB MenuSystemAccount
CASE 4: GOSUB MenuSystemReport
CASE 5: GOSUB MenuSystemColors
CASE 6: GOSUB help
END SELECT
FancyCls colors(2, ColorPref), colors(1, ColorPref)
SELECT CASE SubChoice
CASE -2: Choice = (Choice + 3) MOD 5 + 1
CASE -3: Choice = (Choice) MOD 6 + 1
END SELECT
WEND
WEND
EXIT SUB
MenuSystemMain:
FancyCls colors(2, ColorPref), colors(1, ColorPref)
COLOR colors(7, ColorPref), colors(4, ColorPref)
Box 9, 19, 14, 61
center 11, "Use las teclas de direcci<63>n para el men<65>"
center 12, "Presione Entrar para elegir elemento"
Choice$(1) = " Archivo "
Choice$(2) = " Proveedores "
Choice$(3) = " Transacciones "
Choice$(4) = " Clientes "
Choice$(5) = " Colores "
Choice$(6) = " Ayuda "
menuRow(1) = 1: menuCol(1) = 2
menuRow(2) = 1: menuCol(2) = 12
menuRow(3) = 1: menuCol(3) = 26
menuRow(4) = 1: menuCol(4) = 42
menuRow(5) = 1: menuCol(5) = 53
menuRow(6) = 1: menuCol(6) = 72
help$(1) = "Salir del T.P.V"
help$(2) = "Agregar/edit/supr Proveedores"
help$(3) = "Agregar/edit/supr Transacciones"
help$(4) = "Ver e imprimir clientes"
help$(5) = "Fijar color en pantalla"
help$(6) = " Ayuda "
DO
NewChoice = Menu((Choice), 6, Choice$(), menuRow(), menuCol(), help$(), true)
LOOP WHILE NewChoice = 0
Choice = NewChoice
RETURN
MenuSystemFile:
FancyCls colors(2, ColorPref), colors(1, ColorPref)
Choice$(1) = " Ficheros "
Choice$(2) = " Status "
Choice$(3) = " Salir "
menuRow(1) = 3: menuCol(1) = 2
menuRow(2) = 4: menuCol(2) = 2
menuRow(3) = 5: menuCol(3) = 2
help$(1) = "Operaciones de Configuraci<63>n"
help$(2) = "Status actual"
help$(3) = "Salir del T.P.V."
SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false)
SELECT CASE SubChoice
CASE 1
Choice$(1) = " Eliminar Fich. "
Choice$(2) = " Vendedores "
Choice$(3) = " Caja (S/N) "
menuRow(1) = 5: menuCol(1) = 6
menuRow(2) = 6: menuCol(2) = 6
menuRow(3) = 7: menuCol(3) = 6
help$(1) = "Eliminaci<63>n de ficheros..."
help$(2) = "Agregar/Editar/Eliminar Vendedores"
help$(3) = "Configurar Caja registradora"
SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false)
SELECT CASE SubChoice
CASE 1: Elif
CASE 2
don = 2
GOSUB empresa
Vende (SubChoice)
don = 0
CASE 3
ON ERROR GOTO ErrorCaj
OPEN "Caja.cfg" FOR INPUT AS #1
INPUT #1, act$
CLOSE
Box 8, 13, 14, 69
center 11, "<22>Hay una caja registradora instalada"
center 12, "en el puerto RS232?"
LOCATE 13, 15: PRINT "Actual: ", act$
center 14, "<Esc, Mantener> <<3C><> Cambiar"
kbd$ = INKEY$
WHILE kbd$ = "": kbd$ = INKEY$: WEND
IF kbd$ <> CHR$(13) THEN RETURN
LOCATE 13, 15: INPUT "Nuevo: ", act$
IF UCASE$(RTRIM$(LTRIM$(act$))) <> "S" THEN act$ = "N"
OPEN "Caja.cfg" FOR OUTPUT AS #1
PRINT #1, act$
CLOSE
CASE ELSE
END SELECT
CASE 2: Staul
CASE 3: finished = true
CASE ELSE
END SELECT
RETURN
MenuSystemEdit:
FancyCls colors(2, ColorPref), colors(1, ColorPref)
Choice$(1) = " Altas "
Choice$(2) = " Editar/Modificar "
Choice$(3) = " Buscar "
Choice$(4) = " Eliminar "
Choice$(5) = " Imprimir (1, 2) "
menuRow(1) = 3: menuCol(1) = 9
menuRow(2) = 4: menuCol(2) = 9
menuRow(3) = 5: menuCol(3) = 9
menuRow(4) = 6: menuCol(4) = 9
menuRow(5) = 7: menuCol(5) = 9
help$(1) = "Agregar Proveedores"
help$(2) = "Editar/Modificar Proveedores"
help$(3) = "Busqueda de Proveedores"
help$(4) = "Eliminar Proveedores"
help$(5) = "Imprimir lista individual o r<>pida"
SubChoice = Menu(1, 5, Choice$(), menuRow(), menuCol(), help$(), false)
SELECT CASE SubChoice
CASE 1 TO 5
CHAIN "Proveed"
END SELECT
RETURN
MenuSystemAccount:
don = 0
FancyCls colors(2, ColorPref), colors(1, ColorPref)
Choice$(1) = " Compras "
Choice$(2) = " Referencias "
Choice$(3) = " Imprimir (1) "
Choice$(4) = " Imprimir (2) "
menuRow(1) = 3: menuCol(1) = 26
menuRow(2) = 4: menuCol(2) = 26
menuRow(3) = 5: menuCol(3) = 26
menuRow(4) = 6: menuCol(4) = 26
help$(1) = "Agregar/Eliminar/Editar Compras"
help$(2) = "Agregar/Eliminar/Editar Referencias"
help$(3) = "Imprimir Compras del mes"
help$(4) = "Imprimir Referencias"
SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false)
item% = SubChoice
SELECT CASE SubChoice
CASE 1: vaw = 1: GOTO empresa
CASE 2: vaw = 2: GOTO empresa
CASE 3: vaw = 3: GOTO empresa
CASE 4: vaw = 4: GOTO empresa
END SELECT
RETURN
empresa:
boorra = 1
FOR A = 1 TO 10
IF Trim$(Account(A).Title) = "" THEN
Choice$(A) = RIGHT$(STR$(A), 2) + ". ------------------- "
ELSE
Choice$(A) = RIGHT$(STR$(A), 2) + ". " + Account(A).Title
END IF
menuRow(A) = A + 4
menuCol(A) = 32
help$(A) = RTRIM$(Account(A).Title)
NEXT A
SubChoice = Menu(1, 10, Choice$(), menuRow(), menuCol(), help$(), false)
boorra = 0
IF SubChoice > 0 THEN
IF Choice$(SubChoice) = RIGHT$(STR$(SubChoice), 2) + ". ------------------- " THEN
Box 17, 5, 21, 75
center 19, "Esa empresa no EXISTE, <20>Desea crearla?"
DO:
K$ = INKEY$
LOOP WHILE K$ = ""
IF K$ = "s" OR K$ = "S" THEN
Box 17, 5, 21, 75
center 18, "Introduzca el nombre de la Empresa"
emp$ = GetString$(19, 7, "", end$, 20, 20)
'end$ contiene la informacion
Account(SubChoice).Title = end$
SaveState
ELSE
Box 17, 5, 21, 75
center 19, "Escoja una empresa"
GOTO empresa
END IF
END IF
item% = SubChoice
IF vaw = 2 THEN
Box 17, 5, 21, 75
center 18, "Por Favor, espere mientras"
center 19, "inicio el modulo de REFERENCIAS"
CHAIN "ref#"
END IF
IF vaw = 1 THEN
Box 17, 5, 21, 75
center 18, "Por Favor, espere mientras"
center 19, "inicio el modulo de COMPRAS"
CHAIN "compras"
END IF
IF vaw = 3 THEN ImpComp (SubChoice)
IF vaw = 4 THEN ImpRef (SubChoice)
END IF
IF don = 2 THEN RETURN
GOTO MenuSystemMain
MenuSystemReport:
FancyCls colors(2, ColorPref), colors(1, ColorPref)
Choice$(1) = " Ticket "
Choice$(2) = " Balance "
Choice$(3) = " Stock actual "
menuRow(1) = 3: menuCol(1) = 39
menuRow(2) = 4: menuCol(2) = 39
menuRow(3) = 5: menuCol(3) = 39
help$(1) = "Ticket, comenzar a fichar"
help$(2) = "Total Vendido, dia, mes"
help$(3) = "Ver o imprimir Stock actual"
SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false)
don = 2
SELECT CASE SubChoice
CASE 1
GOSUB empresa
Ticket (SubChoice%)
CASE 2
GOSUB empresa
Balan (SubChoice%)
CASE 3
GOSUB empresa
Stock (SubChoice%)
CASE ELSE
END SELECT
RETURN
MenuSystemColors:
FancyCls colors(2, ColorPref), colors(1, ColorPref)
Choice$(1) = " Monocrom<6F>tico "
Choice$(2) = " Cyan/Azul "
Choice$(3) = " Azul/Cyan "
Choice$(4) = " Rojo/Gris "
menuRow(1) = 3: menuCol(1) = 50
menuRow(2) = 4: menuCol(2) = 50
menuRow(3) = 5: menuCol(3) = 50
menuRow(4) = 6: menuCol(4) = 50
help$(1) = "Color para presentaci<63>n monocrom<6F>tico y LCD"
help$(2) = "Color presentado cyan"
help$(3) = "Color presentado azul"
help$(4) = "Color presentado rojo"
SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false)
SELECT CASE SubChoice
CASE 1 TO 4
ColorPref = SubChoice
SaveState
CASE ELSE
END SELECT
RETURN
help:
FancyCls colors(2, ColorPref), colors(1, ColorPref)
Choice$(1) = " Uso de la ayuda "
Choice$(2) = " Sobre los Men<65>s "
Choice$(3) = " Grabaci<63>n de Datos "
Choice$(4) = " Acerca de... "
menuRow(1) = 3: menuCol(1) = 57
menuRow(2) = 4: menuCol(2) = 57
menuRow(3) = 5: menuCol(3) = 57
menuRow(4) = 6: menuCol(4) = 57
help$(1) = "Uso de la ayuda en Personal Financial"
help$(2) = "Ayuda en los men<65>s"
help$(3) = "Modo de grabar los Datos"
help$(4) = "Creditos del Personal Financial"
SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false)
SELECT CASE SubChoice
CASE 1
RETURN
CASE 2
RETURN
CASE 3
RETURN
CASE 4
Box 9, 10, 16, 70
center 10, "T E R M I N A L P U N T O de V E N T A"
center 12, "by"
center 14, "Jos<6F> David Guill<6C>n (c) 1993"
center 16, "Pulse una tecla"
SLEEP
CASE ELSE
END SELECT
RETURN
END SUB
'PrintHelpLine:
' Prints help text on the bottom row in the proper color
SUB PrintHelpLine (help$)
COLOR colors%(5, ColorPref), colors%(4, ColorPref)
LOCATE 25, 1
PRINT SPACE$(80);
center 25, help$
END SUB
'SaveState:
' Save color preference and account information to "Personal.cfg" data file.
SUB SaveState
OPEN "Personal.cfg" FOR OUTPUT AS #2
PRINT #2, ColorPref
FOR A = 1 TO 19
PRINT #2, Account(A).Title
NEXT A
CLOSE #2
END SUB
'ScrollDown:
' Call the assembly program to scroll the screen down
SUB ScrollDown
DEF SEG = VARSEG(ScrollDownAsm(1))
CALL Absolute(VARPTR(ScrollDownAsm(1)))
DEF SEG
END SUB
'ScrollUp:
' Calls the assembly program to scroll the screen up
SUB ScrollUp
DEF SEG = VARSEG(ScrollUpAsm(1))
CALL Absolute(VARPTR(ScrollUpAsm(1)))
DEF SEG
END SUB
SUB Staul
END SUB
SUB Stock (EEE%)
END SUB
SUB Ticket (e%)
'Stores info about each column
REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6)
'Array to keep the current balance at all the transactions
REDIM Balance#(1000), Ca#(1000), Cb$(1000), Cc#(1000), Cd#(1000), Ce#(1000), lin$(155)
gf = 0
Box 17, 5, 21, 75
center 18, "Por Favor Introduzca Fecha"
center 19, "con la que guardar ticket del d<>a."
PrintHelpLine "Fecha: mm - dd - aaaa"
DO
emp$ = GetString$(20, 7, DATE$, end$, 10, 10)
Fecha$ = end$
M = VAL(MID$(Fecha$, 1, 2))
D = VAL(MID$(Fecha$, 4, 2))
IF M <= 12 AND D <= 31 THEN gf = 1
IF LEN(Fecha$) < 10 THEN gf = 0
LOOP WHILE gf = 0
gf = 0
mes$ = MID$(Fecha$, 1, 2)
dia$ = MID$(Fecha$, 4, 2)
an$ = MID$(Fecha$, 7, 4)
CurrDia$ = dia$
compufech$ = mes$ + dia$ + an$
help$(1) = "Vendedor 1 a 9 "
help$(2) = "Referencia "
help$(3) = "Producto "
help$(4) = "Unidades "
help$(5) = "P.V.P. (Unidad) "
Col(1) = 2: vis(1) = 3: max(1) = 1
Col(2) = 9: vis(2) = 6: max(2) = 6
Col(3) = 19: vis(3) = 22: max(3) = 22
Col(4) = 43: vis(4) = 5: max(4) = 3
Col(5) = 51: vis(5) = 10: max(5) = 8
'Open random access file
file$ = "T-" + dia$ + mes$ + "." + Cvit$(e)
OPEN file$ FOR RANDOM AS #1 LEN = 59
FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$
FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$
'Initialize variables
CurrString$(1) = ""
CurrFig#(2) = 0
CurrFig#(3) = 0
CurrFig#(4) = 0
CurrFig#(5) = 0
CurrFig#(6) = 0
GET #1, 1
IF valid$ <> "SI" THEN
LSET IoDia$ = ""
LSET IoRef$ = STR$(0)
LSET IoDesc$ = ""
LSET IoUnd$ = STR$(0)
LSET IoCC$ = STR$(0)
LSET IoPvp$ = STR$(0)
LSET IoPc$ = STR$(0)
PUT #1, 2
LSET valid$ = "SI"
LSET IoMaxRecord$ = "1"
PUT #1, 1
END IF
MaxRecord = VAL(IoMaxRecord$)
Balance#(0) = 0
A = 1
WHILE A <= MaxRecord
GET #1, A + 1
p# = VAL(IoPvp$)
p1# = VAL(IoUnd$)
p2# = VAL(IoCC$)
p3# = VAL(IoPc$)
Balance#(A) = p# * p1# * p2# - p1# * p2# * p3#
BalTotal# = BalTotal# + Balance#(A)
A = A + 1
WEND
GOSUB CargaReferencias
'Draw Screen
COLOR colors(7, ColorPref), colors(4, ColorPref)
Box 2, 1, 21, 80
Box 22, 1, 24, 80
COLOR colors(5, ColorPref), colors(4, ColorPref)
LOCATE 1, 1: PRINT SPACE$(80);
LOCATE 1, 4: PRINT "Empresa: " + Trim$(Account(e%).Title);
'LOCATE 1, 63: PRINT "Fecha: ";
'LOCATE 1, 63: PRINT "Fecha: " + Fecha$;
COLOR colors(7, ColorPref), colors(4, ColorPref)
LOCATE 3, 2: PRINT " No. <20> Ref# <20> Concepto <20> Und <20> P.V.P. <20> Total "
LOCATE 4, 2: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
u1$ = " <20> <20> <20> <20> <20> "
u1x$ = "<22><><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>߳<EFBFBD><DFB3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
u2$ = "##,###,###"
u3$ = "##,###,###,###"
u5$ = "###"
u6$ = "######"
u9$ = "#,###,###,###,###"
CurrTopline = 1: bajabarra = 1
GOSUB EditPrintWholeScreen
bajabarra = 0
CurrRow = 1
CurrCol = 1
PrintHelpLine help$(CurrCol) + "| <F1=Fichar> <F2=Salir> <F3=Impr. Tiket> <F9=Insert> <F10=Supr>"
GOSUB EditGetLine
finished = false
GOSUB EditPrintBalances
'Loop until <F2> is pressed
DO
GOSUB EditShowCursor 'Show Cursor, Wait for key
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
ed = 1: GOSUB EditShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1
bajabar = 0: bajabarra = 0
IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item
GOSUB EditEditItem
END IF
SELECT CASE kbd$ 'Handle Special keys
CASE CHR$(0) + "H" 'up arrow
GOSUB EditMoveUp
CASE CHR$(0) + "P" 'Down arrow
GOSUB EditMoveDown
CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab
CurrCol = (CurrCol + 3) MOD 5 + 1
PrintHelpLine help$(CurrCol) + "| <F1=Fichar> <F2=Salir> <F3=Impr. Tiket> <F9=Insert> <F10=Supr>"
CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab
CurrCol = (CurrCol) MOD 5 + 1
PrintHelpLine help$(CurrCol) + "| <F1=Fichar> <F2=Salir> <F3=Impr. Tiket> <F9=Insert> <F10=Supr>"
CASE CHR$(0) + "G" 'Home
CurrCol = 1
CASE CHR$(0) + "O" 'End
CurrCol = 6
CASE CHR$(0) + "I" 'Page Up
CurrRow = 1
CurrTopline = CurrTopline - 16
IF CurrTopline < 1 THEN
CurrTopline = 1
END IF
'************************
bajabarra = 1
GOSUB EditPrintWholeScreen
GOSUB EditGetLine
bajabarra = 0
GOSUB PrintBalan
CASE CHR$(0) + "Q" 'Page Down
CurrRow = 1
CurrTopline = CurrTopline + 16
IF CurrTopline > MaxRecord THEN
CurrTopline = MaxRecord
END IF
bajabarra = 1
GOSUB EditPrintWholeScreen
GOSUB EditGetLine
bajabarra = 0
GOSUB PrintBalan
CASE CHR$(0) + "<" 'F2
finished = true
CASE CHR$(0) + "C" 'F9
GOSUB EditAddRecord
CASE CHR$(0) + "D" 'F10
GOSUB EditDeleteRecord
CASE CHR$(13) 'Enter
CASE ELSE
BEEP
END SELECT
LOOP UNTIL finished
CLOSE
EXIT SUB
EditShowCursor:
IF ed = 1 THEN
COLOR colors(7, ColorPref), colors(4, ColorPref)
ELSE
COLOR colors(8, ColorPref), colors(9, ColorPref)
END IF
LOCATE CurrRow + 4, Col(CurrCol)
SELECT CASE CurrCol
CASE 1
IF CurrFig#(2) <> 0 THEN
PRINT USING u6$; CurrFig#(2);
ELSE
PRINT SPACE$(vis(2));
END IF
CASE 2
IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN
PRINT LEFT$(CurrString$(1), vis(2));
ELSE
PRINT SPACE$(vis(2))
END IF
CASE 3
IF CurrFig#(3) <> 0 THEN
PRINT " ";
PRINT USING u5$; CurrFig#(3);
PRINT " ";
ELSE
PRINT " ";
END IF
CASE 4
IF CurrFig#(4) <> 0 THEN
PRINT " ";
PRINT USING u5$; CurrFig#(4);
PRINT " ";
ELSE
PRINT " ";
END IF
CASE 5
IF CurrFig#(5) <> 0 THEN
PRINT USING u2$; CurrFig#(5);
ELSE
PRINT " ";
END IF
CASE 6
IF CurrFig#(6) <> 0 THEN
PRINT USING u2$; CurrFig#(6);
ELSE
PRINT " ";
END IF
END SELECT
RETURN
EditEditItem:
CurrRecord = CurrTopline + CurrRow - 1
COLOR colors(7, ColorPref), colors(4, ColorPref)
LOCATE 1, 63: PRINT "Fecha: ";
LOCATE 1, 63: PRINT "Fecha: " + Fecha$;
COLOR colors(8, ColorPref), colors(9, ColorPref)
GraDat = 0: Clasifica = 0
SELECT CASE CurrCol
CASE 1
start$ = kbd$
DO
kbd$ = GetString$(CurrRow + 4, Col(1), start$, new$, vis(1), max(1))
new1# = VAL(new$)
start$ = ""
LOOP WHILE new1# >= 1001# OR new1# < 0
CurrFig#(2) = new1#
reg = 0: b = 1
DO
IF Ca#(b) = CurrFig#(2) THEN
CurrString$(1) = Cb$(b)
CurrFig#(4) = Cc#(b)
CurrFig#(5) = Cd#(b)
CurrFig#(6) = Ce#(b)
Clasifica = 1: Valpu = 1
EXIT DO
END IF
b = b + 1
LOOP WHILE Ca#(b) <> 0 OR b <= TopeRef# + 1
IF Clasifica = 0 THEN
df = 0
FOR Ol = 16 TO 19
FOR Oc = 24 TO 49
df = df + 1
lin$(df) = CHR$(SCREEN(Ol, Oc))
NEXT Oc, Ol
Box 16, 24, 19, 49
IF TopeRef# = 999 THEN
LOCATE 17, 25: PRINT " Lo siento, referencias "
LOCATE 18, 25: PRINT "AGOTADAS, elimine alguna"
ELSE
LOCATE 17, 25: PRINT "Esa Referencia no existe"
LOCATE 18, 25: PRINT "<22> Desea crearla ? (S/N) "
DO
i$ = INKEY$
LOOP WHILE i$ = ""
COLOR colors(7, ColorPref), colors(4, ColorPref)
df = 0
FOR Ol = 16 TO 19
FOR Oc = 24 TO 49
df = df + 1
LOCATE Ol, Oc: PRINT lin$(df)
NEXT Oc, Ol
IF i$ = "s" OR i$ = "S" THEN
Valpu = 0
TopeRef# = TopeRef# + 1
GraDat = 1
GraCurrDat = CurrTopline + CurrRow - 1
ELSEIF i$ = "n" OR i$ = "N" THEN CurrFig#(2) = 0
END IF
END IF
END IF
GOSUB EditPutLine
GOSUB EditGetLine
BalTotal# = BalTotal# - Balance#(CurrRecord)
PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5)
PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6)
Balance#(CurrRecord) = PvpTotal# - PcTotal#
BalTotal# = BalTotal# + Balance#(CurrRecord)
CASE 2
IF Valpu = 0 THEN
kbd$ = GetString$(CurrRow + 4, Col(CurrCol), kbd$, new$, vis(CurrCol), max(CurrCol))
CurrString$(1) = new$
END IF
GOSUB EditPutLine
GOSUB EditGetLine
CASE 3
start$ = kbd$
DO
kbd$ = GetString$(CurrRow + 4, Col(3), start$, new$, vis(3), max(3))
new3# = VAL(new$)
start$ = ""
IF CurrFig#(4) <= 100# AND new3# <= 601# OR new3# <= 0 THEN EXIT DO
IF CurrFig#(4) > 100# AND new3# <= 11 OR new3# <= 0 THEN EXIT DO
LOOP
CurrFig#(3) = new3#
GOSUB EditPutLine
GOSUB EditGetLine
BalTotal# = BalTotal# - Balance#(CurrRecord)
PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5)
PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6)
Balance#(CurrRecord) = PvpTotal# - PcTotal#
BalTotal# = BalTotal# + Balance#(CurrRecord)
CASE 4
IF Valpu = 0 THEN
start$ = kbd$
DO
kbd$ = GetString$(CurrRow + 4, Col(4), start$, new$, vis(4), max(4))
new4# = VAL(new$)
start$ = ""
IF CurrFig#(3) <= 10 AND new4# <= 601 OR new4# <= 0 THEN EXIT DO
IF CurrFig#(3) > 10 AND new4# <= 101 OR new4# <= 0 THEN EXIT DO
LOOP
CurrFig#(4) = new4#
END IF
GOSUB EditPutLine
GOSUB EditGetLine
BalTotal# = BalTotal# - Balance#(CurrRecord)
PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5)
PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6)
Balance#(CurrRecord) = PvpTotal# - PcTotal#
BalTotal# = BalTotal# + Balance#(CurrRecord)
CASE 5
IF Valpu = 0 THEN
start$ = kbd$
old3# = CurrFig#(5)
DO
kbd$ = GetString$(CurrRow + 4, Col(5), start$, new$, vis(5), max(5))
new5# = VAL(new$)
start$ = ""
LOOP WHILE new5# >= 75001# OR new5# < 0
A = CurrRecord
CurrFig#(5) = new5#
END IF
GOSUB EditPutLine
GOSUB EditGetLine
BalTotal# = BalTotal# - Balance#(CurrRecord)
PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5)
PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6)
Balance#(CurrRecord) = PvpTotal# - PcTotal#
BalTotal# = BalTotal# + Balance#(CurrRecord)
CASE 6
IF Valpu = 0 THEN
start$ = kbd$
old4# = CurrFig#(6)
DO
kbd$ = GetString$(CurrRow + 4, Col(6), start$, new$, vis(6), max(6))
new6# = VAL(new$)
start$ = ""
LOOP WHILE new6# >= 75001# OR new6# < 0
A = CurrRecord
CurrFig#(6) = new6#
END IF
GOSUB EditPutLine
GOSUB EditGetLine
BalTotal# = BalTotal# - Balance#(CurrRecord)
PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5)
PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6)
Balance#(CurrRecord) = PvpTotal# - PcTotal#
BalTotal# = BalTotal# + Balance#(CurrRecord)
CASE ELSE
END SELECT
GOSUB EditPrintLine
RETURN
EditMoveUp:
Valpu = 0
IF CurrRow = 1 THEN
IF CurrTopline = 1 THEN
BEEP
ELSE
ScrollDown
CurrTopline = CurrTopline - 1
GOSUB EditGetLine
GOSUB EditPrintLine
END IF
ELSE
CurrRow = CurrRow - 1
GOSUB EditGetLine
END IF
GOSUB PrintBalan
RETURN
EditMoveDown:
Valpu = 0
IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN
BEEP
ELSE
IF CurrRow = 16 THEN
ScrollUp
CurrTopline = CurrTopline + 1
GOSUB EditGetLine
GOSUB EditPrintLine
ELSE
CurrRow = CurrRow + 1
GOSUB EditGetLine
END IF
END IF
GOSUB PrintBalan
RETURN
EditPrintLine:
COLOR colors(7, ColorPref), colors(4, ColorPref)
CurrRecord = CurrTopline + CurrRow - 1
LOCATE CurrRow + 4, 2
IF CurrRecord = MaxRecord + 1 THEN
PRINT u1x$;
ELSEIF CurrRecord > MaxRecord THEN
PRINT u1$;
ELSE
IF CurrFig#(2) <> 0 THEN PRINT USING u6$; CurrFig#(2); ELSE PRINT " ";
IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "<22>" + CurrString$(1); ELSE PRINT "<22> ";
IF CurrFig#(3) <> 0 THEN PRINT "<22> "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT "<22> ";
IF CurrFig#(4) <> 0 THEN PRINT "<22> "; : PRINT USING u5$; CurrFig#(4); : PRINT " "; ELSE PRINT "<22> ";
IF CurrFig#(5) <> 0 THEN PRINT "<22>"; : PRINT USING u2$; CurrFig#(5); ELSE PRINT "<22> ";
IF CurrFig#(6) <> 0 THEN PRINT "<22>"; : PRINT USING u2$; CurrFig#(6); ELSE PRINT "<22> ";
PRINT "<22>";
PRINT USING u3$; Balance#(CurrRecord);
IF bajabar <> 1 THEN GOSUB EditPrintBalances
END IF
RETURN
EditPrintBalances:
COLOR colors(7, ColorPref), colors(4, ColorPref)
FOR A = 1 TO 16
CurrRecord = CurrTopline + A - 1
IF CurrRecord <= MaxRecord THEN
LOCATE 4 + A, 66
PRINT USING u3$; Balance#(CurrTopline + A - 1);
END IF
NEXT A
PrintBalan:
IF bajabarra <> 1 THEN
COLOR colors(7, ColorPref), colors(4, ColorPref)
PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5)
PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6)
LOCATE 21, 1: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
Box 22, 1, 24, 80
LOCATE 23, 2: PRINT CurrString$(1)
LOCATE 23, 25: PRINT "<22>";
LOCATE 23, 26: PRINT USING u9$; PvpTotal#;
PRINT "<22>";
PRINT USING u9$; PcTotal#;
PRINT "<22>";
PRINT USING u9$; BalTotal#;
END IF
RETURN
EditDeleteRecord:
bajabar = 1
IF MaxRecord = 1 THEN
BEEP
ELSE
CurrRecord = CurrTopline + CurrRow - 1
MaxRecord = MaxRecord - 1
A = CurrRecord
BalTotal# = BalTotal# - Balance#(CurrRecord)
WHILE A <= MaxRecord
GET #1, A + 2
PUT #1, A + 1
Balance#(A) = Balance#(A + 1)
A = A + 1
WEND
Balance#(MaxRecord + 1) = 0
LSET valid$ = "SI"
LSET IoMaxRecord$ = Cvit$(MaxRecord)
PUT #1, 1
GOSUB EditPrintWholeScreen
CurrRecord = CurrTopline + CurrRow - 1
IF CurrRecord > MaxRecord THEN
GOSUB EditMoveUp
END IF
bajabar = 0
GOSUB EditGetLine
END IF
RETURN
EditAddRecord:
bajabar = 1
CurrRecord = CurrTopline + CurrRow - 1
A = MaxRecord
tb = 0
WHILE A > CurrRecord
GET #1, A + 1
PUT #1, A + 2
Balance#(A + 1) = Balance#(A)
A = A - 1
WEND
Balance#(CurrRecord + 1) = 0
MaxRecord = MaxRecord + 1
LSET IoRef$ = STR$(0)
LSET IoDesc$ = ""
LSET IoUnd$ = STR$(0)
LSET IoCC$ = STR$(0)
LSET IoPvp$ = STR$(0)
LSET IoPc$ = STR$(0)
PUT #1, CurrRecord + 2
LSET valid$ = "SI"
LSET IoMaxRecord$ = Cvit$(MaxRecord)
PUT #1, 1
GOSUB EditPrintWholeScreen
GOSUB EditGetLine
RETURN
EditPrintWholeScreen:
temp = CurrRow
FOR CurrRow = 1 TO 16
CurrRecord = CurrTopline + CurrRow - 1
IF CurrRecord <= MaxRecord THEN
GOSUB EditGetLine
END IF
GOSUB EditPrintLine
NEXT CurrRow
CurrRow = temp
RETURN
EditPutLine:
CurrRecord = CurrTopline + CurrRow - 1
LSET IoDia$ = CurrDia$
LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2))))
LSET IoDesc$ = CurrString$(1)
LSET IoUnd$ = LTRIM$(RTRIM$(STR$(CurrFig#(3))))
LSET IoCC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4))))
LSET IoPvp$ = LTRIM$(RTRIM$(STR$(CurrFig#(5))))
LSET IoPc$ = LTRIM$(RTRIM$(STR$(CurrFig#(6))))
PUT #1, CurrRecord + 1
IF GraCurrDat = CurrRecord THEN
file2$ = "Ref#." + Cvit$(e%)
OPEN file2$ FOR RANDOM AS #2 LEN = 54
FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$
FIELD #2, 2 AS vld$, 5 AS IMxRcrd$
LSET IRf$ = LTRIM$(RTRIM$(STR$(CurrFig#(2))))
LSET IDsc$ = CurrString$(1)
LSET ICC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4))))
LSET IPVP$ = LTRIM$(RTRIM$(STR$(CurrFig#(5))))
LSET IPC$ = LTRIM$(RTRIM$(STR$(CurrFig#(6))))
PUT #2, TopeRef#
LSET vld$ = "SI"
LSET IMxRcrd$ = LTRIM$(RTRIM$(STR$(TopeRef#)))
PUT #2, 1
TopeRef# = VAL(IMxRcrd$)
Ca#(TopeRef#) = CurrFig#(2)
Cb$(TopeRef#) = CurrString$(1)
Cc#(TopeRef#) = CurrFig#(4)
Cd#(TopeRef#) = CurrFig#(5)
Ce#(TopeRef#) = CurrFig#(6)
CLOSE #2
END IF
RETURN
EditGetLine:
CurrRecord = CurrTopline + CurrRow - 1
GET #1, CurrRecord + 1
dia$ = IoDia$
CurrFig#(2) = VAL(IoRef$)
CurrString$(1) = IoDesc$
CurrFig#(3) = VAL(IoUnd$)
CurrFig#(4) = VAL(IoCC$)
CurrFig#(5) = VAL(IoPvp$)
CurrFig#(6) = VAL(IoPc$)
compufech$ = mes$ + "-" + dia$ + "-" + an$
LOCATE 1, 63: PRINT "Fecha: ";
LOCATE 1, 63: PRINT "Fecha: " + compufech$;
RETURN
CargaReferencias:
CLS
Box 14, 28, 17, 51
center 15, "Cargando referencias"
center 16, "Por favor, espere..."
file2$ = "Ref#." + Cvit$(e%)
OPEN file2$ FOR RANDOM AS #2 LEN = 54
FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$
FIELD #2, 2 AS vld$, 5 AS IMxRcrd$
GET #2, 1
IF vld$ <> "SI" THEN
LSET IRf$ = STR$(0)
LSET IDsc$ = ""
LSET ICC$ = STR$(0)
LSET IPVP$ = STR$(0)
LSET IPC$ = STR$(0)
PUT #2, 2
LSET vld$ = "SI"
LSET IMxRcrd$ = "1"
PUT #2, 1
END IF
TopeRef# = VAL(IMxRcrd$)
b = 1
WHILE b <= TopeRef#
GET #2, b + 1
Ca#(b) = VAL(IRf$)
Cb$(b) = IDsc$
Cc#(b) = VAL(ICC$)
Cd#(b) = VAL(IPVP$)
Ce#(b) = VAL(IPC$)
b = b + 1
WEND
CLOSE #2
RETURN
END SUB
'Trin$:
' Remove null and spaces from the end of a string.
FUNCTION Trim$ (x$)
IF x$ = "" THEN
Trim$ = ""
ELSE
lastChar = 0
FOR A = 1 TO LEN(x$)
y$ = MID$(x$, A, 1)
IF y$ <> CHR$(0) AND y$ <> " " THEN
lastChar = A
END IF
NEXT A
Trim$ = LEFT$(x$, lastChar)
END IF
END FUNCTION
SUB Vende (r%)
'Information about each column
REDIM help$(4), Col(4), vis(4), max(4), Title$(9), Desc$(9), Ca$(9), AType$(9)
'Draw the screen
COLOR colors(7, ColorPref), colors(4, ColorPref)
OPEN "Vendedor" + Cvit$(item) FOR RANDOM AS #1 LEN = 76
FIELD #1, 20 AS T$, 50 AS D$, 3 AS C$, 1 AS A$
FIELD #1, 2 AS valid$
IF valid$ <> "*" THEN
valid$ = "*"
PUT #1, 1
FOR A = 1 TO 9
LSET T$ = ""
LSET D$ = ""
LSET C$ = ""
LSET A$ = ""
PUT #1, A + 1
NEXT A
END IF
FOR A = 1 TO 9
GET #1, A + 1
Title$(A) = T$
Desc$(A) = D$
Ca$(A) = C$
AType$(A) = A$
NEXT A
CLOSE
Box 2, 1, 14, 80
Box 15, 1, 18, 80
COLOR colors(5, ColorPref), colors(4, ColorPref)
LOCATE 1, 1: PRINT SPACE$(80)
LOCATE 1, 4: PRINT "Editor de Vendedores, Empresa: " + Trim$(Account(r%).Title);
COLOR colors(7, ColorPref), colors(4, ColorPref)
LOCATE 3, 2: PRINT "No<4E> Vendedor/a <20> Otros Datos <20> C.A <20>N.A"
LOCATE 4, 2: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
u$ = "##<23>\ \<5C>\ \<5C>\ \<5C> ! "
FOR A = 5 TO 13
LOCATE A, 2
x = A - 4
PRINT USING u$; x; Title$(x); Desc$(x); Ca$(x); AType$(x);
NEXT A
'Initialize variables
help$(1) = " Nombre del Vendedor/a "
help$(2) = " Direcci<63>n, n<> Telefono, etc... "
help$(3) = " Codigo Personal de Acceso al Sistema "
help$(4) = " Acceso al Sistema ( Nivel 1 a 5 ) "
Col(1) = 5: Col(2) = 26: Col(3) = 72: Col(4) = 78
vis(1) = 20: vis(2) = 50: vis(3) = 4: vis(4) = 1
max(1) = 20: max(2) = 50: max(3) = 3: max(4) = 1
finished = false
CurrRow = 1
CurrCol = 1
PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <Esc=Anula>"
'Loop until F2 or <ESC> is pressed
DO
GOSUB EditAccountsShowCursor 'Show Cursor
DO 'Wait for key
kbd$ = INKEY$
LOOP UNTIL kbd$ <> ""
IF kbd$ >= " " AND kbd$ < "~" THEN 'If legal, edit item
COLOR colors(8, ColorPref), colors(9, ColorPref)
ok = false
start$ = kbd$
DO
kbd$ = GetString$(CurrRow + 4, Col(CurrCol), start$, end$, vis(CurrCol), max(CurrCol))
SELECT CASE CurrCol
CASE 1: Title$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol))
CASE 2: Desc$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol))
CASE 3: Ca$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol))
CASE 4: AType$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol))
CASE ELSE
END SELECT
start$ = ""
IF CurrCol = 4 THEN
x$ = UCASE$(end$)
IF VAL(x$) >= 1 OR VAL(x$) <= 5 THEN
ok = true
ELSE
BEEP
END IF
ELSE
ok = true
END IF
LOOP UNTIL ok
END IF
hide = 1: GOSUB EditAccountsShowCursor: hide = 0 'Hide Cursor so it can move
'If it needs to
SELECT CASE kbd$
CASE CHR$(0) + "H" 'Up Arrow
CurrRow = (CurrRow + 17) MOD 9 + 1
CASE CHR$(0) + "P" 'Down Arrow
CurrRow = (CurrRow) MOD 9 + 1
CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab
CurrCol = (CurrCol + 1) MOD 4 + 1
PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <Esc=Anula>"
CASE CHR$(0) + "M", CHR$(9) 'Right or Tab
CurrCol = (CurrCol) MOD 4 + 1
PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <Esc=Anula>"
CASE CHR$(0) + "<" 'F2
finished = true
Save = true
CASE CHR$(27) 'Esc
finished = true
Save = false
CASE CHR$(13) 'Return
CASE ELSE
BEEP
END SELECT
LOOP UNTIL finished
IF Save THEN
OPEN "Vendedor" + Cvit$(item) FOR RANDOM AS #1 LEN = 76
FIELD #1, 20 AS T$, 50 AS D$, 3 AS C$, 1 AS A$
FIELD #1, 2 AS valid$
FOR A = 1 TO 9
LSET T$ = Title$(A)
LSET D$ = Desc$(A)
LSET C$ = Ca$(A)
LSET A$ = AType$(A)
PUT #1, A + 1
NEXT A
CLOSE
END IF
EXIT SUB
EditAccountsShowCursor:
IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref)
LOCATE CurrRow + 4, Col(CurrCol)
SELECT CASE CurrCol
CASE 1: PRINT LEFT$(Title$(CurrRow), vis(CurrCol));
CASE 2: PRINT LEFT$(Desc$(CurrRow), vis(CurrCol));
CASE 3: PRINT LEFT$(Ca$(CurrRow), vis(CurrCol));
CASE 4: PRINT LEFT$(AType$(CurrRow), vis(CurrCol));
CASE ELSE
END SELECT
RETURN
END SUB