1930 lines
53 KiB
QBasic
1930 lines
53 KiB
QBasic
'
|
||
' 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 T.P.V."
|
||
help$(2) = "Ayuda en los men<65>s"
|
||
help$(3) = "Modo de grabar los Datos"
|
||
help$(4) = "Creditos del Terminal Punto de Venta"
|
||
|
||
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), Title$(9)
|
||
|
||
|
||
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) = "Unidades "
|
||
|
||
Col(1) = 2: vis(1) = 4: max(1) = 1
|
||
Col(2) = 9: vis(2) = 6: max(2) = 6
|
||
Col(3) = 43: vis(3) = 5: max(3) = 2
|
||
|
||
'Open random access file
|
||
|
||
OPEN "Vendedor" + Cvit$(e%) FOR RANDOM AS #1 LEN = 69
|
||
|
||
FIELD #1, 20 AS T$, 43 AS D$, 3 AS C$, 1 AS A$
|
||
FIELD #1, 2 AS valid$
|
||
|
||
FOR tAt = 1 TO 9
|
||
GET #1, tAt + 1
|
||
Title$(tAt) = T$
|
||
NEXT tAt
|
||
CLOSE
|
||
|
||
|
||
file$ = "T-" + dia$ + mes$ + "." + Cvit$(e)
|
||
|
||
OPEN file$ FOR RANDOM AS #1 LEN = 19
|
||
|
||
FIELD #1, 2 AS IoDia$, 1 AS IoVen$, 6 AS IoRef$, 3 AS IoUnd$
|
||
FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$
|
||
|
||
'Initialize variables
|
||
CurrFig#(1) = 0
|
||
CurrFig#(2) = 0
|
||
CurrFig#(3) = 0
|
||
|
||
GET #1, 1
|
||
IF valid$ <> "SI" THEN
|
||
LSET IoDia$ = ""
|
||
LSET IoVen$ = STR$(0)
|
||
LSET IoRef$ = STR$(0)
|
||
LSET IoUnd$ = STR$(0)
|
||
PUT #1, 2
|
||
LSET valid$ = "SI"
|
||
LSET IoMaxRecord$ = "1"
|
||
PUT #1, 1
|
||
END IF
|
||
|
||
RecordMin = VAL(IoMaxRecord$)
|
||
MaxRecord = 1
|
||
'MaxRecord = VAL(IoMaxRecord$)
|
||
|
||
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);
|
||
|
||
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
|
||
vex = 1
|
||
|
||
'GOSUB EditPrintWholeScreen
|
||
CurrRow = 1
|
||
vex = 0
|
||
temp = CurrRow
|
||
FOR CurrRow = 1 TO 16
|
||
CurrRecord = CurrTopline + CurrRow - 1
|
||
GOSUB EditPrintLine
|
||
NEXT CurrRow
|
||
CurrRow = temp
|
||
bajabarra = 0
|
||
CurrRow = 1
|
||
CurrCol = 1
|
||
|
||
CurrRecord = CurrTopline + CurrRow - 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 - 1
|
||
IF CurrCol <= 0 THEN CurrCol = 3
|
||
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 3 + 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) + 1
|
||
|
||
SELECT CASE CurrCol
|
||
CASE 1
|
||
IF CurrFig#(1) <> 0 THEN PRINT " "; CurrFig#(1); ELSE PRINT " ";
|
||
CASE 2
|
||
IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING "###"; CurrFig#(2); : PRINT " " ELSE PRINT " ";
|
||
CASE 3
|
||
IF CurrFig#(3) <> 0 THEN PRINT " "; : PRINT USING "##"; CurrFig#(3); : PRINT " "; ELSE PRINT " ";
|
||
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
|
||
DO
|
||
kbd$ = GetString$(CurrRow + 4, Col(CurrCol) + 1, kbd$, new$, vis(CurrCol), max(CurrCol))
|
||
LOOP WHILE VAL(new$) > 9 OR VAL(new$) < 1
|
||
|
||
CurrFig#(1) = VAL(new$)
|
||
IF RTRIM$(LTRIM$(Title$(CurrFig#(1)))) = "" 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
|
||
LOCATE 17, 25: PRINT "Ese Vendedor no existe"
|
||
LOCATE 18, 27: PRINT "Verifique el n<>mero"
|
||
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
|
||
CurrFig#(1) = 1
|
||
ELSE
|
||
LOCATE 1, 35: PRINT "Vendedor: " + Trim$(Title$(CurrFig#(1)));
|
||
END IF
|
||
|
||
GOSUB EditPutLine
|
||
GOSUB EditGetLine
|
||
|
||
CASE 2
|
||
|
||
start$ = kbd$
|
||
DO
|
||
kbd$ = GetString$(CurrRow + 4, Col(2) + 1, start$, new$, vis(2), max(2))
|
||
new2# = VAL(new$)
|
||
start$ = ""
|
||
LOOP WHILE new2# >= 1001# OR new2# < 0
|
||
CurrFig#(2) = new2#
|
||
|
||
reg = 0: b = 1
|
||
DO
|
||
IF Ca#(b) = CurrFig#(2) THEN
|
||
CurrString$(1) = Cb$(b)
|
||
CurrFig#(4) = Cd#(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
|
||
LOCATE 17, 25: PRINT "Esa Referencia no existe"
|
||
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
|
||
CurrFig#(2) = 0
|
||
END IF
|
||
|
||
BalTotal# = BalTotal# - Balance#(CurrRecord)
|
||
Balance#(CurrRecord) = CurrFig#(3) * CurrFig#(4)
|
||
BalTotal# = BalTotal# + Balance#(CurrRecord)
|
||
|
||
GOSUB EditPutLine
|
||
GOSUB EditGetLine
|
||
|
||
CASE 3
|
||
|
||
start$ = kbd$
|
||
DO
|
||
kbd$ = GetString$(CurrRow + 4, Col(3) + 1, start$, new$, vis(3), max(3))
|
||
new3# = VAL(new$)
|
||
start$ = ""
|
||
CurrFig#(3) = new3#
|
||
|
||
LOOP WHILE CurrFig#(3) < 1 OR CurrFig#(3) > 99
|
||
|
||
BalTotal# = BalTotal# - Balance#(CurrRecord)
|
||
Balance#(CurrRecord) = CurrFig#(3) * CurrFig#(4)
|
||
BalTotal# = BalTotal# + Balance#(CurrRecord)
|
||
|
||
GOSUB EditPutLine
|
||
GOSUB EditGetLine
|
||
|
||
IF der <> CurrRecord THEN
|
||
ed = 1: GOSUB EditShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1
|
||
GOSUB EditAddRecord
|
||
END IF
|
||
|
||
der = CurrRecord
|
||
|
||
CASE ELSE
|
||
END SELECT
|
||
|
||
GOSUB EditPrintLine
|
||
|
||
RETURN
|
||
|
||
EditMoveUp:
|
||
Valpu = 0
|
||
'Si La linea actual es igual a la linea minima es decir la ultima entrada.
|
||
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#(1) <> 0 THEN PRINT " "; CurrFig#(1); ELSE PRINT " ";
|
||
|
||
IF CurrFig#(2) <> 0 THEN PRINT "<22> "; : PRINT USING "###"; CurrFig#(2); : PRINT " "; ELSE PRINT "<22> ";
|
||
|
||
IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "<22> " + CurrString$(1) + " "; ELSE PRINT "<22> ";
|
||
|
||
IF CurrFig#(3) <> 0 THEN PRINT "<22> "; : PRINT USING "##"; CurrFig#(3); : PRINT " "; ELSE PRINT "<22> ";
|
||
|
||
IF CurrFig#(4) <> 0 THEN PRINT "<22> "; : PRINT USING u2$; CurrFig#(4); : PRINT " <20>"; ELSE PRINT "<22> <20>";
|
||
|
||
IF Balance#(CurrRecord) <> 0 THEN PRINT USING u3$; Balance#(CurrRecord); ELSE PRINT " "
|
||
|
||
IF bajabar <> 1 THEN GOSUB EditPrintBalances
|
||
|
||
|
||
END IF
|
||
|
||
RETURN
|
||
|
||
EditPrintBalances:
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
FOR tAt = 1 TO 16
|
||
CurrRecord = CurrTopline + tAt - 1
|
||
IF CurrRecord <= MaxRecord THEN
|
||
LOCATE 4 + tAt, 67
|
||
PRINT USING u3$; Balance#(CurrTopline + tAt - 1);
|
||
END IF
|
||
NEXT tAt
|
||
CurrRecord = CurrTopline + CurrRow - 1
|
||
|
||
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 = RecordMin THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRecord = CurrTopline + CurrRow - 1
|
||
MaxRecord = MaxRecord - 1
|
||
A = CurrRecord
|
||
BalTotal# = BalTotal# - Balance#(CurrRecord)
|
||
WHILE A <= MaxRecord
|
||
GET #1, A + 2 + RecordMin
|
||
PUT #1, A + 1 + RecordMin
|
||
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 + RecordMin
|
||
PUT #1, A + 2 + RecordMin
|
||
|
||
Balance#(A + 1) = Balance#(A)
|
||
|
||
A = A - 1
|
||
|
||
WEND
|
||
|
||
|
||
Balance#(CurrRecord + 1) = 0
|
||
|
||
MaxRecord = MaxRecord + 1
|
||
LSET IoVen$ = STR$(0)
|
||
LSET IoRef$ = STR$(0)
|
||
LSET IoUnd$ = STR$(0)
|
||
CurrString$(1) = "": CurrFig#(4) = 0
|
||
|
||
PUT #1, CurrRecord + 2 + RecordMin
|
||
|
||
LSET valid$ = "SI"
|
||
LSET IoMaxRecord$ = Cvit$(MaxRecord)
|
||
PUT #1, 1
|
||
GOSUB EditPrintWholeScreen
|
||
|
||
GOSUB EditGetLine
|
||
RETURN
|
||
|
||
EditPrintWholeScreen:
|
||
vex = 0
|
||
|
||
temp = CurrRow
|
||
FOR CurrRow = 1 TO 16
|
||
CurrRecord = CurrTopline + CurrRow - 1
|
||
|
||
IF MaxRecord <> RecordMin OR vex = 0 THEN
|
||
IF CurrRecord <= MaxRecord THEN
|
||
GOSUB EditGetLine
|
||
END IF
|
||
END IF
|
||
GOSUB EditPrintLine
|
||
NEXT CurrRow
|
||
CurrRow = temp
|
||
RETURN
|
||
|
||
|
||
EditPutLine:
|
||
Graba = CurrRecord + RecordMin
|
||
CurrRecord = CurrTopline + CurrRow - 1
|
||
LSET IoDia$ = CurrDia$
|
||
LSET IoVen$ = LTRIM$(RTRIM$(STR$(CurrFig#(1))))
|
||
LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2))))
|
||
LSET IoUnd$ = LTRIM$(RTRIM$(STR$(CurrFig#(3))))
|
||
PUT #1, CurrRecord + RecordMin
|
||
RETURN
|
||
|
||
|
||
EditGetLine:
|
||
Graba = CurrRecord + RecordMin
|
||
CurrRecord = CurrTopline + CurrRow - 1
|
||
GET #1, CurrRecord + RecordMin
|
||
dia$ = IoDia$
|
||
CurrFig#(1) = VAL(IoVen$)
|
||
CurrFig#(2) = VAL(IoRef$)
|
||
CurrFig#(3) = VAL(IoUnd$)
|
||
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%)
|
||
Save = 0
|
||
|
||
'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$(r%) FOR RANDOM AS #1 LEN = 69
|
||
|
||
FIELD #1, 20 AS T$, 43 AS D$, 3 AS C$, 1 AS A$
|
||
FIELD #1, 2 AS valid$
|
||
|
||
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) = 43: vis(3) = 3: vis(4) = 1
|
||
max(1) = 20: max(2) = 43: 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 - 1
|
||
IF CurrRow <= 0 THEN CurrRow = 9
|
||
|
||
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 + 4) MOD 3 + 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 = 1
|
||
CASE CHR$(27) 'Esc
|
||
finished = true
|
||
Save = false
|
||
CASE CHR$(13) 'Return
|
||
CASE ELSE
|
||
BEEP
|
||
END SELECT
|
||
LOOP UNTIL finished
|
||
|
||
IF Save = 1 THEN
|
||
|
||
OPEN "Vendedor" + Cvit$(r%) FOR RANDOM AS #1 LEN = 69
|
||
FIELD #1, 20 AS T$, 43 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 Title$(CurrRow)
|
||
CASE 2: PRINT Desc$(CurrRow)
|
||
CASE 3: PRINT Ca$(CurrRow)
|
||
CASE 4: PRINT AType$(CurrRow)
|
||
CASE ELSE
|
||
END SELECT
|
||
|
||
RETURN
|
||
|
||
END SUB
|
||
|