C/bas
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
474d98379e
bas/NEW/JD1.BAS
jdg 474d98379e First commit ~0,10
2021-09-03 17:42:07 +02:00

3920 lines
113 KiB
QBasic
Raw Blame History

DECLARE SUB Vende (r%)
DECLARE SUB Elif ()
DECLARE SUB Staul ()
DECLARE SUB Ticket (e%)
DECLARE SUB Stock (EE%)
DECLARE SUB Balan (EEE%)
'
' 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 Proveedores (lug%)
DECLARE SUB LCenter (text$)
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 EditTrans (item%)
DECLARE SUB Referencias (op%)
DECLARE SUB ImpRef (po%)
DECLARE SUB ImpComp (so%)
DECLARE FUNCTION Cvdt$ (x#)
DECLARE FUNCTION Cvst$ (x!)
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 ColorPref 'Color Preference
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 printerr AS INTEGER 'Printer error flag
DIM SHARED Fecha$(1), fech$(1)
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
'Cvdt$:
' Convert a double precision number to a string WITHOUT a leading space.
FUNCTION Cvdt$ (x#)
Cvdt$ = RIGHT$(STR$(x#), LEN(STR$(x#)) - 1)
END FUNCTION
'Cvit$:
' Convert an integer to a string WITHOUT a leading space.
FUNCTION Cvit$ (x)
Cvit$ = RIGHT$(STR$(x), LEN(STR$(x)) - 1)
END FUNCTION
'Cvst$:
' Convert a single precision number to a string WITHOUT a leading space
FUNCTION Cvst$ (x!)
Cvst$ = RIGHT$(STR$(x!), LEN(STR$(x!)) - 1)
END FUNCTION
'EditTrans:
' This is the full-screen editor which allows you to enter and change
' transactions
SUB EditTrans (item%)
'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 realizar la transacci<63>n"
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$
'Open random access file
file$ = "E-" + mes$ + an$ + "." + Cvit$(item)
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 CargaCienReferencias
help$(1) = "Referencia del Producto "
help$(2) = "Producto (sin Referencia o nuevo) "
help$(3) = "Unidades totales "
help$(4) = "Unidades parciales, ( o por caja ) "
help$(5) = "P.V.P. del Producto, ( por unidad )"
help$(6) = "Precio de Costo, ( la unidad ) "
Col(1) = 2: vis(1) = 6: max(1) = 6
Col(2) = 9: vis(2) = 22: max(2) = 22
Col(3) = 32: vis(3) = 5: max(3) = 3
Col(4) = 38: vis(4) = 5: max(4) = 3
Col(5) = 44: vis(5) = 10: max(5) = 8
Col(6) = 55: vis(6) = 10: max(6) = 8
'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(item).Title);
'LOCATE 1, 63: PRINT "Fecha: ";
'LOCATE 1, 63: PRINT "Fecha: " + Fecha$;
COLOR colors(7, ColorPref), colors(4, ColorPref)
LOCATE 3, 2: PRINT " Ref# <20> Concepto <20> Und <20>Und/C<> P.V.P. <20> P.C. <20> Beneficios "
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> <20> "
u1x$ = "<22><><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><EFBFBD><EFBFBD>"
u2$ = "##,###,###"
u3$ = "##,###,###,###"
u5$ = "###"
u6$ = "######"
u9$ = "#,###,###,###,###"
CurrTopline = 1: bajabarra = 1
GOSUB EditTransPrintWholeScreen
bajabarra = 0
CurrRow = 1
CurrCol = 1
PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <F9=Insert> <F10=Supr>"
GOSUB EditTransGetLine
finished = false
GOSUB EditTransPrintBalances
'Loop until <F2> is pressed
DO
GOSUB EditTransShowCursor 'Show Cursor, Wait for key
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
ed = 1: GOSUB EditTransShowCursor: 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 EditTransEditItem
END IF
SELECT CASE kbd$ 'Handle Special keys
CASE CHR$(0) + "H" 'up arrow
GOSUB EditTransMoveUp
CASE CHR$(0) + "P" 'Down arrow
GOSUB EditTransMoveDown
CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab
CurrCol = (CurrCol + 4) MOD 6 + 1
PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <F9=Insert> <F10=Supr>"
CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab
CurrCol = (CurrCol) MOD 6 + 1
PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <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 EditTransPrintWholeScreen
GOSUB EditTransGetLine
bajabarra = 0
GOSUB PrintBalances
CASE CHR$(0) + "Q" 'Page Down
CurrRow = 1
CurrTopline = CurrTopline + 16
IF CurrTopline > MaxRecord THEN
CurrTopline = MaxRecord
END IF
bajabarra = 1
GOSUB EditTransPrintWholeScreen
GOSUB EditTransGetLine
bajabarra = 0
GOSUB PrintBalances
CASE CHR$(0) + "<" 'F2
finished = true
CASE CHR$(0) + "C" 'F9
GOSUB EditTransAddRecord
CASE CHR$(0) + "D" 'F10
GOSUB EditTransDeleteRecord
CASE CHR$(13) 'Enter
CASE ELSE
BEEP
END SELECT
LOOP UNTIL finished
CLOSE
EXIT SUB
EditTransShowCursor:
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 " ";
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
EditTransEditItem:
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 EditTransPutLine
GOSUB EditTransGetLine
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 EditTransPutLine
GOSUB EditTransGetLine
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 EditTransPutLine
GOSUB EditTransGetLine
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 EditTransPutLine
GOSUB EditTransGetLine
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 EditTransPutLine
GOSUB EditTransGetLine
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 EditTransPutLine
GOSUB EditTransGetLine
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 EditTransPrintLine
RETURN
EditTransMoveUp:
Valpu = 0
IF CurrRow = 1 THEN
IF CurrTopline = 1 THEN
BEEP
ELSE
ScrollDown
CurrTopline = CurrTopline - 1
GOSUB EditTransGetLine
GOSUB EditTransPrintLine
END IF
ELSE
CurrRow = CurrRow - 1
GOSUB EditTransGetLine
END IF
GOSUB PrintBalances
RETURN
EditTransMoveDown:
Valpu = 0
IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN
BEEP
ELSE
IF CurrRow = 16 THEN
ScrollUp
CurrTopline = CurrTopline + 1
GOSUB EditTransGetLine
GOSUB EditTransPrintLine
ELSE
CurrRow = CurrRow + 1
GOSUB EditTransGetLine
END IF
END IF
GOSUB PrintBalances
RETURN
EditTransPrintLine:
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 EditTransPrintBalances
END IF
RETURN
EditTransPrintBalances:
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
PrintBalances:
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
EditTransDeleteRecord:
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 EditTransPrintWholeScreen
CurrRecord = CurrTopline + CurrRow - 1
IF CurrRecord > MaxRecord THEN
GOSUB EditTransMoveUp
END IF
bajabar = 0
GOSUB EditTransGetLine
END IF
RETURN
EditTransAddRecord:
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 EditTransPrintWholeScreen
GOSUB EditTransGetLine
RETURN
EditTransPrintWholeScreen:
temp = CurrRow
FOR CurrRow = 1 TO 16
CurrRecord = CurrTopline + CurrRow - 1
IF CurrRecord <= MaxRecord THEN
GOSUB EditTransGetLine
END IF
GOSUB EditTransPrintLine
NEXT CurrRow
CurrRow = temp
RETURN
EditTransPutLine:
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$(item%)
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
EditTransGetLine:
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
CargaCienReferencias:
CLS
box 14, 28, 17, 51
LOCATE 15, 30: PRINT "Cargando referencias"
LOCATE 16, 30: PRINT "Por favor, espere..."
file2$ = "Ref#." + Cvit$(item%)
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
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
'LCenter:
' Center TEXT$ on the line printer
SUB LCenter (text$)
LPRINT TAB(41 - LEN(text$) / 2); text$
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 Administrador"
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 Administrador"
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
Proveedores (Subchoice)
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)
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
IF vaw = 2 THEN Referencias (Subchoice)
IF vaw = 1 THEN EditTrans (Subchoice)
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, "P E R S O N A L F I N A N C I A L"
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
SUB Proveedores (lug%)
DIM Row(12), Col(12), vis(12), max(12), help$(12), CurrString$(12), she$(4)
Row(1) = 4: Col(1) = 11: vis(1) = 40: max(1) = 40
Row(2) = 6: Col(2) = 14: vis(2) = 32: max(2) = 32
Row(3) = 6: Col(3) = 62: vis(3) = 10: max(3) = 10
Row(4) = 8: Col(4) = 14: vis(4) = 32: max(4) = 32
Row(5) = 8: Col(5) = 59: vis(5) = 19: max(5) = 19
Row(6) = 10: Col(6) = 14: vis(6) = 16: max(6) = 16
Row(7) = 10: Col(7) = 58: vis(7) = 19: max(7) = 19
Row(8) = 15: Col(8) = 21: vis(8) = 50: max(8) = 50
Row(9) = 17: Col(9) = 13: vis(9) = 58: max(9) = 58
Row(10) = 19: Col(10) = 21: vis(10) = 50: max(10) = 50
Row(11) = 21: Col(11) = 14: vis(11) = 32: max(11) = 32
Row(12) = 21: Col(12) = 59: vis(12) = 16: max(12) = 16
help$(1) = "Nombre de la entidad Proveedora "
help$(2) = "Direcci<63>n "
help$(3) = "Codigo Postal "
help$(4) = "Localidad "
help$(5) = "Provincia "
help$(6) = "Tel<65>fono "
help$(7) = "C.I.F. "
help$(8) = "Entidad Bancaria "
help$(9) = "Material que Provee "
help$(10) = "Jefe de Ventas "
help$(11) = "Direcci<63>n del Jefe V. "
help$(12) = "Tel<65>fono del Jefe de V. "
ON lug GOTO ip, mp, sp, bp, impr
ip:
COLOR colors(7, ColorPref), colors(4, ColorPref): PRINT "SD"
entrada = 0: jk = 0
nom$ = "": ape$ = "": Cal$ = "": num$ = "": Pis$ = "": lettt$ = "": tel$ = ""
GOSUB menu2
OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56
FOR x = 1 TO LOF(1) / 56
jk = jk + 1
FIELD #1, 40 AS nom$, 16 AS tel$
GET #1, x
IF RTRIM$(LTRIM$(nom$)) = "" THEN entrada = jk: GOTO ent
NEXT x
entrada = jk + 1
ent:
CLOSE #1
IF entrada = 0 THEN entrada = 1
LOCATE 2, 47: PRINT entrada
pieza = 0
empi:
IF pieza = 3 THEN PrintHelpLine help$(1) + " | <F2=Buscar> <F10=Salir>"
IF pieza = 0 THEN PrintHelpLine help$(1) + "| <F2=Guardar y Salir> <F10=Salir sin Grabar>"
a = 1
DO
GOSUB showline
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
ed = 1: GOSUB showline: ed = 0
IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item
kbd$ = GetString$(Row(a), Col(a), kbd$, new$, vis(a), max(a))
CurrString$(a) = new$
END IF
SELECT CASE kbd$ 'Handle Special keys
CASE CHR$(0) + "H" 'up arrow
IF pieza = 3 AND a = 1 THEN a = 4 ELSE IF pieza = 3 THEN a = a - 1
IF pieza = 0 AND a = 1 THEN a = 12 ELSE IF pieza = 0 THEN a = a - 1
IF pieza = 3 THEN PrintHelpLine help$(a) + " | <F2=Buscar> <F10=Salir>"
IF pieza = 0 THEN PrintHelpLine help$(a) + "| <F2=Guardar y Salir> <F10=Salir sin Grabar>"
CASE CHR$(0) + "P" 'Down arrow
IF pieza = 3 AND a = 4 THEN a = 1 ELSE IF pieza = 3 THEN a = a + 1
IF pieza = 0 AND a = 12 THEN a = 1 ELSE IF pieza = 0 THEN a = a + 1
IF pieza = 3 THEN PrintHelpLine help$(a) + " | <F2=Buscar> <F10=Salir>"
IF pieza = 0 THEN PrintHelpLine help$(a) + "| <F2=Guardar y Salir> <F10=Salir sin Grabar>"
CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab
IF pieza = 3 AND a = 1 THEN a = 4 ELSE IF pieza = 3 THEN a = a - 1
IF pieza = 0 AND a = 1 THEN a = 12 ELSE IF pieza = 0 THEN a = a - 1
IF pieza = 3 THEN PrintHelpLine help$(a) + " | <F2=Buscar> <F10=Salir>"
IF pieza = 0 THEN PrintHelpLine help$(a) + "| <F2=Guardar y Salir> <F10=Salir sin Grabar>"
CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab
IF pieza = 3 AND a = 4 THEN a = 1 ELSE IF pieza = 3 THEN a = a + 1
IF pieza = 0 AND a = 12 THEN a = 1 ELSE IF pieza = 0 THEN a = a + 1
IF pieza = 3 THEN PrintHelpLine help$(a) + " | <F2=Buscar> <F10=Salir>"
IF pieza = 0 THEN PrintHelpLine help$(a) + "| <F2=Guardar y Salir> <F10=Salir sin Grabar>"
CASE CHR$(0) + "<" 'F2
finished = true
CASE CHR$(0) + "D" 'F10
CLOSE : EXIT SUB
CASE CHR$(13) 'Enter
CASE ELSE
BEEP
END SELECT
LOOP UNTIL finished
IF pieza = 3 THEN RETURN
cont:
OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56
OPEN "proo2.dat" FOR RANDOM AS #2 LEN = 112
OPEN "proo3.dat" FOR RANDOM AS #3 LEN = 206
FIELD #1, 40 AS nom2$, 16 AS Tel2$
FIELD #2, 32 AS cal2$, 10 AS num2$, 32 AS Pis2$, 19 AS LET2$, 19 AS loc2$
FIELD #3, 50 AS Cpu2$, 58 AS Ram2$, 50 AS TG2$, 32 AS Hd2$, 16 AS tel3$
LSET nom2$ = CurrString$(1): LSET Tel2$ = CurrString$(6)
LSET cal2$ = CurrString$(2): LSET num2$ = CurrString$(3): LSET Pis2$ = CurrString$(4): LSET LET2$ = CurrString$(5): LSET loc2$ = CurrString$(7)
LSET Cpu2$ = CurrString$(8): LSET Ram2$ = CurrString$(9): LSET TG2$ = CurrString$(10): LSET Hd2$ = CurrString$(11): LSET tel3$ = CurrString$(12)
IF valor = 3 THEN PUT #1, lf ELSE PUT #1, entrada
IF valor = 3 THEN PUT #2, lf ELSE PUT #2, entrada
IF valor = 3 THEN PUT #3, lf ELSE PUT #3, entrada
CLOSE #1, #2, #3
IF valor = 3 THEN RETURN
IF pieza = 3 THEN RETURN
LOCATE 13, 2: PRINT "<22>Seguir introduciendo?"
we:
i$ = INKEY$
IF i$ = "" THEN GOTO we
IF i$ = "S" OR i$ = "s" THEN GOTO ip ELSE CLOSE : EXIT SUB
ep:
GOSUB menu2
center 23, "Utilice + y - para ver las Fichas"
K = 0
mirp:
lf = 0
CLOSE #1, #2, #3
OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56
OPEN "proo2.dat" FOR RANDOM AS #2 LEN = 112
OPEN "proo3.dat" FOR RANDOM AS #3 LEN = 206
lf = 0
vez = 1
DO
pro:
IF lf = 0 THEN lf = 1
FIELD #1, 40 AS nom$, 16 AS tel$
FIELD #2, 32 AS Cal$, 10 AS num$, 32 AS Pis$, 19 AS lettt$, 19 AS locc$
FIELD #3, 50 AS cpu$, 58 AS ram$, 50 AS tg$, 32 AS hd$, 16 AS tel4$
GET #1, lf
GET #2, lf
GET #3, lf
g = 0
IF K = 1 AND UCASE$(RTRIM$(LTRIM$(she$(1)))) <> UCASE$(MID$(nom$, 1, LEN(RTRIM$(LTRIM$(she$(1)))))) THEN GOSUB pw
IF K = 2 AND UCASE$(RTRIM$(LTRIM$(she$(2)))) <> UCASE$(MID$(Cal$, 1, LEN(RTRIM$(LTRIM$(she$(2)))))) THEN GOSUB pw
IF K = 3 AND UCASE$(RTRIM$(LTRIM$(she$(3)))) <> UCASE$(MID$(num$, 1, LEN(RTRIM$(LTRIM$(she$(3)))))) THEN GOSUB pw
IF K = 4 AND UCASE$(RTRIM$(LTRIM$(she$(4)))) <> UCASE$(MID$(tg$, 1, LEN(RTRIM$(LTRIM$(she$(4)))))) THEN GOSUB pw
IF g = 1 THEN GOTO pro
IF RTRIM$(LTRIM$(nom$)) = "" AND r = 0 THEN lf = lf + 1: GOTO pro
IF RTRIM$(LTRIM$(nom$)) = "" AND r = 1 THEN lf = lf - 1: GOTO pro
vez = 0
COLOR colors(3, ColorPref), colors(9, ColorPref)
LOCATE 4, 11: PRINT nom$
LOCATE 6, 14: PRINT Cal$
LOCATE 6, 62: PRINT num$
LOCATE 8, 14: PRINT Pis$
LOCATE 8, 59: PRINT lettt$
LOCATE 10, 14: PRINT tel$
LOCATE 10, 58: PRINT locc$
LOCATE 15, 21: PRINT cpu$
LOCATE 17, 13: PRINT ram$
LOCATE 19, 21: PRINT tg$
LOCATE 21, 14: PRINT hd$
LOCATE 21, 59: PRINT tel4$
COLOR colors(7, ColorPref), colors(4, ColorPref)
nom$ = nom$: Cal$ = Cal$: num$ = num$: Pis$ = Pis$: lettt$ = lettt$: locc$ = locc$
tel$ = tel$: cpu$ = cpu$: ram$ = ram$: tg$ = tg$: hd$ = hd$: tel4$ = tel4$
CurrString$(1) = nom$
CurrString$(2) = Cal$
CurrString$(3) = num$
CurrString$(4) = Pis$
CurrString$(5) = lettt$
CurrString$(6) = tel$
CurrString$(7) = locc$
CurrString$(8) = cpu$
CurrString$(9) = ram$
CurrString$(10) = tg$
CurrString$(11) = hd$
CurrString$(12) = tel$
tipo = 0
T:
w$ = INKEY$: IF w$ = "" THEN GOTO T
IF w$ = "+" THEN lf = lf + 1: r = 0
IF w$ = "-" THEN lf = lf - 1: r = 1
IF w$ = CHR$(27) THEN CLOSE : EXIT SUB
IF w$ = CHR$(13) AND valor = 3 THEN CLOSE #1, #2, #3: RETURN
IF w$ = CHR$(13) AND valor = 2 THEN CLOSE #1, #2, #3: RETURN
IF lf > LOF(1) / 56 THEN lf = lf - 1: GOTO T
IF lf = 0 OR lf = -1 THEN lf = 1: GOTO T
IF tipo = 1 THEN GOTO pro
LOOP
CLOSE #1, #2, #3
END
pw:
IF vez = 1 AND r = 0 THEN lf = lf + 1: g = 1
IF vez = 1 AND r = 1 THEN lf = lf - 1: g = 1
IF g = 0 AND r = 0 THEN lf = lf + 1
IF g = 0 AND r = 1 THEN lf = lf - 1
IF lf > LOF(1) / 56 AND vez = 1 THEN GOTO filenotfound
IF lf > LOF(1) / 56 THEN lf = lf - 1: GOTO T
IF lf = 0 OR lf = -1 THEN lf = 1: GOTO T
tipo = 1
g = 1
RETURN
END
mp:
valor = 0
GOSUB menu2
valor = 3
LOCATE 23, 1: PRINT STRING$(80, "<22>");
center 23, "Use + o - y <<3C><> para editar ficha"
GOSUB mirp
GOSUB empi
EXIT SUB
r:
i$ = INKEY$: IF i$ = "" THEN GOTO r
IF i$ = "S" OR i$ = "s" THEN GOTO mp ELSE CLOSE : EXIT SUB
bp:
valor = 0
GOSUB menu2
valor = 3
LOCATE 23, 1: PRINT STRING$(80, "<22>");
center 23, "Use + o - y <<3C><> para borrar ficha"
GOSUB mirp
FOR wq = 1 TO 12
CurrString$(wq) = ""
NEXT wq
LOCATE 23, 1: PRINT STRING$(80, "<22>");
center 23, "Pulse 'S' si desea eliminarla"
r3:
i$ = INKEY$: IF i$ = "" THEN GOTO r3
IF i$ = "S" OR i$ = "s" THEN GOTO po ELSE CLOSE : EXIT SUB
po:
GOSUB cont
LOCATE 23, 1: PRINT STRING$(80, "<22>");
center 23, "<22>Desea eliminar otra ficha?"
r2:
i$ = INKEY$: IF i$ = "" THEN GOTO r2
IF i$ = "S" OR i$ = "s" THEN GOTO bp ELSE CLOSE : EXIT SUB
finentrada:
END
impr:
REM FICHERO PARA IMPRIMIR
COLOR colors(7, ColorPref), colors(4, ColorPref)
box 13, 33, 19, 72
LOCATE 14, 34: PRINT "Esta usd. en la secci<63>n de impresion."
LOCATE 15, 34: PRINT "Cerciorese de que la impresora este"
LOCATE 16, 34: PRINT "encendida y de que tenga papel."
LOCATE 18, 34: PRINT " Pulse una tecla..."
n:
q$ = INKEY$: IF q$ = "" THEN GOTO n
IF q$ = CHR$(27) THEN EXIT SUB
box 13, 33, 19, 72
LOCATE 15, 34: PRINT "Elija modo de impresion:"
LOCATE 17, 39: PRINT "(a) Lista simple"
LOCATE 18, 39: PRINT "(b) Lista completa"
COLOR colors(8, ColorPref), colors(9, ColorPref)
hn:
q$ = INKEY$: IF q$ = "" THEN GOTO hn
IF q$ = CHR$(27) THEN EXIT SUB
IF q$ = "A" OR q$ = "a" THEN GOTO ls
IF q$ = "B" OR q$ = "b" THEN GOTO lc
GOTO hn
ls:
kop = 0
printerr = false
ON ERROR GOTO ErrorTrap
LPRINT
kdb$ = INKEY$
WHILE kdb$ = "": kdb$ = INKEY$: WEND
IF kdb$ = CHR$(27) THEN EXIT SUB
IF printerr = true THEN GOTO ls
OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56
FOR x = 1 TO LOF(1) / 56
FIELD #1, 40 AS nom$, 16 AS tel$
GET #1, x
IF RTRIM$(LTRIM$(nom$)) = "" THEN GOTO continua
IF kop = 0 THEN
LPRINT " Nombre de la entidad proveedora Tel<65>fono ": LPRINT
kop = 1
END IF
LPRINT nom$ + " " + tel$
b = b + 1: IF b = 50 THEN GOSUB finlista
continua:
NEXT x
CLOSE #1
CLOSE : EXIT SUB
finlista:
box 13, 33, 19, 72
LOCATE 15, 34: PRINT "Cuando deje de imprimir ponga papel"
LOCATE 16, 34: PRINT " Pulse entonces una tecla para "
LOCATE 17, 34: PRINT " continuar listando. "
M:
IF INKEY$ = "" THEN GOTO M
box 13, 33, 19, 72
LOCATE 16, 34: PRINT " IMPRIMIENDO "
b = 0: RETURN
lc:
valor = 2
GOSUB menu2
center 23, "Seleccione ficha a imprimir..."
GOSUB mirp
lf:
printerr = false
ON ERROR GOTO ErrorTrap
LPRINT
kdb$ = INKEY$
WHILE kdb$ = "": kdb$ = INKEY$: WEND
IF kdb$ = CHR$(27) THEN EXIT SUB
IF printerr = true THEN GOTO lf
LPRINT " Tratamiento de Proveedores <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><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><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> N<> de Ficha: <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Nombre: " + nom$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Direcci<63>n: " + Cal$ + " Cod. Postal: " + num$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Localidad: " + Pis$ + " Provincia: " + lettt$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Tel<65>fono: " + tel$ + " C.I.F.: " + locc$ + " <20><>";
LPRINT "<22> <20><>";
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>";
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><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>";
LPRINT "<22> Entidad Bancaria: " + cpu$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Material: " + ram$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Jefe de Ventas: " + tg$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Direcci<63>n: " + hd$ + " Tel<65>fono: " + tel$ + " <20><>";
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>ٱ";
LPRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><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 "Base de Datos y Programa TPV, por Jos<6F> David Guill<6C>n, para Guill<6C>n Dominguez s.l.";
FancyCls colors(2, ColorPref), colors(1, ColorPref)
box 10, 15, 14, 65
center 12, "Cuando deje de imprimir, pulse una tecla"
SLEEP
CLOSE : EXIT SUB
sp:
valor = 0: pieza = 3
GOSUB menu2
LOCATE 13, 2: PRINT "Introduzca parte a buscar..."
lili:
Row(1) = 4: Col(1) = 11: vis(1) = 40: max(1) = 40
Row(2) = 8: Col(2) = 14: vis(2) = 32: max(2) = 32
Row(3) = 8: Col(3) = 59: vis(3) = 19: max(3) = 19
Row(4) = 17: Col(4) = 13: vis(4) = 58: max(4) = 58
help$(1) = "Nombre de la entidad Proveedora "
help$(2) = "Localidad "
help$(3) = "Provincia "
help$(4) = "Material que Provee "
GOSUB empi
FOR qwq = 1 TO 4
IF LTRIM$(RTRIM$(CurrString$(qwq))) <> "" THEN she$(qwq) = CurrString$(qwq): K = qwq
NEXT qwq
IF pieza = 0 THEN pieza = 3: GOTO lili
PrintHelpLine "Pulse (Esc) para salir y + -"
GOTO mirp
EXIT SUB
filenotfound:
LOCATE 13, 2: PRINT "Ficha no encontrada"
SLEEP
COLOR colors(7, ColorPref), colors(4, ColorPref)
GOTO sp
END
menu2:
LOCATE 1, 1
PRINT " Tratamiento de Proveedores <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ";
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> N<> de Ficha: <20><>";
PRINT "<22> <20><>";
PRINT "<22> Nombre: <20><>";
PRINT "<22> <20><>";
PRINT "<22> Direcci<63>n: Cod. Postal: <20><>";
PRINT "<22> <20><>";
PRINT "<22> Localidad: Provincia: <20><>";
PRINT "<22> <20><>";
PRINT "<22> Tel<65>fono: C.I.F.: <20><>";
PRINT "<22> <20><>";
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>";
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>";
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> <20><>";
PRINT "<22> Entidad Bancaria: <20><>";
PRINT "<22> <20><>";
PRINT "<22> Material: <20><>";
PRINT "<22> <20><>";
PRINT "<22> Jefe de Ventas: <20><>";
PRINT "<22> <20><>";
PRINT "<22> Direcci<63>n: Tel<65>fono: <20><>";
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>ٱ";
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
RETURN
showline:
IF ed = 1 THEN
COLOR colors(7, ColorPref), colors(4, ColorPref)
ELSE
COLOR colors(8, ColorPref), colors(9, ColorPref)
END IF
LOCATE Row(a), Col(a)
IF RTRIM$(LTRIM$(CurrString$(a))) <> "" THEN
PRINT CurrString$(a)
ELSE
PRINT SPACE$(vis(a))
END IF
RETURN
lg:
CLOSE : EXIT SUB
END SUB
SUB Referencias (op%)
'Stores info about each column
REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6), lin$(130), ref1000#(1000)
'Array to keep the current balance at all the transactions
'Open random access file
file$ = "Ref#." + Cvit$(op%)
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$
'Initialize variables
CurrString$(1) = ""
CurrFig#(2) = 0
CurrFig#(3) = 0
CurrFig#(4) = 0
CurrFig#(5) = 0
GET #1, 1
IF valid$ <> "SI" THEN
LSET IoRef$ = STR$(0)
LSET IoDesc$ = ""
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$)
ref1000#(0) = 0
a = 1
WHILE a <= MaxRecord
GET #1, a + 1
ref1000#(a) = VAL(IoRef$)
a = a + 1
WEND
help$(1) = "Referencia del Producto "
help$(2) = "Nombre del Producto "
help$(3) = "Unidades parciales, ( o por caja ) "
help$(4) = "P.V.P. del Producto, ( por unidad )"
help$(5) = "Precio de Costo, ( la unidad ) "
Col(1) = 4: vis(1) = 10: max(1) = 6
Col(2) = 16: vis(2) = 22: max(2) = 22
Col(3) = 40: vis(3) = 9: max(3) = 3
Col(4) = 50: vis(4) = 12: max(4) = 8
Col(5) = 63: vis(5) = 13: max(5) = 8
'Draw Screen
COLOR colors(7, ColorPref), colors(4, ColorPref)
box 2, 3, 24, 76
COLOR colors(5, ColorPref), colors(4, ColorPref)
LOCATE 1, 1: PRINT SPACE$(80);
LOCATE 1, 4: PRINT "Referencias de la Empresa: " + Trim$(account(op%).Title);
COLOR colors(7, ColorPref), colors(4, ColorPref)
LOCATE 3, 4: PRINT " Ref# <20> Concepto <20> Und/C <20> P.V.P. <20> P.C. "
LOCATE 4, 4: 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>"
u1$ = " <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$ = "######"
CurrTopline = 1
GOSUB EditTransPrintWholeScreen2
CurrRow = 1
CurrCol = 1
PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <F9=Insert> <F10=Supr>"
GOSUB EditTransGetLine2
finished = false
'Loop until <F2> is pressed
DO
GOSUB EditTransShowCursor2 'Show Cursor, Wait for key
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
ed = 1: GOSUB EditTransShowCursor2: ed = 0: 'Oculta el cursor para obtener datos ED=1
IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item
GOSUB EditTransEditItem2
END IF
SELECT CASE kbd$ 'Handle Special keys
CASE CHR$(0) + "H" 'up arrow
GOSUB EditTransMoveUp2
CASE CHR$(0) + "P" 'Down arrow
GOSUB EditTransMoveDown2
CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab
CurrCol = (CurrCol + 3) MOD 5 + 1
PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <F9=Insert> <F10=Supr>"
CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab
CurrCol = (CurrCol) MOD 5 + 1
PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <F9=Insert> <F10=Supr>"
CASE CHR$(0) + "G" 'Home
CurrCol = 1
CASE CHR$(0) + "O" 'End
CurrCol = 5
CASE CHR$(0) + "I" 'Page Up
CurrRow = 1
CurrTopline = CurrTopline - 19
IF CurrTopline < 1 THEN
CurrTopline = 1
END IF
GOSUB EditTransPrintWholeScreen2
GOSUB EditTransGetLine2
CASE CHR$(0) + "Q" 'Page Down
CurrRow = 1
CurrTopline = CurrTopline + 19
IF CurrTopline > MaxRecord THEN
CurrTopline = MaxRecord
END IF
GOSUB EditTransPrintWholeScreen2
GOSUB EditTransGetLine2
CASE CHR$(0) + "<" 'F2
finished = true
CASE CHR$(0) + "C" 'F9
GOSUB EditTransAddRecord2
CASE CHR$(0) + "D" 'F10
GOSUB EditTransDeleteRecord2
CASE CHR$(13) 'Enter
CASE ELSE
BEEP
END SELECT
LOOP UNTIL finished
CLOSE
EXIT SUB
EditTransShowCursor2:
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 " "; : PRINT USING u6$; CurrFig#(2); ELSE PRINT " ";
CASE 2
IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT CurrString$(1); ELSE PRINT " ";
CASE 3
IF CurrFig#(3) <> 0 THEN PRINT " "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT " ";
CASE 4
IF CurrFig#(4) <> 0 THEN PRINT " "; : PRINT USING u5$; CurrFig#(4); : PRINT " "; ELSE PRINT " ";
CASE 5
IF CurrFig#(5) <> 0 THEN PRINT " "; : PRINT USING u2$; CurrFig#(5); ELSE PRINT " ";
END SELECT
RETURN
EditTransEditItem2:
CurrRecord = CurrTopline + CurrRow - 1
EditTransEditItem3:
COLOR colors(8, ColorPref), colors(9, ColorPref)
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# >= 100001# OR new1# < 0
CurrFig#(2) = new1#
reg = 0: b = 1
DO WHILE ref1000#(b) <> 0 OR b = 999
IF ref1000#(b) = CurrFig#(2) THEN
df = 0
FOR Ol = 17 TO 19
FOR Oc = 24 TO 49
df = df + 1
lin$(df) = CHR$(SCREEN(Ol, Oc))
NEXT Oc, Ol
box 17, 24, 19, 49
LOCATE 18, 25: PRINT "Esa Referencia ya existe"
SLEEP
COLOR colors(7, ColorPref), colors(4, ColorPref)
df = 0
FOR Ol = 17 TO 19
FOR Oc = 24 TO 49
df = df + 1
LOCATE Ol, Oc: PRINT lin$(df)
NEXT Oc, Ol
reg = 1
EXIT DO
END IF
b = b + 1
LOOP
IF reg = 1 THEN GOTO EditTransEditItem3
GOSUB EditTransPutLine2
GOSUB EditTransGetLine2
CASE 2
kbd$ = GetString$(CurrRow + 4, Col(CurrCol), kbd$, new$, vis(CurrCol), max(CurrCol))
CurrString$(1) = new$
GOSUB EditTransPutLine2
GOSUB EditTransGetLine2
CASE 3
start$ = kbd$
DO
kbd$ = GetString$(CurrRow + 4, Col(3), start$, new$, vis(3), max(3))
new3# = VAL(new$)
start$ = ""
LOOP WHILE new3# > 601# OR new3# < 0
CurrFig#(3) = new3#
IF CurrFig#(3) = 0 THEN CurrFig#(3) = 1
GOSUB EditTransPutLine2
GOSUB EditTransGetLine2
CASE 4
start$ = kbd$
DO
kbd$ = GetString$(CurrRow + 4, Col(4), start$, new$, vis(4), max(4))
new4# = VAL(new$)
start$ = ""
LOOP WHILE new4# >= 75001# OR new4# < 0
CurrFig#(4) = new4#
IF CurrFig#(4) = 0 THEN
df = 0
FOR Ol = 17 TO 19
FOR Oc = 18 TO 59
df = df + 1
lin$(df) = CHR$(SCREEN(Ol, Oc))
NEXT Oc, Ol
box 17, 18, 19, 59
LOCATE 18, 20: PRINT "El P.V.P. No puede ser 0 ni menor de 0"
SLEEP
COLOR colors(7, ColorPref), colors(4, ColorPref)
df = 0
FOR Ol = 17 TO 19
FOR Oc = 18 TO 59
df = df + 1
LOCATE Ol, Oc: PRINT lin$(df)
NEXT Oc, Ol
END IF
GOSUB EditTransPutLine2
GOSUB EditTransGetLine2
CASE 5
start$ = kbd$
DO
kbd$ = GetString$(CurrRow + 4, Col(5), start$, new$, vis(5), max(5))
new5# = VAL(new$)
start$ = ""
LOOP WHILE new5# >= 75001# OR new5 < 0
CurrFig#(5) = new5#
IF CurrFig#(5) = 0 THEN
df = 0
FOR Ol = 17 TO 19
FOR Oc = 18 TO 59
df = df + 1
lin$(df) = CHR$(SCREEN(Ol, Oc))
NEXT Oc, Ol
box 17, 18, 19, 59
LOCATE 18, 20: PRINT " El P.C. No puede ser 0 ni menor de 0"
SLEEP
df = 0
COLOR colors(7, ColorPref), colors(4, ColorPref)
FOR Ol = 17 TO 19
FOR Oc = 18 TO 59
df = df + 1
LOCATE Ol, Oc: PRINT lin$(df)
NEXT Oc, Ol
END IF
GOSUB EditTransPutLine2
GOSUB EditTransGetLine2
CASE ELSE
END SELECT
GOSUB EditTransPrintLine2
RETURN
EditTransMoveUp2:
IF CurrRow = 1 THEN
IF CurrTopline = 1 THEN
BEEP
ELSE
ScrollDown
CurrTopline = CurrTopline - 1
GOSUB EditTransGetLine2
GOSUB EditTransPrintLine2
END IF
ELSE
CurrRow = CurrRow - 1
GOSUB EditTransGetLine2
END IF
RETURN
EditTransMoveDown2:
IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN
BEEP
ELSE
IF CurrRow = 19 THEN
ScrollUp
CurrTopline = CurrTopline + 1
GOSUB EditTransGetLine2
GOSUB EditTransPrintLine2
ELSE
CurrRow = CurrRow + 1
GOSUB EditTransGetLine2
END IF
END IF
p = 0
IF CurrFig#(4) = 0 THEN p = 1 ELSE IF CurrFig#(5) = 0 THEN p = 2
IF p <> 0 THEN
df = 0
FOR Ol = 17 TO 19
FOR Oc = 18 TO 59
df = df + 1
lin$(df) = CHR$(SCREEN(Ol, Oc))
NEXT Oc, Ol
box 17, 18, 19, 59
LOCATE 18, 20: IF p = 1 THEN PRINT "El P.V.P. No puede ser 0 ni menor de 0" ELSE PRINT " El P.C. No puede ser 0 ni menor de 0"
SLEEP
COLOR colors(7, ColorPref), colors(4, ColorPref)
df = 0
FOR Ol = 17 TO 19
FOR Oc = 18 TO 59
df = df + 1
LOCATE Ol, Oc: PRINT lin$(df)
NEXT Oc, Ol
END IF
RETURN
EditTransPrintLine2:
COLOR colors(7, ColorPref), colors(4, ColorPref)
CurrRecord = CurrTopline + CurrRow - 1
LOCATE CurrRow + 4, 4
IF CurrRecord = MaxRecord + 1 THEN
PRINT u1x$;
ELSEIF CurrRecord > MaxRecord THEN
PRINT u1$;
ELSE
IF CurrFig#(2) <> 0 THEN PRINT " "; : 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 " <20> "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT " <20> ";
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> ";
END IF
RETURN
EditTransDeleteRecord2:
IF MaxRecord = 1 THEN
BEEP
ELSE
CurrRecord = CurrTopline + CurrRow - 1
MaxRecord = MaxRecord - 1
a = CurrRecord
WHILE a <= MaxRecord
GET #1, a + 2
PUT #1, a + 1
ref1000#(a) = ref1000#(a + 1)
a = a + 1
WEND
LSET valid$ = "SI"
LSET IoMaxRecord$ = Cvit$(MaxRecord)
PUT #1, 1
GOSUB EditTransPrintWholeScreen2
CurrRecord = CurrTopline + CurrRow - 1
IF CurrRecord > MaxRecord THEN
GOSUB EditTransMoveUp2
END IF
GOSUB EditTransGetLine2
END IF
RETURN
EditTransAddRecord2:
CurrRecord = CurrTopline + CurrRow - 1
a = MaxRecord
WHILE a > CurrRecord
GET #1, a + 1
PUT #1, a + 2
ref1000#(a + 1) = ref1000#(a)
a = a - 1
WEND
MaxRecord = MaxRecord + 1
LSET IoRef$ = STR$(0)
LSET IoDesc$ = ""
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 EditTransPrintWholeScreen2
GOSUB EditTransGetLine2
RETURN
EditTransPrintWholeScreen2:
temp = CurrRow
FOR CurrRow = 1 TO 19
CurrRecord = CurrTopline + CurrRow - 1
IF CurrRecord <= MaxRecord THEN
GOSUB EditTransGetLine2
END IF
GOSUB EditTransPrintLine2
NEXT CurrRow
CurrRow = temp
RETURN
EditTransPutLine2:
CurrRecord = CurrTopline + CurrRow - 1
LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2))))
LSET IoDesc$ = CurrString$(1)
LSET IoCC$ = LTRIM$(RTRIM$(STR$(CurrFig#(3))))
LSET IoPvp$ = LTRIM$(RTRIM$(STR$(CurrFig#(4))))
LSET IoPc$ = LTRIM$(RTRIM$(STR$(CurrFig#(5))))
PUT #1, CurrRecord + 1
RETURN
EditTransGetLine2:
CurrRecord = CurrTopline + CurrRow - 1
GET #1, CurrRecord + 1
CurrFig#(2) = VAL(IoRef$)
CurrString$(1) = IoDesc$
CurrFig#(3) = VAL(IoCC$)
CurrFig#(4) = VAL(IoPvp$)
CurrFig#(5) = VAL(IoPc$)
RETURN
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
Reference in New Issue View Git Blame Copy Permalink