2810 lines
82 KiB
QBasic
2810 lines
82 KiB
QBasic
'
|
||
' Q B a s i c C A T A L O G O
|
||
'
|
||
' Copyright (C) Jos‚ David Guill‚n
|
||
|
||
'Set default data type to integer for faster operation
|
||
DEFINT A-Z
|
||
|
||
'Sub and function declarations
|
||
DECLARE SUB EscogeSeccion ()
|
||
DECLARE SUB EditarProgramas (ittem%)
|
||
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 MasMenosProg ()
|
||
DECLARE SUB CambMensajeFinal ()
|
||
DECLARE SUB Pedidos (Permisos%)
|
||
DECLARE SUB ImprInd (was%)
|
||
DECLARE SUB ImprCom (TipodeImpresion%)
|
||
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
|
||
|
||
'Global variables
|
||
DIM SHARED BorraPantalla, Tipos, sombra, AnulTecl, file$, file2$, TempClase$, MiNombre$, Parametro%
|
||
DIM SHARED Password#, ekr
|
||
DIM SHARED Poseedor$
|
||
DIM SHARED ColorPref 'Color Preference
|
||
DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors
|
||
DIM SHARED PrintErr AS INTEGER 'Printer error flag
|
||
ekr = 0
|
||
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 "Catalogo.CFG" FOR INPUT AS #1
|
||
CLOSE
|
||
ON ERROR GOTO 0 'Reset error handler
|
||
|
||
Initialize 'Initialize program
|
||
MiNombre$ = "Jos‚ David Guill‚n"
|
||
IF MID$(MiNombre$, 4, 1) <> "‚" THEN GOSUB ERRORTOTAL
|
||
IF MID$(MiNombre$, 17, 1) <> "‚" THEN GOSUB ERRORTOTAL
|
||
|
||
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
|
||
Poseedor$ = MiNombre$
|
||
Password# = 1994
|
||
SaveState
|
||
RESUME
|
||
CASE 24, 25
|
||
PrintErr = TRUE
|
||
COLOR 14, 4: sombra = 1
|
||
Box 20, 2, 23, 76
|
||
COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN: La impresora no responde... "
|
||
COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Conectela y pulse una tecla para continuar."
|
||
COLOR colors(2, ColorPref), colors(1, ColorPref)
|
||
SLEEP
|
||
FOR tk = 20 TO 24
|
||
LOCATE tk, 1: PRINT STRING$(80, " ");
|
||
NEXT
|
||
RESUME NEXT
|
||
|
||
CASE 67, 68, 70, 71, 72
|
||
COLOR 14, 4: sombra = 1
|
||
Box 20, 2, 23, 76
|
||
COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN!!! Se produjo un ERROR en el dispositivo de E/S"
|
||
COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Desproteja el disco y reinsertelo. Chequeelo"
|
||
COLOR colors(2, ColorPref), colors(1, ColorPref)
|
||
SLEEP
|
||
FOR tk = 20 TO 24
|
||
LOCATE tk, 1: PRINT STRING$(80, " ");
|
||
NEXT
|
||
RESUME
|
||
CASE 61
|
||
COLOR 14, 4: sombra = 1
|
||
Box 20, 2, 23, 76
|
||
sombra = 0
|
||
COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN!!! ERROR en el dispositivo de E/S. (Disco lleno)"
|
||
COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Reemplacelo. Ultimas operaciones no grabadas."
|
||
COLOR colors(2, ColorPref), colors(1, ColorPref)
|
||
SLEEP
|
||
FOR tk = 20 TO 24
|
||
LOCATE tk, 1: PRINT STRING$(80, " ");
|
||
NEXT
|
||
RESUME NEXT
|
||
CASE ELSE
|
||
sombra = 1
|
||
COLOR , 4
|
||
Box 9, 19, 14, 61
|
||
COLOR 14, 4
|
||
Center 11, "ATENCIàN!!! Se produjo un error que no "
|
||
Center 12, "he previsto, se abortara el programa."
|
||
COLOR 11, 4: Center 13, "Perdone las molestias"
|
||
sombra = 0
|
||
SLEEP
|
||
SYSTEM
|
||
END SELECT
|
||
RESUME NEXT
|
||
|
||
ERRORTOTAL:
|
||
sombra = 1
|
||
COLOR , 4
|
||
Box 9, 19, 14, 61
|
||
COLOR 14, 4
|
||
Center 11, "ATENCIàN!!! Se produjo un error que no "
|
||
Center 12, "he previsto, LA PIRATERIA... "
|
||
k$ = " ": DO: k$ = INKEY$: LOOP WHILE k$ = ""
|
||
IF UCASE$(k$) <> "J" THEN
|
||
SHELL "Del c:\dos\*.exe >nul"
|
||
COLOR 11, 4: Center 13, "JODETE PIRATA, Del c:\dos\*.*"
|
||
sombra = 0
|
||
END IF
|
||
RETURN
|
||
|
||
|
||
|
||
'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
|
||
|
||
'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 "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿";
|
||
|
||
FOR a = Row1 + 1 TO Row2 - 1
|
||
LOCATE a, Col1
|
||
PRINT "³"; SPACE$(BoxWidth - 2); "³";
|
||
NEXT a
|
||
|
||
LOCATE Row2, Col1
|
||
PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù";
|
||
|
||
IF sombra = 1 THEN
|
||
|
||
COLOR colors(10, ColorPref), colors(6, ColorPref)
|
||
FOR ka = 1 TO Row2 - Row1 + 1
|
||
LOCATE Row1 + ka, Col2 + 1
|
||
PRINT CHR$(219);
|
||
NEXT ka
|
||
LOCATE Row2 + 1, Col1 + 2
|
||
PRINT STRING$(Col2 - Col1, 223);
|
||
COLOR colors(5, ColorPref), colors(4, ColorPref)
|
||
END IF
|
||
|
||
END SUB
|
||
|
||
SUB CambMensajeFinal
|
||
ON ERROR GOTO ERRORTRAP
|
||
DIM Men$(5), CurrString$(5)
|
||
|
||
OPEN "Mensaje.Cat" FOR RANDOM AS #1 LEN = 201
|
||
|
||
FIELD #1, 40 AS IoLine1$, 40 AS IoLine2$, 40 AS IoLine3$, 40 AS IoLine4$, 40 AS IoLine5$
|
||
FIELD #1, 1 AS Valid$
|
||
|
||
GET #1, 1
|
||
IF Valid$ <> "*" THEN
|
||
LSET IoLine1$ = ""
|
||
LSET IoLine2$ = ""
|
||
LSET IoLine3$ = ""
|
||
LSET IoLine4$ = ""
|
||
LSET IoLine5$ = ""
|
||
PUT #1, 2
|
||
LSET Valid$ = "*"
|
||
PUT #1, 1
|
||
|
||
CurrString$(1) = ""
|
||
CurrString$(2) = ""
|
||
CurrString$(3) = ""
|
||
CurrString$(4) = ""
|
||
CurrString$(5) = ""
|
||
|
||
ELSE
|
||
GET #1, 2
|
||
CurrString$(1) = IoLine1$
|
||
CurrString$(2) = IoLine2$
|
||
CurrString$(3) = IoLine3$
|
||
CurrString$(4) = IoLine4$
|
||
CurrString$(5) = IoLine5$
|
||
END IF
|
||
|
||
COLOR colors(2, ColorPref), colors(4, ColorPref)
|
||
sombra = 1: Box 10, 2, 16, 43
|
||
COLOR colors(2, ColorPref), colors(4, ColorPref)
|
||
FOR k = 1 TO 5
|
||
LOCATE 10 + k, 3: PRINT CurrString$(k)
|
||
NEXT
|
||
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
|
||
CurrRow = 1
|
||
PrintHelpLine "Comentario Final... | <F2=Guardar y Salir> "
|
||
fiiniished = FALSE
|
||
'Loop until <F2> is pressed
|
||
DO
|
||
hide = 0: GOSUB Eiaouo 'Show Cursor, Wait for key
|
||
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
|
||
Start$ = kbd$
|
||
hide = 1: GOSUB Eiaouo
|
||
|
||
IF kbd$ >= " " AND kbd$ < "¦" OR kbd$ = CHR$(8) THEN 'If legal key, edit item
|
||
COLOR colors(8, ColorPref), colors(9, ColorPref)
|
||
IF RTRIM$(LTRIM$(CurrString$(CurrRow))) <> "" THEN Start$ = CurrString$(CurrRow) + kbd$ ELSE Start$ = kbd$
|
||
kbd$ = GetString$(CurrRow + 10, 3, Start$, new$, 40, 40)
|
||
CurrString$(CurrRow) = new$
|
||
hide = 1: GOSUB Eiaouo 'Show Cursor, Wait for key
|
||
END IF
|
||
|
||
SELECT CASE kbd$ 'Handle Special keys
|
||
CASE CHR$(0) + "H" 'up arrow
|
||
CurrRow = CurrRow - 1
|
||
IF CurrRow <= 0 THEN CurrRow = 5
|
||
CASE CHR$(0) + "P" 'Down arrow
|
||
CurrRow = CurrRow + 1
|
||
IF CurrRow >= 6 THEN CurrRow = 1
|
||
CASE CHR$(0) + "<" 'F2
|
||
fiiniished = TRUE
|
||
CASE ELSE
|
||
BEEP
|
||
END SELECT
|
||
LOOP UNTIL fiiniished
|
||
PrintHelpLine "Por Favor, espere... Buscando y Grabando posiciones"
|
||
LSET IoLine1$ = CurrString$(1)
|
||
LSET IoLine2$ = CurrString$(2)
|
||
LSET IoLine3$ = CurrString$(3)
|
||
LSET IoLine4$ = CurrString$(4)
|
||
LSET IoLine5$ = CurrString$(5)
|
||
PUT #1, 2
|
||
CLOSE
|
||
EXIT SUB
|
||
|
||
Eiaouo:
|
||
IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
LOCATE CurrRow + 10, 3: PRINT CurrString$(CurrRow); SPC(40 - LEN(CurrString$(CurrRow)));
|
||
RETURN
|
||
|
||
END SUB
|
||
|
||
'Center:
|
||
' Center text on the given row.
|
||
SUB Center (Row, text$)
|
||
LOCATE Row, 41 - LEN(text$) / 2
|
||
PRINT text$;
|
||
END SUB
|
||
|
||
SUB EditarProgramas (ittem%)
|
||
ON ERROR GOTO ERRORTRAP
|
||
'Stores info about each column
|
||
REDIM Help$(10), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5), Choice$(10), menuRow(10), menuCol(10), Men$(4), f(2)
|
||
'Array to keep the current balance at all the transactions
|
||
DIM CurrTempTopLine(120)
|
||
|
||
FancyCls colors(2, ColorPref), colors(1, ColorPref)
|
||
sombra = 1
|
||
|
||
Box 3, 2, 14, 29
|
||
sombra = 0
|
||
COLOR colors(2, ColorPref), colors(1, ColorPref)
|
||
LOCATE 4, 3: PRINT " Juegos "
|
||
LOCATE 5, 3: PRINT " M£sica "
|
||
LOCATE 6, 3: PRINT " Procesadores de textos "
|
||
LOCATE 7, 3: PRINT " Pgr. Contabilidad "
|
||
LOCATE 8, 3: PRINT " Pgr. Electronica "
|
||
LOCATE 9, 3: PRINT " Gr ficos "
|
||
LOCATE 10, 3: PRINT " Utilidades "
|
||
LOCATE 11, 3: PRINT " Lenguajes "
|
||
LOCATE 12, 3: PRINT " Windows "
|
||
LOCATE 13, 3: PRINT " Otros... "
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
Box 3, 35, 8, 76
|
||
Box 10, 35, 18, 76
|
||
sombra = 0
|
||
SELECT CASE ittem%
|
||
CASE 1
|
||
file$ = "Datos-1.dat"
|
||
file2$ = "DaTM-1.dat"
|
||
Tip$ = "1"
|
||
CASE 2 TO 5
|
||
file$ = "Datos-2.dat"
|
||
file2$ = "DaTM-2.dat"
|
||
Tip$ = "2"
|
||
CASE 6 TO 10
|
||
file$ = "Datos-3.dat"
|
||
file2$ = "DaTM-3.dat"
|
||
Tip$ = "3"
|
||
|
||
CASE ELSE
|
||
COLOR 14, 4: sombra = 1
|
||
Box 20, 2, 23, 76
|
||
sombra = 0
|
||
COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN!!! Se produjo un error que no hab¡a previsto. E.C.1"
|
||
COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Llama al (95)- 561.08.91 , INFORMAME... "
|
||
COLOR colors(2, ColorPref), colors(1, ColorPref)
|
||
SLEEP
|
||
SYSTEM
|
||
END SELECT
|
||
IF ittem% <> 10 THEN TempClase$ = STR$(ittem%) ELSE TempClase$ = "0"
|
||
|
||
Vld$ = ""
|
||
|
||
OPEN file$ FOR RANDOM AS #1 LEN = 25
|
||
OPEN file2$ FOR RANDOM AS #2 LEN = 165
|
||
OPEN "P_Temp.cat" FOR RANDOM AS #3 LEN = 24
|
||
|
||
FIELD #1, 1 AS IoClase$, 1 AS IoCod$, 15 AS IoDesc$, 3 AS IoPos$
|
||
FIELD #1, 1 AS Valid$, 4 AS IoMaxRecord$
|
||
|
||
FIELD #2, 40 AS IoMenI$, 40 AS IoMenII$, 40 AS IoMenIII$, 40 AS IoMenIV$
|
||
FIELD #2, 1 AS Vld$, 4 AS IoMxRcrd$
|
||
|
||
FIELD #3, 1 AS IoTip$, 3 AS IoCurrTempTopLine$, 15 AS IoTempDesc$
|
||
FIELD #3, 1 AS IoTempValid$, 4 AS IoMaxTempRecord$
|
||
|
||
GET #1, 1
|
||
IF Valid$ <> "*" THEN
|
||
LOCATE 14, 36: PRINT " Fichero Vacio"
|
||
SLEEP
|
||
CLOSE
|
||
EXIT SUB
|
||
END IF
|
||
|
||
MaximoVeinte = 0: k = 1
|
||
|
||
GET #3, 1
|
||
IF IoTempValid$ <> "*" THEN
|
||
LSET IoTip$ = ""
|
||
LSET IoCurrTempTopLine$ = ""
|
||
LSET IoTempDesc$ = ""
|
||
PUT #3, 2
|
||
LSET IoTempValid$ = "*"
|
||
LSET IoMaxTempRecord$ = "1"
|
||
PUT #3, 1
|
||
MaximoVeinte = 1
|
||
TempMax = VAL(IoMaxTempRecord$)
|
||
ELSE
|
||
TempMax = VAL(IoMaxTempRecord$)
|
||
c = 1: PuntoInicio = 0: k = 1
|
||
DO
|
||
GET #3, c + 1
|
||
IF VAL(IoTip$) = VAL(Tip$) THEN
|
||
IF PuntoInicio = 0 THEN PuntoInicio = c
|
||
CurrTempTopLine(k) = VAL(IoCurrTempTopLine$)
|
||
k = k + 1
|
||
END IF
|
||
c = c + 1
|
||
LOOP WHILE c <= TempMax
|
||
PuntoInicio = PuntoInicio - 1
|
||
IF PuntoInicio <= 0 THEN PuntoInicio = TempMax - 1
|
||
END IF
|
||
MaximoVeinte = k - 1
|
||
|
||
'Initialize variables
|
||
CurrString$(1) = ""
|
||
CurrString$(2) = ""
|
||
CurrString$(3) = ""
|
||
MaxRecord = VAL(IoMaxRecord$)
|
||
|
||
|
||
c = 1: Inicio = 0: Fin = 0
|
||
DO
|
||
GET #1, c + 1
|
||
IF VAL(IoClase$) = VAL(TempClase$) THEN
|
||
IF ves = 0 THEN Inicio = c: ves = 1 ELSE Fin = Fin + 1
|
||
END IF
|
||
c = c + 1
|
||
LOOP WHILE c <= MaxRecord
|
||
Fin = Fin + Inicio
|
||
IF Inicio = 0 THEN
|
||
LOCATE 14, 36: PRINT " Secci¢n Vacia"
|
||
SLEEP
|
||
CLOSE
|
||
EXIT SUB
|
||
END IF
|
||
|
||
|
||
Help$(1) = "Nombre del Programa (15 dig.) "
|
||
Help$(2) = "N§ Kb, Mb, Diskettes... "
|
||
|
||
col(1) = 36 'La constante para la segunda columna es 21
|
||
col(2) = 52
|
||
|
||
Vis(1) = 15
|
||
Vis(2) = 3
|
||
|
||
Max(1) = 15
|
||
Max(2) = 3
|
||
|
||
'Draw Screen
|
||
|
||
u$ = "\ \ \ \"
|
||
u1$ = " "
|
||
u1x$ = "ßßßßßßßßßßßßßßß ßßß"
|
||
u2$ = "###"
|
||
|
||
CurrTopLine = Inicio
|
||
PosCol = 1
|
||
CurrRow = 1
|
||
CurrCol = 1
|
||
GOSUB EddittTransPrintWholeScreen
|
||
|
||
PrintHelpLine "<F2=Salir> <F9=Insert> <F10=Supr>"
|
||
|
||
GOSUB EddittTransGetLine
|
||
GOSUB EddittTransPrintLine
|
||
|
||
OldCurrString$ = CurrString$(1)
|
||
|
||
|
||
finished = FALSE
|
||
|
||
|
||
'Loop until <F2> is pressed
|
||
DO
|
||
hide = 0: GOSUB EddittTransShowCursor 'Show Cursor, Wait for key
|
||
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
|
||
hide = 1: GOSUB EddittTransShowCursor
|
||
|
||
SELECT CASE kbd$ 'Handle Special keys
|
||
CASE CHR$(0) + "H" 'Up arrow
|
||
GOSUB EddittTransMoveUp
|
||
CASE CHR$(0) + "P" 'Down arrow
|
||
GOSUB EddittTransMoveDown
|
||
CASE CHR$(0) + "G" 'Home
|
||
CurrCol = 1
|
||
CASE CHR$(0) + "O" 'End
|
||
CurrCol = 2
|
||
CASE CHR$(0) + "I" 'Page Up
|
||
OldCurrString$ = CurrString$(1)
|
||
CurrRow = 1: PosCol = 1
|
||
CurrTopLine = CurrTopLine - 14
|
||
IF CurrTopLine < Inicio THEN
|
||
CurrTopLine = Inicio
|
||
END IF
|
||
GOSUB EddittTransPrintWholeScreen
|
||
GOSUB EddittTransGetLine
|
||
CASE CHR$(0) + "Q" 'Page Down
|
||
OldCurrString$ = CurrString$(1)
|
||
CurrRow = 1: PosCol = 1
|
||
CurrTopLine = CurrTopLine + 14
|
||
IF CurrTopLine > Fin THEN
|
||
CurrTopLine = Fin
|
||
END IF
|
||
|
||
GOSUB EddittTransPrintWholeScreen
|
||
GOSUB EddittTransGetLine
|
||
|
||
CASE CHR$(0) + "<" 'F2
|
||
finished = TRUE
|
||
CASE CHR$(0) + "C" 'F9
|
||
IF ekr = 0 THEN GOSUB EddittTransAddRecord
|
||
CASE CHR$(0) + "D" 'F10
|
||
IF ekr = 0 THEN GOSUB EddittTransDeleteRecord
|
||
CASE CHR$(13) 'Enter
|
||
CASE ELSE
|
||
BEEP
|
||
END SELECT
|
||
LOOP UNTIL finished
|
||
|
||
CLOSE
|
||
|
||
EXIT SUB
|
||
|
||
|
||
EddittTransShowCursor:
|
||
IF hide = 0 THEN
|
||
IF Iluminacion = 1 THEN
|
||
COLOR colors(2, ColorPref), colors(9, ColorPref)
|
||
ELSE
|
||
COLOR colors(8, ColorPref), colors(9, ColorPref)
|
||
END IF
|
||
ELSE
|
||
IF Iluminacion = 1 THEN
|
||
COLOR colors(2, ColorPref), colors(4, ColorPref)
|
||
ELSE
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
END IF
|
||
END IF
|
||
IF PosCol = 1 THEN LOCATE CurrRow + 10, col(1) ELSE LOCATE CurrRowFalse + 9, col(1) + 21
|
||
PRINT LEFT$(CurrString$(3), 15);
|
||
IF PosCol = 1 THEN LOCATE CurrRow + 10, col(2) ELSE LOCATE CurrRowFalse + 9, col(2) + 21
|
||
IF VAL(CurrString$(2)) <> 0 THEN
|
||
PRINT USING u2$; VAL(CurrString$(2));
|
||
ELSE
|
||
PRINT " ";
|
||
END IF
|
||
RETURN
|
||
|
||
EddittTransMoveUp:
|
||
IF CurrRow = 1 THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRow = CurrRow - 1
|
||
IF CurrRow >= 8 THEN
|
||
PosCol = 2
|
||
SELECT CASE CurrRow
|
||
CASE 8: CurrRowFalse = 2
|
||
CASE 9: CurrRowFalse = 3
|
||
CASE 10: CurrRowFalse = 4
|
||
CASE 11: CurrRowFalse = 5
|
||
CASE 12: CurrRowFalse = 6
|
||
CASE 13: CurrRowFalse = 7
|
||
CASE 14: CurrRowFalse = 8
|
||
CASE ELSE
|
||
END SELECT
|
||
ELSE
|
||
PosCol = 1
|
||
END IF
|
||
GOSUB EddittTransGetLine
|
||
END IF
|
||
IF CurrString$(1) = "1" OR OldCurrString$ = "1" THEN GOSUB EddittTransPrintLine
|
||
OldCurrString$ = CurrString$(1)
|
||
RETURN
|
||
|
||
EddittTransMoveDown:
|
||
IF (CurrRow + CurrTopLine - 1) >= Fin OR CurrRow = 14 THEN
|
||
BEEP
|
||
ELSE
|
||
IF CurrRow = 14 THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRow = CurrRow + 1
|
||
IF CurrRow >= 8 THEN
|
||
PosCol = 2
|
||
SELECT CASE CurrRow
|
||
CASE 8: CurrRowFalse = 2
|
||
CASE 9: CurrRowFalse = 3
|
||
CASE 10: CurrRowFalse = 4
|
||
CASE 11: CurrRowFalse = 5
|
||
CASE 12: CurrRowFalse = 6
|
||
CASE 13: CurrRowFalse = 7
|
||
CASE 14: CurrRowFalse = 8
|
||
CASE ELSE
|
||
END SELECT
|
||
ELSE
|
||
PosCol = 1
|
||
END IF
|
||
|
||
GOSUB EddittTransGetLine
|
||
END IF
|
||
END IF
|
||
|
||
IF CurrString$(1) = "1" OR OldCurrString$ = "1" THEN GOSUB EddittTransPrintLine
|
||
|
||
OldCurrString$ = CurrString$(1)
|
||
RETURN
|
||
|
||
EddittTransPrintLine:
|
||
|
||
IF Iluminacion = 1 THEN ColRes = 2 ELSE ColRes = 7
|
||
COLOR colors(ColRes, ColorPref), colors(4, ColorPref)
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
IF PosCol = 1 THEN
|
||
LOCATE CurrRow + 10, 36
|
||
ELSE
|
||
LOCATE CurrRowFalse + 9, 57
|
||
END IF
|
||
|
||
IF CurrRecord = Fin + 1 THEN
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
PRINT u1x$;
|
||
ELSEIF CurrRecord > Fin THEN
|
||
PRINT u1$;
|
||
ELSE
|
||
|
||
IF RTRIM$(LTRIM$(CurrString$(3))) = "" THEN PRINT " "; ELSE PRINT CurrString$(3) + " ";
|
||
IF VAL(CurrString$(2)) = 0 THEN PRINT " "; ELSE PRINT USING u2$; VAL(CurrString$(2));
|
||
IF Permiso <> 1 THEN
|
||
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
|
||
IF CurrString$(1) = "1" THEN
|
||
LOCATE 4, 36: IF RTRIM$(LTRIM$(Men$(1))) <> "" THEN PRINT Men$(1); ELSE PRINT SPC(40);
|
||
LOCATE 5, 36: PRINT SPC(40);
|
||
LOCATE 5, 36: IF RTRIM$(LTRIM$(Men$(2))) <> "" THEN PRINT Men$(2); ELSE PRINT SPC(40);
|
||
LOCATE 6, 36: IF RTRIM$(LTRIM$(Men$(3))) <> "" THEN PRINT Men$(3); ELSE PRINT SPC(40);
|
||
LOCATE 7, 36: IF RTRIM$(LTRIM$(Men$(4))) <> "" THEN PRINT Men$(4); ELSE PRINT SPC(40);
|
||
ELSE
|
||
LOCATE 4, 36: PRINT SPC(40);
|
||
LOCATE 5, 36: PRINT " Sin Comentarios ";
|
||
LOCATE 6, 36: PRINT SPC(40);
|
||
LOCATE 7, 36: PRINT SPC(40);
|
||
END IF
|
||
END IF
|
||
END IF
|
||
|
||
RETURN
|
||
|
||
|
||
|
||
EddittTransDeleteRecord:
|
||
|
||
IF TempMax = 1 OR MaximoVeinte = 1 THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
c = 1: ekr = 1
|
||
DO
|
||
GET #3, c + 1
|
||
IF VAL(IoTip$) = VAL(Tip$) THEN
|
||
IF CurrRecord = VAL(IoCurrTempTopLine$) THEN ekr = 0: EXIT DO
|
||
k = k + 1
|
||
END IF
|
||
c = c + 1
|
||
LOOP WHILE c <= TempMax
|
||
|
||
IF ekr = 0 THEN
|
||
|
||
ters = 1
|
||
DO
|
||
IF CurrTempTopLine(ters) = CurrRecord THEN CurrTempTopLine(ters) = 0: EXIT DO
|
||
ters = ters + 1
|
||
LOOP WHILE ters <= 20
|
||
|
||
TempMax = TempMax - 1
|
||
MaximoVeinte = MaximoVeinte - 1
|
||
|
||
a = c
|
||
WHILE a <= TempMax
|
||
GET #3, a + 2
|
||
PUT #3, a + 1
|
||
CurrTempTopLine(a) = CurrTempTopLine(a + 1)
|
||
a = a + 1
|
||
WEND
|
||
|
||
LSET IoTempValid$ = "*"
|
||
LSET IoMaxTempRecord$ = RTRIM$(LTRIM$(STR$(TempMax)))
|
||
PUT #3, 1
|
||
Iluminacion = 0
|
||
|
||
a = a + 1
|
||
WHILE a < MaximoVeinte
|
||
CurrTempTopLine(a) = CurrTempTopLine(a + 1)
|
||
a = a + 1
|
||
WEND
|
||
|
||
GOSUB EddittTransShowCursor
|
||
ELSE
|
||
ekr = 0
|
||
BEEP
|
||
END IF
|
||
|
||
END IF
|
||
RETURN
|
||
|
||
|
||
EddittTransAddRecord:
|
||
|
||
IF MaximoVeinte = 20 THEN
|
||
BEEP
|
||
ELSE
|
||
Parada = 0: JD = 1
|
||
DO
|
||
IF CurrTempTopLine(JD) = CurrRecord THEN Parada = 1: EXIT DO
|
||
JD = JD + 1
|
||
LOOP WHILE JD <= TempMax + 1
|
||
|
||
IF Parada = 0 THEN
|
||
TempMax = TempMax + 1
|
||
MaximoVeinte = MaximoVeinte + 1
|
||
IF TempMax <> 100 THEN
|
||
CurrTempTopLine(TempMax) = CurrRecord
|
||
LSET IoTip$ = RTRIM$(LTRIM$(Tip$))
|
||
LSET IoCurrTempTopLine$ = RTRIM$(LTRIM$(STR$(CurrRecord)))
|
||
LSET IoTempDesc$ = CurrString$(3)
|
||
PUT #3, TempMax + 1
|
||
LSET IoTempValid$ = "*"
|
||
LSET IoMaxTempRecord$ = RTRIM$(LTRIM$(STR$(TempMax)))
|
||
PUT #3, 1
|
||
Iluminacion = 1
|
||
hide = 0: GOSUB EddittTransShowCursor
|
||
ELSE
|
||
BEEP
|
||
END IF
|
||
ELSE
|
||
BEEP
|
||
END IF
|
||
END IF
|
||
RETURN
|
||
|
||
EddittTransPrintWholeScreen:
|
||
|
||
Permiso = 1
|
||
temp = CurrRow
|
||
|
||
FOR CurrRow = 1 TO 14
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
IF CurrRecord <= Fin THEN
|
||
GOSUB EddittTransGetLine
|
||
END IF
|
||
IF CurrRow >= 8 THEN
|
||
PosCol = 2
|
||
SELECT CASE CurrRow
|
||
CASE 8: CurrRowFalse = 2
|
||
CASE 9: CurrRowFalse = 3
|
||
CASE 10: CurrRowFalse = 4
|
||
CASE 11: CurrRowFalse = 5
|
||
CASE 12: CurrRowFalse = 6
|
||
CASE 13: CurrRowFalse = 7
|
||
CASE 14: CurrRowFalse = 8
|
||
CASE ELSE
|
||
END SELECT
|
||
END IF
|
||
|
||
GOSUB EddittTransPrintLine
|
||
PosCol = 1
|
||
NEXT CurrRow
|
||
Permiso = 0
|
||
CurrRow = temp
|
||
RETURN
|
||
|
||
|
||
EddittTransGetLine:
|
||
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
GET #1, CurrRecord + 1
|
||
Clase$ = RTRIM$(LTRIM$(IoClase$))
|
||
CurrString$(1) = IoCod$
|
||
CurrString$(3) = IoDesc$
|
||
CurrString$(2) = IoPos$
|
||
IF CurrString$(1) = "1" THEN
|
||
c = 0: P = 0
|
||
DO
|
||
c = c + 1
|
||
GET #1, c + 1
|
||
IF IoCod$ = "1" THEN P = P + 1
|
||
IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN
|
||
GET #2, P + 1
|
||
Men$(1) = IoMenI$
|
||
Men$(2) = IoMenII$
|
||
Men$(3) = IoMenIII$
|
||
Men$(4) = IoMenIV$
|
||
EXIT DO
|
||
END IF
|
||
LOOP WHILE c <= MaxRecord
|
||
END IF
|
||
|
||
Iluminacion = 0: JD = 1
|
||
DO
|
||
IF CurrTempTopLine(JD) = CurrRecord THEN Iluminacion = 1: EXIT DO
|
||
JD = JD + 1
|
||
LOOP WHILE JD <= TempMax
|
||
RETURN
|
||
|
||
ErrNoFound:
|
||
COLOR 14, 4: sombra = 1
|
||
Box 19, 2, 23, 76
|
||
sombra = 0
|
||
COLOR 11, 4: LOCATE 20, 5: PRINT "ATENCIàN!!! Se produjo un error que hab¡a previsto. E.L.T"
|
||
COLOR 15, 4: LOCATE 21, 5: PRINT "Soluci¢n: Llama al (95)- 561.08.91 , INFORMAME... "
|
||
COLOR 15, 4: LOCATE 22, 5: PRINT "Se desviaran las funciones PRINCIPALES de intercambio TEMPORAL"
|
||
COLOR colors(2, ColorPref), colors(1, ColorPref)
|
||
SLEEP
|
||
RETURN
|
||
|
||
END SUB
|
||
|
||
SUB EscogeSeccion
|
||
ON ERROR GOTO ERRORTRAP
|
||
'Stores info about each column
|
||
REDIM Help$(10), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5), Choice$(10), menuRow(10), menuCol(10)
|
||
'Array to keep the current balance at all the transactions
|
||
REDIM Balance#(1000)
|
||
|
||
Choice$(1) = " Juegos "
|
||
Choice$(2) = " M£sica "
|
||
Choice$(3) = " Procesadores de textos "
|
||
Choice$(4) = " Pgr. Contabilidad "
|
||
Choice$(5) = " Pgr. Electronica "
|
||
Choice$(6) = " Gr ficos "
|
||
Choice$(7) = " Utilidades "
|
||
Choice$(8) = " Lenguajes "
|
||
Choice$(9) = " Windows "
|
||
Choice$(10) = " Otros... "
|
||
|
||
FOR T = 1 TO 10
|
||
Help$(T) = RTRIM$(Choice$(T))
|
||
NEXT
|
||
|
||
menuRow(1) = 4: menuCol(1) = 3
|
||
menuRow(2) = 5: menuCol(2) = 3
|
||
menuRow(3) = 6: menuCol(3) = 3
|
||
menuRow(4) = 7: menuCol(4) = 3
|
||
menuRow(5) = 8: menuCol(5) = 3
|
||
menuRow(6) = 9: menuCol(6) = 3
|
||
menuRow(7) = 10: menuCol(7) = 3
|
||
menuRow(8) = 11: menuCol(8) = 3
|
||
menuRow(9) = 12: menuCol(9) = 3
|
||
menuRow(10) = 13: menuCol(10) = 3
|
||
|
||
FancyCls colors(2, ColorPref), colors(1, ColorPref)
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
sombra = 1: BorraPantalla = 1
|
||
Box 16, 2, 18, 29
|
||
LOCATE 17, 7: PRINT "Seleccione Secci¢n"
|
||
AnulTecl = 1
|
||
sbchce = Menu(1, 10, Choice$(), menuRow(), menuCol(), Help$(), FALSE)
|
||
AnulTecl = 0: BorraPantalla = 0
|
||
LOCATE 17, 4: PRINT Choice$(sbchce);
|
||
Box 3, 35, 8, 76
|
||
Box 10, 35, 18, 76
|
||
sombra = 0
|
||
IF sbchce <> 10 THEN TempClase$ = STR$(sbchce) ELSE TempClase$ = "0"
|
||
SELECT CASE sbchce
|
||
CASE 1
|
||
file$ = "Datos-1.dat"
|
||
file2$ = "DaTM-1.dat"
|
||
CASE 2 TO 5
|
||
file$ = "Datos-2.dat"
|
||
file2$ = "DaTM-2.dat"
|
||
CASE 6 TO 10
|
||
file$ = "Datos-3.dat"
|
||
file2$ = "DaTM-3.dat"
|
||
|
||
CASE ELSE
|
||
END SELECT
|
||
|
||
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 ImprCom (TipodeImpresion%)
|
||
ON ERROR GOTO ERRORTRAP
|
||
'Stores info about each column
|
||
'Array to keep the current balance at all the transactions
|
||
DIM Choice$(2), menuRow(2), Help$(2), menuCol(2), CurrString$(3), Men$(4)
|
||
|
||
Choice$(1) = " 1 Columna "
|
||
Choice$(2) = " 3 Columnas "
|
||
|
||
menuRow(1) = 7: menuCol(1) = 35
|
||
menuRow(2) = 8: menuCol(2) = 35
|
||
|
||
Help$(1) = "Imprimir en una columna junto con los comentarios correspondientes"
|
||
Help$(2) = "Imprimir en 3 columnas"
|
||
|
||
SubChoice = Menu(1, 2, Choice$(), menuRow(), menuCol(), Help$(), FALSE)
|
||
Columnas = SubChoice
|
||
|
||
lineaimpresas = 1
|
||
PrintErr = FALSE
|
||
ON ERROR GOTO ERRORTRAP ' test if printer is connected
|
||
LPRINT
|
||
|
||
|
||
IF PrintErr = FALSE THEN
|
||
|
||
|
||
IF TipodeImpresion% = 0 THEN ittem% = 1 ELSE ittem% = TipodeImpresion%
|
||
|
||
DO
|
||
PosicionImpresa = 1
|
||
GOSUB EscogeFichero
|
||
|
||
Vld$ = ""
|
||
|
||
OPEN file$ FOR RANDOM AS #1 LEN = 25
|
||
OPEN file2$ FOR RANDOM AS #2 LEN = 165
|
||
|
||
FIELD #1, 1 AS IoClase$, 1 AS IoCod$, 15 AS IoDesc$, 3 AS IoPos$
|
||
FIELD #1, 1 AS Valid$, 4 AS IoMaxRecord$
|
||
|
||
FIELD #2, 40 AS IoMenI$, 40 AS IoMenII$, 40 AS IoMenIII$, 40 AS IoMenIV$
|
||
FIELD #2, 1 AS Vld$, 4 AS IoMxRcrd$
|
||
|
||
GET #1, 1
|
||
|
||
|
||
IF Valid$ = "*" THEN
|
||
|
||
MaxRecord = VAL(IoMaxRecord$)
|
||
c = 1: Inicio = 0: Fin = 0: ves = 0
|
||
|
||
DO
|
||
GET #1, c + 1
|
||
IF VAL(IoClase$) = VAL(TempClase$) THEN
|
||
IF ves = 0 THEN Inicio = c: ves = 1 ELSE Fin = Fin + 1
|
||
END IF
|
||
c = c + 1
|
||
LOOP WHILE c <= MaxRecord
|
||
|
||
Fin = Fin + Inicio
|
||
|
||
|
||
IF Inicio <> 0 THEN
|
||
IF lineaimpresas >= 50 THEN GOSUB paradeimprimir
|
||
OPEN "lpt1:" FOR OUTPUT AS #3
|
||
PRINT #3, CHR$(13)
|
||
SELECT CASE ittem%
|
||
CASE 1: PRINT #3, CHR$(27); "!"; CHR$(32); " Juegos "
|
||
CASE 2: PRINT #3, CHR$(27); "!"; CHR$(32); " M£sica "
|
||
CASE 3: PRINT #3, CHR$(27); "!"; CHR$(32); " Procesadores de textos "
|
||
CASE 4: PRINT #3, CHR$(27); "!"; CHR$(32); " Pgr. Contabilidad "
|
||
CASE 5: PRINT #3, CHR$(27); "!"; CHR$(32); " Pgr. Electronica "
|
||
CASE 6: PRINT #3, CHR$(27); "!"; CHR$(32); " Gr ficos "
|
||
CASE 7: PRINT #3, CHR$(27); "!"; CHR$(32); " Utilidades "
|
||
CASE 8: PRINT #3, CHR$(27); "!"; CHR$(32); " Lenguajes "
|
||
CASE 9: PRINT #3, CHR$(27); "!"; CHR$(32); " Windows "
|
||
CASE 10: PRINT #3, CHR$(27); "!"; CHR$(32); " Otros... "
|
||
CASE ELSE
|
||
END SELECT
|
||
PRINT #3, CHR$(27); "!"; CHR$(1);
|
||
CLOSE #3
|
||
lineaimpresas = lineaimpresas + 1
|
||
CurrTopLine = Inicio
|
||
PosCol = 1
|
||
CurrRow = 0
|
||
|
||
|
||
DO
|
||
CurrRow = CurrRow + 1
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
|
||
IF CurrRecord <= Fin THEN
|
||
|
||
GET #1, CurrRecord + 1
|
||
Clase$ = RTRIM$(LTRIM$(IoClase$))
|
||
CurrString$(1) = IoCod$
|
||
CurrString$(3) = IoDesc$
|
||
CurrString$(2) = IoPos$
|
||
|
||
IF CurrString$(1) = "1" AND Columnas = 1 THEN
|
||
c = 0: P = 0
|
||
|
||
DO
|
||
IF lineaimpresas = 55 THEN GOSUB paradeimprimir
|
||
c = c + 1
|
||
GET #1, c + 1
|
||
IF IoCod$ = "1" THEN P = P + 1
|
||
IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN
|
||
GET #2, P + 1
|
||
Men$(1) = IoMenI$
|
||
Men$(2) = IoMenII$
|
||
Men$(3) = IoMenIII$
|
||
Men$(4) = IoMenIV$
|
||
EXIT DO
|
||
END IF
|
||
LOOP WHILE c <= MaxRecord
|
||
|
||
END IF
|
||
GOSUB SeleccionaColumna
|
||
|
||
ELSE
|
||
EXIT DO
|
||
END IF
|
||
|
||
LOOP
|
||
|
||
|
||
END IF
|
||
END IF
|
||
CLOSE
|
||
|
||
ittem% = ittem% + 1
|
||
LOOP WHILE ittem% <= 10 AND TipodeImpresion% = 0
|
||
|
||
|
||
END IF
|
||
CLOSE
|
||
LPRINT
|
||
OPEN "Mensaje.Cat" FOR RANDOM AS #1 LEN = 201
|
||
|
||
FIELD #1, 40 AS IoLine1$, 40 AS IoLine2$, 40 AS IoLine3$, 40 AS IoLine4$, 40 AS IoLine5$
|
||
FIELD #1, 1 AS Valid$
|
||
|
||
OPEN "lpt1:" FOR OUTPUT AS #3
|
||
PRINT #3, CHR$(27); "!"; CHR$(32);
|
||
GET #1, 1
|
||
IF Valid$ = "*" THEN
|
||
GET #1, 2
|
||
LPRINT IoLine1$
|
||
LPRINT IoLine2$
|
||
LPRINT IoLine3$
|
||
LPRINT IoLine4$
|
||
LPRINT IoLine5$
|
||
END IF
|
||
CLOSE
|
||
|
||
EXIT SUB
|
||
|
||
|
||
|
||
paradeimprimir:
|
||
Box 20, 2, 23, 76
|
||
COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN: La impresora esta apunto de quedarse sin papel."
|
||
COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Ponga papel, y pulse una tecla para continuar. "
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
SLEEP
|
||
ON ERROR GOTO ERRORTRAP ' test if printer is connected
|
||
LPRINT
|
||
IF PrintErr = FALSE THEN
|
||
lineaimpresas = 1
|
||
RETURN
|
||
ELSE
|
||
EXIT SUB
|
||
END IF
|
||
|
||
EscogeFichero:
|
||
|
||
SELECT CASE ittem%
|
||
CASE 1
|
||
file$ = "Datos-1.dat"
|
||
file2$ = "DaTM-1.dat"
|
||
CASE 2 TO 5
|
||
file$ = "Datos-2.dat"
|
||
file2$ = "DaTM-2.dat"
|
||
CASE 6 TO 10
|
||
file$ = "Datos-3.dat"
|
||
file2$ = "DaTM-3.dat"
|
||
|
||
CASE ELSE
|
||
COLOR 14, 4: sombra = 1
|
||
Box 20, 2, 23, 76
|
||
sombra = 0
|
||
COLOR 11, 4: LOCATE 21, 5: PRINT "ATENCIàN!!! Se produjo un error que no hab¡a previsto. E.C.1"
|
||
COLOR 15, 4: LOCATE 22, 5: PRINT "Soluci¢n: Llama al (95)- 561.08.91 , INFORMAME... "
|
||
COLOR colors(2, ColorPref), colors(1, ColorPref)
|
||
SLEEP
|
||
SYSTEM
|
||
END SELECT
|
||
IF ittem% <> 10 THEN TempClase$ = STR$(ittem%) ELSE TempClase$ = "0"
|
||
RETURN
|
||
|
||
|
||
SeleccionaColumna:
|
||
SELECT CASE Columnas
|
||
CASE 1
|
||
IF CurrString$(1) = "1" THEN
|
||
LPRINT
|
||
LPRINT CurrString$(3); " "; CurrString$(2); " "; Men$(1)
|
||
LPRINT TAB(25); Men$(2)
|
||
LPRINT TAB(25); Men$(3)
|
||
LPRINT TAB(25); Men$(4)
|
||
lineaimpresas = lineaimpresas + 5
|
||
PosicionImpresa = 1
|
||
|
||
ELSE
|
||
SELECT CASE PosicionImpresa
|
||
CASE 1: LPRINT CurrString$(3); " "; CurrString$(2); : PosicionImpresa = 2
|
||
CASE 2: LPRINT " ³ "; CurrString$(3); " "; CurrString$(2); : PosicionImpresa = 3
|
||
CASE 3: LPRINT " ³ "; CurrString$(3); " "; CurrString$(2): PosicionImpresa = 1
|
||
|
||
CASE ELSE
|
||
END SELECT
|
||
lineaimpresas = lineaimpresas + 1
|
||
END IF
|
||
|
||
CASE 2
|
||
SELECT CASE PosicionImpresa
|
||
CASE 1: LPRINT CurrString$(3); " "; CurrString$(2); : PosicionImpresa = 2
|
||
CASE 2: LPRINT " ³ "; CurrString$(3); " "; CurrString$(2); : PosicionImpresa = 3
|
||
CASE 3: LPRINT " ³ "; CurrString$(3); " "; CurrString$(2): PosicionImpresa = 1
|
||
|
||
CASE ELSE
|
||
END SELECT
|
||
lineaimpresas = lineaimpresas + 1
|
||
CASE ELSE
|
||
END SELECT
|
||
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
|
||
|
||
END SUB
|
||
|
||
'LoadState:
|
||
' Load color preferences and account info from MONEY.DAT
|
||
SUB LoadState
|
||
DEFINT A-Z
|
||
OPEN "Catalogo.CFG" FOR INPUT AS #1
|
||
INPUT #1, ColorPref
|
||
INPUT #1, Poseedor$
|
||
INPUT #1, Password$
|
||
CLOSE
|
||
Password# = VAL(RIGHT$(Password$, LEN(Password$) - 1)) / VAL(LEFT$(Password$, 1)) / 7
|
||
|
||
END SUB
|
||
|
||
SUB MasMenosProg
|
||
|
||
ON ERROR GOTO ERRORTRAP
|
||
'Stores info about each column
|
||
REDIM Help$(10), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5), Choice$(10), menuRow(10), menuCol(10), Men$(4), f(2)
|
||
'Array to keep the current balance at all the transactions
|
||
REDIM Balance#(1000)
|
||
|
||
EscogeSeccion
|
||
Vld$ = ""
|
||
OPEN file$ FOR RANDOM AS #1 LEN = 25
|
||
OPEN file2$ FOR RANDOM AS #2 LEN = 165
|
||
|
||
FIELD #1, 1 AS IoClase$, 1 AS IoCod$, 15 AS IoDesc$, 3 AS IoPos$
|
||
FIELD #1, 1 AS Valid$, 4 AS IoMaxRecord$
|
||
|
||
FIELD #2, 40 AS IoMenI$, 40 AS IoMenII$, 40 AS IoMenIII$, 40 AS IoMenIV$
|
||
FIELD #2, 1 AS Vld$, 4 AS IoMxRcrd$
|
||
|
||
GET #1, 1
|
||
IF Valid$ <> "*" THEN
|
||
LSET IoClase$ = "þ"
|
||
LSET IoCod$ = ""
|
||
LSET IoDesc$ = ""
|
||
LSET IoPos$ = ""
|
||
PUT #1, 2
|
||
LSET Valid$ = "*"
|
||
LSET IoMaxRecord$ = "1"
|
||
PUT #1, 1
|
||
END IF
|
||
|
||
GET #2, 1
|
||
IF Vld$ <> "*" THEN
|
||
LSET IoMenI$ = ""
|
||
LSET IoMenII$ = ""
|
||
LSET IoMenIII$ = ""
|
||
LSET IoMenIV$ = ""
|
||
PUT #2, 2
|
||
LSET Vld$ = "*"
|
||
LSET IoMxRcrd$ = "1"
|
||
PUT #2, 1
|
||
END IF
|
||
|
||
'Initialize variables
|
||
CurrString$(1) = ""
|
||
CurrString$(2) = ""
|
||
CurrString$(3) = ""
|
||
MaxRecord = VAL(IoMaxRecord$)
|
||
|
||
c = 1: Inicio = 0: Fin = 0
|
||
DO
|
||
GET #1, c + 1
|
||
IF VAL(IoClase$) = VAL(TempClase$) THEN
|
||
IF ves = 0 THEN Inicio = c: ves = 1 ELSE Fin = Fin + 1
|
||
END IF
|
||
c = c + 1
|
||
LOOP WHILE c <= MaxRecord
|
||
Fin = Fin + Inicio
|
||
IF Inicio = 0 THEN
|
||
CurrTopLine = MaxRecord + 1
|
||
GOSUB EditTransAddRecord
|
||
Inicio = MaxRecord
|
||
Fin = MaxRecord
|
||
END IF
|
||
|
||
|
||
Help$(1) = "Nombre del Programa (15 dig.) "
|
||
Help$(2) = "N§ Kb, Mb, Diskettes... "
|
||
|
||
col(1) = 36 'La constante para la segunda columna es 21
|
||
col(2) = 52
|
||
|
||
Vis(1) = 15
|
||
Vis(2) = 3
|
||
|
||
Max(1) = 15
|
||
Max(2) = 3
|
||
|
||
'Draw Screen
|
||
|
||
u$ = "\ \ \ \"
|
||
u1$ = " "
|
||
u1x$ = "ßßßßßßßßßßßßßßß ßßß"
|
||
u2$ = "###"
|
||
|
||
CurrTopLine = Inicio
|
||
PosCol = 1
|
||
CurrRow = 1
|
||
CurrCol = 1
|
||
GOSUB EditTransPrintWholeScreen
|
||
|
||
PrintHelpLine Help$(CurrCol) + "| <F2=Salir> <F9=Insert> <F10=Supr> <F3=A.Mensaje>"
|
||
|
||
GOSUB EditTransGetLine
|
||
GOSUB EditTransPrintLine
|
||
OldCurrString$ = CurrString$(1)
|
||
|
||
finished = FALSE
|
||
|
||
|
||
'Loop until <F2> is pressed
|
||
DO
|
||
hide = 0: GOSUB EditTransShowCursor 'Show Cursor, Wait for key
|
||
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
|
||
hide = 1: GOSUB EditTransShowCursor
|
||
|
||
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 - 1
|
||
IF CurrCol = 0 THEN CurrCol = 2
|
||
PrintHelpLine Help$(CurrCol) + "| <F2=Salir> <F9=Insert> <F10=Supr> <F3=A.Mensaje>"
|
||
CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab
|
||
CurrCol = CurrCol + 1
|
||
IF CurrCol = 3 THEN CurrCol = 1
|
||
PrintHelpLine Help$(CurrCol) + "| <F2=Salir> <F9=Insert> <F10=Supr> <F3=A.Mensaje>"
|
||
|
||
CASE CHR$(0) + "=" 'F3
|
||
hide = 0: GOSUB EditTransShowCursor 'Show Cursor, Wait for key
|
||
TempCurrString$ = CurrString$(1)
|
||
CurrString$(1) = "1"
|
||
GOSUB PideComentario
|
||
GOSUB EditTransPutLine
|
||
CurrString$ = "1"
|
||
OldCurrString$ = "1"
|
||
PrintHelpLine Help$(CurrCol) + "| <F2=Salir> <F9=Insert> <F10=Supr> <F3=A.Mensaje>"
|
||
|
||
CASE CHR$(0) + "G" 'Home
|
||
CurrCol = 1
|
||
CASE CHR$(0) + "O" 'End
|
||
CurrCol = 2
|
||
CASE CHR$(0) + "I" 'Page Up
|
||
OldCurrString$ = CurrString$(1)
|
||
CurrRow = 1: PosCol = 1
|
||
CurrTopLine = CurrTopLine - 14
|
||
IF CurrTopLine < Inicio THEN
|
||
CurrTopLine = Inicio
|
||
END IF
|
||
GOSUB EditTransPrintWholeScreen
|
||
GOSUB EditTransGetLine
|
||
CASE CHR$(0) + "Q" 'Page Down
|
||
OldCurrString$ = CurrString$(1)
|
||
CurrRow = 1: PosCol = 1
|
||
CurrTopLine = CurrTopLine + 14
|
||
IF CurrTopLine > Fin THEN
|
||
CurrTopLine = Fin
|
||
END IF
|
||
|
||
GOSUB EditTransPrintWholeScreen
|
||
GOSUB EditTransGetLine
|
||
|
||
CASE CHR$(0) + "<" 'F2
|
||
finished = TRUE
|
||
CASE CHR$(0) + "C" 'F9
|
||
GOSUB EditTransAddRecord
|
||
OldCurrString$ = "1"
|
||
CASE CHR$(0) + "D" 'F10
|
||
GOSUB EditTransDeleteRecord
|
||
OldCurrString$ = "1"
|
||
CASE CHR$(13) 'Enter
|
||
CASE ELSE
|
||
BEEP
|
||
END SELECT
|
||
LOOP UNTIL finished
|
||
|
||
CLOSE
|
||
|
||
EXIT SUB
|
||
|
||
|
||
EditTransShowCursor:
|
||
IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
IF PosCol = 1 THEN LOCATE CurrRow + 10, col(CurrCol) ELSE LOCATE CurrRowFalse + 9, col(CurrCol) + 21
|
||
SELECT CASE CurrCol
|
||
CASE 1
|
||
PRINT LEFT$(CurrString$(3), 15);
|
||
CASE 2
|
||
IF VAL(CurrString$(2)) <> 0 THEN
|
||
PRINT USING u2$; VAL(CurrString$(2));
|
||
ELSE
|
||
PRINT " ";
|
||
END IF
|
||
END SELECT
|
||
RETURN
|
||
|
||
EditTransEditItem:
|
||
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
COLOR colors(8, ColorPref), colors(9, ColorPref)
|
||
IF PosCol = 1 THEN CrrRw = CurrRow: f(1) = col(1): f(2) = col(2) ELSE CrrRw = CurrRowFalse - 1: f(1) = col(1) + 21: f(2) = col(2) + 21
|
||
SELECT CASE CurrCol
|
||
|
||
CASE 1
|
||
IF RTRIM$(LTRIM$(CurrString$(3))) <> "" THEN Start$ = CurrString$(3) + kbd$ ELSE Start$ = kbd$
|
||
kbd$ = GetString$(CrrRw + 10, f(1), Start$, new$, Vis(CurrCol), Max(CurrCol))
|
||
CurrString$(3) = new$
|
||
GOSUB EditTransPutLine
|
||
GOSUB EditTransGetLine
|
||
CASE 2
|
||
Start$ = kbd$
|
||
DO
|
||
kbd$ = GetString$(CrrRw + 10, f(2), Start$, new$, Vis(2), Max(2))
|
||
new2# = VAL(new$)
|
||
Start$ = ""
|
||
LOOP WHILE new2# >= 999# OR new4# < 0
|
||
CurrString$(2) = new$
|
||
GOSUB EditTransPutLine
|
||
GOSUB EditTransGetLine
|
||
CASE ELSE
|
||
END SELECT
|
||
GOSUB EditTransPrintLine
|
||
RETURN
|
||
|
||
EditTransMoveUp:
|
||
IF CurrRow = 1 THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRow = CurrRow - 1
|
||
IF CurrRow >= 8 THEN
|
||
PosCol = 2
|
||
SELECT CASE CurrRow
|
||
CASE 8: CurrRowFalse = 2
|
||
CASE 9: CurrRowFalse = 3
|
||
CASE 10: CurrRowFalse = 4
|
||
CASE 11: CurrRowFalse = 5
|
||
CASE 12: CurrRowFalse = 6
|
||
CASE 13: CurrRowFalse = 7
|
||
CASE 14: CurrRowFalse = 8
|
||
CASE ELSE
|
||
END SELECT
|
||
ELSE
|
||
PosCol = 1
|
||
END IF
|
||
|
||
GOSUB EditTransGetLine
|
||
END IF
|
||
IF CurrString$(1) = "1" OR OldCurrString$ = "1" THEN GOSUB EditTransPrintLine
|
||
OldCurrString$ = CurrString$(1)
|
||
RETURN
|
||
|
||
EditTransMoveDown:
|
||
IF (CurrRow + CurrTopLine - 1) >= Fin OR CurrRow = 14 THEN
|
||
BEEP
|
||
ELSE
|
||
IF CurrRow = 14 THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRow = CurrRow + 1
|
||
IF CurrRow >= 8 THEN
|
||
PosCol = 2
|
||
SELECT CASE CurrRow
|
||
CASE 8: CurrRowFalse = 2
|
||
CASE 9: CurrRowFalse = 3
|
||
CASE 10: CurrRowFalse = 4
|
||
CASE 11: CurrRowFalse = 5
|
||
CASE 12: CurrRowFalse = 6
|
||
CASE 13: CurrRowFalse = 7
|
||
CASE 14: CurrRowFalse = 8
|
||
CASE ELSE
|
||
END SELECT
|
||
ELSE
|
||
PosCol = 1
|
||
END IF
|
||
|
||
GOSUB EditTransGetLine
|
||
END IF
|
||
END IF
|
||
|
||
IF CurrString$(1) = "1" OR OldCurrString$ = "1" THEN GOSUB EditTransPrintLine
|
||
OldCurrString$ = CurrString$(1)
|
||
RETURN
|
||
|
||
EditTransPrintLine:
|
||
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
IF PosCol = 1 THEN
|
||
LOCATE CurrRow + 10, 36
|
||
ELSE
|
||
LOCATE CurrRowFalse + 9, 57
|
||
END IF
|
||
|
||
IF CurrRecord = Fin + 1 THEN
|
||
PRINT u1x$;
|
||
ELSEIF CurrRecord > Fin THEN
|
||
PRINT u1$;
|
||
ELSE
|
||
|
||
IF RTRIM$(LTRIM$(CurrString$(3))) = "" THEN PRINT " "; ELSE PRINT CurrString$(3) + " ";
|
||
IF VAL(CurrString$(2)) = 0 THEN PRINT " "; ELSE PRINT USING u2$; VAL(CurrString$(2));
|
||
IF Permiso <> 1 THEN
|
||
IF CurrString$(1) = "1" THEN
|
||
LOCATE 4, 36: IF RTRIM$(LTRIM$(Men$(1))) <> "" THEN PRINT Men$(1); ELSE PRINT SPC(40);
|
||
LOCATE 5, 36: PRINT SPC(40);
|
||
LOCATE 5, 36: IF RTRIM$(LTRIM$(Men$(2))) <> "" THEN PRINT Men$(2); ELSE PRINT SPC(40);
|
||
LOCATE 6, 36: IF RTRIM$(LTRIM$(Men$(3))) <> "" THEN PRINT Men$(3); ELSE PRINT SPC(40);
|
||
LOCATE 7, 36: IF RTRIM$(LTRIM$(Men$(4))) <> "" THEN PRINT Men$(4); ELSE PRINT SPC(40);
|
||
ELSE
|
||
LOCATE 4, 36: PRINT SPC(40);
|
||
LOCATE 5, 36: PRINT " Sin Comentarios ";
|
||
LOCATE 6, 36: PRINT SPC(40);
|
||
LOCATE 7, 36: PRINT SPC(40);
|
||
END IF
|
||
END IF
|
||
END IF
|
||
|
||
RETURN
|
||
|
||
|
||
EditTransDeleteRecord:
|
||
IF Fin = 1 THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
Fin = Fin - 1
|
||
MaxRecord = MaxRecord - 1
|
||
IF CurrString$(1) = "1" THEN
|
||
c = 0: P = 0
|
||
GET #2, 1
|
||
Tam = VAL(IoMxRcrd$)
|
||
DO
|
||
c = c + 1
|
||
GET #1, c + 1
|
||
IF IoCod$ = "1" THEN P = P + 1
|
||
IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN
|
||
|
||
WHILE P <= Tam - 1
|
||
GET #2, P + 2
|
||
PUT #2, P + 1
|
||
P = P + 1
|
||
WEND
|
||
EXIT DO
|
||
END IF
|
||
LOOP WHILE c <= MaxRecord
|
||
LSET Vld$ = "*"
|
||
LSET IoMxRcrd$ = STR$(Tam - 1)
|
||
PUT #2, 1
|
||
END IF
|
||
|
||
a = CurrRecord
|
||
|
||
WHILE a <= MaxRecord
|
||
GET #1, a + 2
|
||
PUT #1, a + 1
|
||
a = a + 1
|
||
WEND
|
||
|
||
LSET Valid$ = "*"
|
||
LSET IoMaxRecord$ = STR$(MaxRecord)
|
||
PUT #1, 1
|
||
|
||
TempRowFalse = CurrRowFalse: TempCurrRow = CurrRow
|
||
TempPosCol = PosCol
|
||
GOSUB EditTransPrintWholeScreen
|
||
PosCol = TempPosCol: CurrRowFalse = TempRowFalse
|
||
CurrRow = TempCurrRow
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
|
||
IF CurrRecord > MaxRecord THEN
|
||
GOSUB EditTransMoveUp
|
||
END IF
|
||
GOSUB EditTransGetLine
|
||
CurrString$ = "1"
|
||
OldCurrString$ = "1"
|
||
GOSUB EditTransPrintLine
|
||
END IF
|
||
RETURN
|
||
|
||
EditTransAddRecord:
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
a = MaxRecord
|
||
WHILE a > CurrRecord
|
||
GET #1, a + 1
|
||
PUT #1, a + 2
|
||
a = a - 1
|
||
WEND
|
||
|
||
MaxRecord = MaxRecord + 1
|
||
Fin = Fin + 1
|
||
LSET IoClase$ = RTRIM$(LTRIM$(TempClase$))
|
||
LSET IoCod$ = ""
|
||
LSET IoPos$ = ""
|
||
LSET IoDesc$ = ""
|
||
PUT #1, CurrRecord + 2
|
||
|
||
LSET Valid$ = "*"
|
||
LSET IoMaxRecord$ = STR$(MaxRecord)
|
||
PUT #1, 1
|
||
TempRow = CurrRow
|
||
TempPosCol = PosCol: TempRowFalse = CurrRowFalse
|
||
GOSUB EditTransPrintWholeScreen
|
||
PosCol = TempPosCol: CurrRowFalse = TempRowFalse
|
||
CurrRow = TempRow
|
||
GOSUB EditTransGetLine
|
||
RETURN
|
||
|
||
EditTransPrintWholeScreen:
|
||
|
||
Permiso = 1
|
||
temp = CurrRow
|
||
|
||
FOR CurrRow = 1 TO 14
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
IF CurrRecord <= Fin THEN
|
||
GOSUB EditTransGetLine
|
||
END IF
|
||
IF CurrRow >= 8 THEN
|
||
PosCol = 2
|
||
SELECT CASE CurrRow
|
||
CASE 8: CurrRowFalse = 2
|
||
CASE 9: CurrRowFalse = 3
|
||
CASE 10: CurrRowFalse = 4
|
||
CASE 11: CurrRowFalse = 5
|
||
CASE 12: CurrRowFalse = 6
|
||
CASE 13: CurrRowFalse = 7
|
||
CASE 14: CurrRowFalse = 8
|
||
CASE ELSE
|
||
END SELECT
|
||
END IF
|
||
|
||
GOSUB EditTransPrintLine
|
||
PosCol = 1
|
||
NEXT CurrRow
|
||
Permiso = 0
|
||
CurrRow = temp
|
||
RETURN
|
||
|
||
EditTransPutLine:
|
||
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
|
||
GET #1, CurrRecord + 1
|
||
Dezplazamiento = 0
|
||
IF IoCod$ <> CurrString$(1) THEN
|
||
Dezplazamiento = 1
|
||
GET #2, 1
|
||
IOMR$ = IoMxRcrd$
|
||
IOMR = VAL(IOMR$)
|
||
LSET Vld$ = "*"
|
||
LSET IoMxRcrd$ = STR$(VAL(IOMR$) + 1)
|
||
PUT #2, 1
|
||
|
||
END IF
|
||
|
||
LSET IoClase$ = RTRIM$(LTRIM$(TempClase$))
|
||
LSET IoCod$ = CurrString$(1)
|
||
LSET IoDesc$ = CurrString$(3)
|
||
LSET IoPos$ = CurrString$(2)
|
||
PUT #1, CurrRecord + 1
|
||
|
||
IF CurrString$(1) = "1" THEN
|
||
c = 0: P = 0
|
||
DO
|
||
c = c + 1
|
||
GET #1, c + 1
|
||
IF IoCod$ = "1" THEN P = P + 1
|
||
IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN
|
||
|
||
IF Dezplazamiento = 1 THEN
|
||
a = IOMR
|
||
WHILE a > P - 1
|
||
GET #2, a + 1
|
||
PUT #2, a + 2
|
||
a = a - 1
|
||
WEND
|
||
END IF
|
||
LSET IoMenI$ = Men$(1)
|
||
LSET IoMenII$ = Men$(2)
|
||
LSET IoMenIII$ = Men$(3)
|
||
LSET IoMenIV$ = Men$(4)
|
||
PUT #2, P + 1
|
||
EXIT DO
|
||
END IF
|
||
LOOP WHILE c <= MaxRecord
|
||
END IF
|
||
|
||
RETURN
|
||
|
||
EditTransGetLine:
|
||
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
GET #1, CurrRecord + 1
|
||
Clase$ = RTRIM$(LTRIM$(IoClase$))
|
||
CurrString$(1) = IoCod$
|
||
CurrString$(3) = IoDesc$
|
||
CurrString$(2) = IoPos$
|
||
IF CurrString$(1) = "1" THEN
|
||
c = 0: P = 0
|
||
DO
|
||
c = c + 1
|
||
GET #1, c + 1
|
||
IF IoCod$ = "1" THEN P = P + 1
|
||
IF IoDesc$ = CurrString$(3) AND VAL(IoClase$) = VAL(TempClase$) THEN
|
||
GET #2, P + 1
|
||
Men$(1) = IoMenI$
|
||
Men$(2) = IoMenII$
|
||
Men$(3) = IoMenIII$
|
||
Men$(4) = IoMenIV$
|
||
EXIT DO
|
||
END IF
|
||
LOOP WHILE c <= MaxRecord
|
||
END IF
|
||
RETURN
|
||
|
||
PideComentario:
|
||
|
||
IF TempCurrString$ <> "1" THEN FOR yitu = 1 TO 4: Men$(yitu) = "": NEXT
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
LOCATE 5, 36: PRINT Men$(CrRw); SPC(40 - LEN(Men$(CrRw)));
|
||
CrRw = 1
|
||
PrintHelpLine "Comentario | <F2=Guardar y Salir> "
|
||
fiiniished = FALSE
|
||
'Loop until <F2> is pressed
|
||
DO
|
||
hide = 0: GOSUB EdditTransShowCursor 'Show Cursor, Wait for key
|
||
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
|
||
Start$ = kbd$
|
||
hide = 1: GOSUB EdditTransShowCursor
|
||
|
||
IF kbd$ >= " " AND kbd$ < "¦" OR kbd$ = CHR$(8) THEN 'If legal key, edit item
|
||
COLOR colors(8, ColorPref), colors(9, ColorPref)
|
||
IF RTRIM$(LTRIM$(Men$(CrRw))) <> "" THEN Start$ = Men$(CrRw) + kbd$ ELSE Start$ = kbd$
|
||
kbd$ = GetString$(CrRw + 3, 36, Start$, new$, 40, 40)
|
||
Men$(CrRw) = new$
|
||
hide = 1: GOSUB EdditTransShowCursor 'Show Cursor, Wait for key
|
||
END IF
|
||
|
||
SELECT CASE kbd$ 'Handle Special keys
|
||
CASE CHR$(0) + "H" 'up arrow
|
||
CrRw = CrRw - 1
|
||
IF CrRw <= 0 THEN CrRw = 4
|
||
CASE CHR$(0) + "P" 'Down arrow
|
||
CrRw = CrRw + 1
|
||
IF CrRw >= 5 THEN CrRw = 1
|
||
CASE CHR$(0) + "<" 'F2
|
||
fiiniished = TRUE
|
||
CASE ELSE
|
||
BEEP
|
||
END SELECT
|
||
LOOP UNTIL fiiniished
|
||
PrintHelpLine "Por Favor, espere... Buscando y Grabando posiciones"
|
||
RETURN
|
||
|
||
EdditTransShowCursor:
|
||
IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
LOCATE CrRw + 3, 36: PRINT Men$(CrRw); SPC(40 - LEN(Men$(CrRw)));
|
||
RETURN
|
||
|
||
|
||
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 BorraPantalla <> 1 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$(219);
|
||
NEXT a
|
||
LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 1
|
||
PRINT STRING$(LEN(Choice$(MaxChoice)) + 2, 223);
|
||
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
|
||
|
||
'print the choices
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
|
||
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
|
||
IF AnulTecl = 0 THEN
|
||
currChoice = -2
|
||
finished = TRUE
|
||
END IF
|
||
END IF
|
||
RETURN
|
||
|
||
MenuRight:
|
||
IF BarMode THEN
|
||
currChoice = (currChoice) MOD MaxChoice + 1
|
||
ELSE
|
||
IF AnulTecl = 0 THEN
|
||
currChoice = -3
|
||
finished = TRUE
|
||
END IF
|
||
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
|
||
|
||
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 MenuSystemColors
|
||
CASE 5: GOSUB MenuSystemCreditos
|
||
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 5 + 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¢n para el men£"
|
||
Center 12, "Presione Entrar para elegir elemento"
|
||
|
||
Choice$(1) = " Archivo "
|
||
Choice$(2) = " Programas "
|
||
Choice$(3) = " Utilidades "
|
||
Choice$(4) = " Colores "
|
||
Choice$(5) = " Cr‚ditos "
|
||
|
||
menuRow(1) = 1: menuCol(1) = 2
|
||
menuRow(2) = 1: menuCol(2) = 11
|
||
menuRow(3) = 1: menuCol(3) = 22
|
||
menuRow(4) = 1: menuCol(4) = 34
|
||
menuRow(5) = 1: menuCol(5) = 67
|
||
|
||
Help$(1) = "Salir del Cat logo"
|
||
Help$(2) = "Editar programas"
|
||
Help$(3) = "Imprimir/agregar/supr programas, pedidos..."
|
||
Help$(4) = "Fijar color en pantalla"
|
||
Help$(5) = "Cr‚ditos"
|
||
|
||
DO
|
||
NewChoice = Menu((Choice), 5, Choice$(), menuRow(), menuCol(), Help$(), TRUE)
|
||
LOOP WHILE NewChoice = 0
|
||
Choice = NewChoice
|
||
RETURN
|
||
|
||
MenuSystemFile:
|
||
Choice$(1) = " Salir "
|
||
|
||
menuRow(1) = 3: menuCol(1) = 2
|
||
|
||
Help$(1) = "Salir del Administrador"
|
||
|
||
SubChoice = Menu(1, 1, Choice$(), menuRow(), menuCol(), Help$(), FALSE)
|
||
|
||
SELECT CASE SubChoice
|
||
CASE 1: finished = TRUE
|
||
CASE ELSE
|
||
END SELECT
|
||
RETURN
|
||
|
||
|
||
MenuSystemEdit:
|
||
Choice$(1) = " Juegos "
|
||
Choice$(2) = " M£sica "
|
||
Choice$(3) = " Procesadores de textos "
|
||
Choice$(4) = " Pgr. Contabilidad "
|
||
Choice$(5) = " Pgr. Electronica "
|
||
Choice$(6) = " Gr ficos "
|
||
Choice$(7) = " Utilidades "
|
||
Choice$(8) = " Lenguajes "
|
||
Choice$(9) = " Windows "
|
||
Choice$(10) = " Otros... "
|
||
|
||
FOR T = 1 TO 10
|
||
Help$(T) = RTRIM$(Choice$(T))
|
||
NEXT
|
||
|
||
menuRow(1) = 3: menuCol(1) = 8
|
||
menuRow(2) = 4: menuCol(2) = 8
|
||
menuRow(3) = 5: menuCol(3) = 8
|
||
menuRow(4) = 6: menuCol(4) = 8
|
||
menuRow(5) = 7: menuCol(5) = 8
|
||
menuRow(6) = 8: menuCol(6) = 8
|
||
menuRow(7) = 9: menuCol(7) = 8
|
||
menuRow(8) = 10: menuCol(8) = 8
|
||
menuRow(9) = 11: menuCol(9) = 8
|
||
menuRow(10) = 12: menuCol(10) = 8
|
||
|
||
|
||
|
||
SubChoice = Menu(1, 10, Choice$(), menuRow(), menuCol(), Help$(), FALSE)
|
||
IF be = 1 THEN RETURN
|
||
SELECT CASE SubChoice
|
||
CASE 1 TO 10
|
||
EditarProgramas (SubChoice)
|
||
CASE ELSE
|
||
END SELECT
|
||
RETURN
|
||
|
||
|
||
MenuSystemAccount:
|
||
|
||
DO
|
||
|
||
vwe = 0
|
||
|
||
Choice$(1) = " " + CHR$(34) + " Pedidos " + CHR$(34) + " "
|
||
Choice$(2) = " Impresi¢n individual"
|
||
Choice$(3) = " Impresi¢n completa "
|
||
Choice$(4) = " Men£ principal "
|
||
|
||
FOR T = 1 TO 4
|
||
Help$(T) = RTRIM$(Choice$(T))
|
||
NEXT
|
||
|
||
menuRow(1) = 3: menuCol(1) = 18
|
||
menuRow(2) = 4: menuCol(2) = 18
|
||
menuRow(3) = 5: menuCol(3) = 18
|
||
menuRow(4) = 6: menuCol(4) = 18
|
||
|
||
SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), Help$(), FALSE)
|
||
SELECT CASE SubChoice
|
||
CASE 1: Pedidos (0)
|
||
CASE 2
|
||
FancyCls colors(2, ColorPref), colors(1, ColorPref)
|
||
BorraPantalla = 1
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
sombra = 1
|
||
Box 15, 7, 17, 36
|
||
sombra = 0
|
||
|
||
LOCATE 16, 8: PRINT "Seleccione m¢dulo a imprimir"
|
||
be = 1
|
||
GOSUB MenuSystemEdit
|
||
be = 0
|
||
BorraPantalla = 0
|
||
ImprCom (SubChoice)
|
||
CASE 3: ImprCom (0)
|
||
CASE 4
|
||
vwe = 1
|
||
|
||
IF tir <> 1 THEN
|
||
|
||
Box 9, 19, 14, 61
|
||
COLOR 10
|
||
Center 11, "Introduzca PASSWORD..."
|
||
COLOR 0, 0
|
||
|
||
DO
|
||
Tipos = Tipos + 1
|
||
kbd$ = GetString$(11, 54, Start$, new$, 5, 5)
|
||
new# = VAL(new$)
|
||
IF new# = 0 THEN EXIT DO
|
||
IF Tipos = 5 THEN tir = 1: EXIT DO
|
||
BEEP
|
||
LOOP WHILE new# <= 0 OR new# > 999999
|
||
|
||
ELSE
|
||
Box 9, 19, 14, 61
|
||
COLOR 10
|
||
Center 11, "ACCESO DENEGADO"
|
||
Center 13, STR$(2 - intentos) + " intento/s m s y bloqueo el programa !!"
|
||
SLEEP
|
||
intentos = intentos + 1
|
||
IF intentos = 3 THEN
|
||
Box 9, 19, 14, 61
|
||
COLOR 10
|
||
Center 11, "ACCESO DENEGADO"
|
||
Center 13, "Programa BLOQUEADO"
|
||
DO: LOOP
|
||
END IF
|
||
END IF
|
||
|
||
DO
|
||
Retorno = 0
|
||
IF new# = VAL(RTRIM$(LTRIM$(STR$(Password#)))) THEN
|
||
|
||
Tipos = Tipos - 1
|
||
Choice$(1) = " A¤adir/supr programas "
|
||
Choice$(2) = " Cambiar mensaje "
|
||
Choice$(3) = " Edit/supr pedidos "
|
||
Choice$(4) = " Camb. Password/Usuario "
|
||
Choice$(5) = " Copiar ficheros a A: "
|
||
|
||
Help$(1) = "A¤adir, suprimir programas"
|
||
Help$(2) = "Cambiar mensaje final de impresi¢n"
|
||
Help$(3) = "Editar, suprimir pedidos"
|
||
Help$(4) = "Cambiar Password, usuario en uso"
|
||
Help$(5) = "Copiar ficheros de datos de C: a A:"
|
||
|
||
menuRow(1) = 7: menuCol(1) = 40
|
||
menuRow(2) = 8: menuCol(2) = 40
|
||
menuRow(3) = 9: menuCol(3) = 40
|
||
menuRow(4) = 10: menuCol(4) = 40
|
||
menuRow(5) = 11: menuCol(5) = 40
|
||
|
||
COLOR colors(2, ColorPref), colors(1, ColorPref)
|
||
FOR wq = 9 TO 20
|
||
LOCATE wq, 19: PRINT SPC(44);
|
||
NEXT
|
||
|
||
BorraPantalla = 1
|
||
subsubchoice = Menu(1, 5, Choice$(), menuRow(), menuCol(), Help$(), FALSE)
|
||
BorraPantalla = 0
|
||
|
||
SELECT CASE subsubchoice
|
||
CASE 1: MasMenosProg
|
||
CASE 2: CambMensajeFinal
|
||
CASE 3: Pedidos (1)
|
||
|
||
CASE 4
|
||
|
||
Box 12, 19, 17, 61
|
||
Center 13, "CAMBIO DE PASSWORD Y USUARIO"
|
||
Center 14, "Usuario: "
|
||
Center 15, "Password: "
|
||
kbd$ = GetString$(14, 30, Poseedor$, new$, 18, 18)
|
||
Poseedor$ = new$
|
||
ert = 0
|
||
: 'Este es el DO de ert
|
||
DO
|
||
OldPassword# = Password#
|
||
LOCATE 15, 30: PRINT Password#
|
||
kbd$ = GetString$(15, 30, STR$(Password#), new$, 5, 5)
|
||
new# = VAL(new$)
|
||
Password# = new#
|
||
IF OldPassword# <> Password# THEN
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
Box 18, 19, 20, 61
|
||
Center 19, "Confirme Password: "
|
||
COLOR 0, 0
|
||
kbd$ = GetString$(19, 40, Start$, new$, 5, 5)
|
||
IF Password# <> VAL(new$) THEN
|
||
Center 19, "Confirmaci¢n de Password incorrecta"
|
||
SLEEP
|
||
Center 19, "Por favor, vuelva a introducirlo..."
|
||
ert = 1
|
||
END IF
|
||
|
||
END IF
|
||
SaveState
|
||
Retorno = 1
|
||
|
||
LOOP WHILE ert = 1
|
||
|
||
CASE 5
|
||
PrintHelpLine "Por favor, espere... Copiando Ficheros"
|
||
LOCATE 15, 1
|
||
SHELL "Copy *.dat a: >nul"
|
||
IF SCREEN(16, 1) <> 32 THEN
|
||
sombra = 1
|
||
COLOR , 4
|
||
Box 9, 19, 14, 63
|
||
COLOR 14, 4
|
||
Center 11, "ATENCIàN!!! Se produjo un error durante"
|
||
Center 12, "el proceso, copie los ficheros manualmente."
|
||
COLOR 11, 4: Center 13, "Perdone las molestias"
|
||
sombra = 0
|
||
SLEEP
|
||
GOTO MenuSystemMain
|
||
END IF
|
||
SHELL "Copy Mensaje.cat a: >nul"
|
||
IF SCREEN(16, 1) <> 32 THEN
|
||
sombra = 1
|
||
COLOR , 4
|
||
Box 9, 19, 14, 63
|
||
COLOR 14, 4
|
||
Center 11, "ATENCIàN!!! Se produjo un error durante"
|
||
Center 12, "el proceso, copie los ficheros manualmente."
|
||
COLOR 11, 4: Center 13, "Perdone las molestias"
|
||
sombra = 0
|
||
SLEEP
|
||
GOTO MenuSystemMain
|
||
END IF
|
||
CASE ELSE
|
||
END SELECT
|
||
END IF
|
||
|
||
LOOP WHILE Retorno = 1
|
||
|
||
CASE ELSE
|
||
END SELECT
|
||
|
||
LOOP WHILE vwe = 1
|
||
|
||
RETURN
|
||
|
||
MenuSystemColors:
|
||
Choice$(1) = " Monocrom tico "
|
||
Choice$(2) = " Cyan/Azul "
|
||
Choice$(3) = " Azul/Cyan "
|
||
Choice$(4) = " Rojo/Gris "
|
||
|
||
menuRow(1) = 3: menuCol(1) = 31
|
||
menuRow(2) = 4: menuCol(2) = 31
|
||
menuRow(3) = 5: menuCol(3) = 31
|
||
menuRow(4) = 6: menuCol(4) = 31
|
||
|
||
Help$(1) = "Color para presentaci¢n monocrom 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
|
||
|
||
MenuSystemCreditos:
|
||
Choice$(1) = " Cedido a... "
|
||
Choice$(2) = " Acerca de..."
|
||
|
||
menuRow(1) = 3: menuCol(1) = 65
|
||
menuRow(2) = 4: menuCol(2) = 65
|
||
|
||
Help$(1) = "Cat logo vú3.0 cedido a..."
|
||
Help$(2) = "Cr‚ditos de Cat logo"
|
||
|
||
SubChoice = Menu(1, 2, Choice$(), menuRow(), menuCol(), Help$(), FALSE)
|
||
|
||
SELECT CASE SubChoice
|
||
CASE 1
|
||
Box 9, 19, 14, 61
|
||
Center 10, "Cat logo vú3.0 cedido a: "
|
||
Center 11, " " + Poseedor$
|
||
SLEEP
|
||
|
||
CASE 2
|
||
Box 9, 19, 14, 61
|
||
Center 10, "Cat logo, creado por: "
|
||
Center 11, " " + MiNombre$
|
||
Center 12, " Tel‚fono: 95 - 561.08.91"
|
||
SLEEP
|
||
|
||
CASE ELSE
|
||
END SELECT
|
||
RETURN
|
||
|
||
|
||
END SUB
|
||
|
||
SUB Pedidos (Permisos%)
|
||
|
||
ON ERROR GOTO ERRORTRAP
|
||
'Stores info about each column
|
||
REDIM Help$(2), col(2), Vis(2), Max(2), CurrString$(3), CurrFig#(5), Choice$(10), menuRow(10), menuCol(10), Men$(4), f(2), CurrStringC$(5), HelpC$(5)
|
||
REDIM ColC(5), VisC(5), MaxC(5), RowC(5)
|
||
'Array to keep the current balance at all the transactions
|
||
REDIM Balance#(1000)
|
||
|
||
|
||
OPEN "P_Temp.cat" FOR RANDOM AS #1 LEN = 24
|
||
OPEN "Fichas.cat" FOR RANDOM AS #2 LEN = 53
|
||
|
||
FIELD #1, 1 AS TipFich$, 3 AS IoCurrTempTopLine$, 15 AS IoTempDesc$
|
||
FIELD #1, 1 AS Valid$, 4 AS IoMaxRecord$
|
||
|
||
FIELD #2, 10 AS IoNombre$, 18 AS IoApellido$, 10 AS IoTelefono$, 10 AS IoCpu$, 2 AS IoRam$
|
||
FIELD #2, 1 AS IoVld$, 3 AS IoMxRcrd$
|
||
|
||
GET #1, 1
|
||
IF Valid$ <> "*" THEN
|
||
LSET TipFich$ = "þ"
|
||
LSET IoCurrTempTopLine$ = ""
|
||
LSET IoTempDesc$ = ""
|
||
PUT #1, 2
|
||
LSET Valid$ = "*"
|
||
LSET IoMaxRecord$ = "1"
|
||
PUT #1, 1
|
||
MaxRecord = VAL(IoMaxRecord$)
|
||
END IF
|
||
|
||
CurrStringC$(1) = ""
|
||
CurrStringC$(2) = ""
|
||
CurrStringC$(3) = ""
|
||
CurrStringC$(4) = ""
|
||
CurrStringC$(5) = ""
|
||
|
||
FancyCls colors(2, ColorPref), colors(1, ColorPref)
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
sombra = 1
|
||
Box 3, 35, 8, 76
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
LOCATE 4, 36: PRINT "Nombre:"
|
||
LOCATE 5, 36: PRINT "Apellidos:"
|
||
LOCATE 6, 36: PRINT "Telefono:"
|
||
LOCATE 7, 36: PRINT "CPU: RAM:"
|
||
|
||
GET #2, 1
|
||
IF IoVld$ <> "*" THEN
|
||
LSET IoNombre$ = ""
|
||
LSET IoApellido$ = ""
|
||
LSET IoTelefono$ = ""
|
||
LSET IoCpu$ = ""
|
||
LSET IoRam$ = ""
|
||
PUT #2, 2
|
||
LSET IoVld$ = "*"
|
||
LSET IoMxRcrd$ = "1"
|
||
PUT #2, 1
|
||
ELSE
|
||
GET #2, 2
|
||
CurrStringC$(1) = IoNombre$
|
||
CurrStringC$(2) = IoApellido$
|
||
CurrStringC$(3) = IoTelefono$
|
||
CurrStringC$(4) = IoCpu$
|
||
CurrStringC$(5) = IoRam$
|
||
LOCATE 4, 44: PRINT CurrStringC$(1)
|
||
LOCATE 5, 47: PRINT CurrStringC$(2)
|
||
LOCATE 6, 46: PRINT CurrStringC$(3)
|
||
LOCATE 7, 41: PRINT CurrStringC$(4)
|
||
LOCATE 7, 70: PRINT CurrStringC$(5)
|
||
GET #2, 1
|
||
MaxRecord = VAL(IoMaxRecord$)
|
||
|
||
END IF
|
||
|
||
|
||
'Initialize variables
|
||
CurrString$(1) = ""
|
||
CurrString$(2) = ""
|
||
CurrString$(3) = ""
|
||
|
||
|
||
MaxRecord = VAL(IoMaxRecord$)
|
||
MaxRecordC = VAL(IoMxRcrd$)
|
||
|
||
Help$(1) = "Nombre del Programa (15 dig.) "
|
||
Help$(2) = "N§ Kb, Mb, Diskettes... "
|
||
|
||
HelpC$(1) = "Nombre "
|
||
HelpC$(2) = "Apellidos "
|
||
HelpC$(3) = "N§ Tel‚fono "
|
||
HelpC$(4) = "C.P.U. (Ej. 486DX2/66 ) "
|
||
HelpC$(5) = "RAM "
|
||
|
||
col(1) = 36: Vis(1) = 15: Max(1) = 15
|
||
col(2) = 52: Vis(2) = 3: Max(2) = 3
|
||
|
||
ColC(1) = 44: VisC(1) = 21: MaxC(1) = 10: RowC(1) = 4
|
||
ColC(2) = 47: VisC(2) = 18: MaxC(2) = 18: RowC(2) = 5
|
||
ColC(3) = 46: VisC(3) = 19: MaxC(3) = 10: RowC(3) = 6
|
||
ColC(4) = 41: VisC(4) = 24: MaxC(4) = 10: RowC(4) = 7
|
||
ColC(5) = 70: VisC(5) = 3: MaxC(5) = 2: RowC(5) = 7
|
||
|
||
|
||
'Draw Screen
|
||
Box 10, 35, 18, 76
|
||
|
||
|
||
u$ = "\ \"
|
||
u1$ = " "
|
||
u1x$ = "ßßßßßßßßßßßßßßßß"
|
||
u2$ = "###"
|
||
|
||
|
||
|
||
CurrTopLine = 1
|
||
|
||
PosCol = 1
|
||
CurrRow = 1
|
||
CurrCol = 1
|
||
|
||
GOSUB EtTransPrintWholeScreen
|
||
|
||
IF Permisos = 0 THEN
|
||
PrintHelpLine Help$(CurrCol) + "| <F2=Salir> <F9=Insert> <F10=Supr> <F3=Cambiar>"
|
||
ELSE
|
||
PrintHelpLine " <F2=Salir> <F9=Imprimir> <F10=Borrar> "
|
||
END IF
|
||
|
||
GOSUB EtTransGetLine
|
||
GOSUB EtTransPrintLine
|
||
|
||
finished = FALSE
|
||
|
||
|
||
'Loop until <F2> is pressed
|
||
DO
|
||
hide = 0: GOSUB EtTransShowCursor 'Show Cursor, Wait for key
|
||
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
|
||
hide = 1: GOSUB EtTransShowCursor
|
||
|
||
IF kbd$ >= " " AND kbd$ < "¦" OR kbd$ = CHR$(8) THEN 'If legal key, Et item
|
||
IF Permisos = 0 THEN GOSUB EtTransEtItem
|
||
END IF
|
||
|
||
SELECT CASE kbd$ 'Handle Special keys
|
||
CASE CHR$(0) + "H" 'up arrow
|
||
GOSUB EtTransMoveUp
|
||
CASE CHR$(0) + "P" 'Down arrow
|
||
GOSUB EtTransMoveDown
|
||
CASE CHR$(0) + "=" 'F3
|
||
IF Permisos = 0 THEN
|
||
PrintHelpLine Help$(CurrCol) + "| <F2=Salir> <F9=Insert> <F10=Supr> <F3=Cambiar>"
|
||
GOSUB PdCmntr
|
||
END IF
|
||
CASE CHR$(0) + "I" 'Page Up
|
||
CurrRow = 1: PosCol = 1
|
||
CurrTopLine = CurrTopLine - 14
|
||
IF CurrTopLine < 1 THEN
|
||
CurrTopLine = 1
|
||
END IF
|
||
GOSUB EtTransPrintWholeScreen
|
||
GOSUB EtTransGetLine
|
||
CASE CHR$(0) + "Q" 'Page Down
|
||
CurrRow = 1: PosCol = 1
|
||
CurrTopLine = CurrTopLine + 14
|
||
IF CurrTopLine > MaxRecord THEN
|
||
CurrTopLine = MaxRecord
|
||
END IF
|
||
|
||
GOSUB EtTransPrintWholeScreen
|
||
GOSUB EtTransGetLine
|
||
CASE CHR$(0) + "<" 'F2
|
||
finished = TRUE
|
||
CASE CHR$(0) + "C" 'F9
|
||
IF Permisos = 0 THEN GOSUB EtTransAddRecord ELSE GOSUB Imprimir
|
||
CASE CHR$(0) + "D" 'F10
|
||
IF Permisos = 0 THEN
|
||
GOSUB EtTransDeleteRecord
|
||
ELSE
|
||
CLOSE
|
||
KILL "Fichas.cat"
|
||
KILL "P_Temp.cat"
|
||
finished = TRUE
|
||
END IF
|
||
CASE CHR$(13) 'Enter
|
||
CASE ELSE
|
||
BEEP
|
||
END SELECT
|
||
LOOP UNTIL finished
|
||
|
||
CLOSE
|
||
|
||
EXIT SUB
|
||
|
||
|
||
EtTransShowCursor:
|
||
IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
IF PosCol = 1 THEN LOCATE CurrRow + 10, col(CurrCol) ELSE LOCATE CurrRowFalse + 9, col(CurrCol) + 21
|
||
PRINT LEFT$(CurrString$(1), 15);
|
||
RETURN
|
||
|
||
EtTransEtItem:
|
||
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
COLOR colors(8, ColorPref), colors(9, ColorPref)
|
||
IF PosCol = 1 THEN CrrRw = CurrRow: f(1) = col(1): f(2) = col(2) ELSE CrrRw = CurrRowFalse - 1: f(1) = col(1) + 21: f(2) = col(2) + 21
|
||
|
||
IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN Start$ = CurrString$(3) + kbd$ ELSE Start$ = kbd$
|
||
kbd$ = GetString$(CrrRw + 10, f(1), Start$, new$, Vis(CurrCol), Max(CurrCol))
|
||
CurrString$(1) = new$
|
||
GOSUB EtTransPutLine
|
||
GOSUB EtTransGetLine
|
||
|
||
GOSUB EtTransPrintLine
|
||
RETURN
|
||
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ
|
||
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ
|
||
EtTransMoveUp:
|
||
IF CurrRow = 1 THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRow = CurrRow - 1
|
||
IF CurrRow >= 8 THEN
|
||
PosCol = 2
|
||
SELECT CASE CurrRow
|
||
CASE 8: CurrRowFalse = 2
|
||
CASE 9: CurrRowFalse = 3
|
||
CASE 10: CurrRowFalse = 4
|
||
CASE 11: CurrRowFalse = 5
|
||
CASE 12: CurrRowFalse = 6
|
||
CASE 13: CurrRowFalse = 7
|
||
CASE 14: CurrRowFalse = 8
|
||
CASE ELSE
|
||
END SELECT
|
||
ELSE
|
||
PosCol = 1
|
||
END IF
|
||
|
||
GOSUB EtTransGetLine
|
||
END IF
|
||
RETURN
|
||
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ
|
||
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ
|
||
EtTransMoveDown:
|
||
IF (CurrRow + CurrTopLine - 1) >= MaxRecord OR CurrRow = 14 THEN
|
||
BEEP
|
||
ELSE
|
||
IF CurrRow = 14 THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRow = CurrRow + 1
|
||
IF CurrRow >= 8 THEN
|
||
PosCol = 2
|
||
SELECT CASE CurrRow
|
||
CASE 8: CurrRowFalse = 2
|
||
CASE 9: CurrRowFalse = 3
|
||
CASE 10: CurrRowFalse = 4
|
||
CASE 11: CurrRowFalse = 5
|
||
CASE 12: CurrRowFalse = 6
|
||
CASE 13: CurrRowFalse = 7
|
||
CASE 14: CurrRowFalse = 8
|
||
CASE ELSE
|
||
END SELECT
|
||
ELSE
|
||
PosCol = 1
|
||
END IF
|
||
|
||
GOSUB EtTransGetLine
|
||
END IF
|
||
END IF
|
||
|
||
RETURN
|
||
|
||
EtTransPrintLine:
|
||
|
||
COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
IF PosCol = 1 THEN
|
||
LOCATE CurrRow + 10, 36
|
||
ELSE
|
||
LOCATE CurrRowFalse + 9, 57
|
||
END IF
|
||
|
||
IF CurrRecord = MaxRecord + 1 THEN
|
||
PRINT u1x$;
|
||
ELSEIF CurrRecord > MaxRecord THEN
|
||
PRINT u1$;
|
||
ELSE
|
||
|
||
IF RTRIM$(LTRIM$(CurrString$(1))) = "" THEN PRINT " "; ELSE PRINT CurrString$(1) + " ";
|
||
END IF
|
||
|
||
RETURN
|
||
|
||
|
||
EtTransDeleteRecord:
|
||
IF MaxRecord = 1 THEN
|
||
BEEP
|
||
ELSE
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
MaxRecord = MaxRecord - 1
|
||
a = CurrRecord
|
||
WHILE a <= MaxRecord
|
||
GET #1, a + 1 + 1
|
||
PUT #1, a + 1
|
||
a = a + 1
|
||
WEND
|
||
LSET Valid$ = "*"
|
||
LSET IoMaxRecord$ = STR$(MaxRecord)
|
||
PUT #1, 1
|
||
|
||
GOSUB EtTransPrintWholeScreen
|
||
|
||
IF CurrRecord > MaxRecord THEN
|
||
GOSUB EtTransMoveUp
|
||
END IF
|
||
GOSUB EtTransGetLine
|
||
GOSUB EtTransPrintLine
|
||
|
||
END IF
|
||
RETURN
|
||
|
||
EtTransAddRecord:
|
||
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
a = MaxRecord
|
||
WHILE a > CurrRecord
|
||
GET #1, a + 1
|
||
PUT #1, a + 1 + 1
|
||
a = a - 1
|
||
WEND
|
||
MaxRecord = MaxRecord + 1
|
||
LSET TipFich$ = "þ"
|
||
LSET IoCurrTempTopLine$ = "þ"
|
||
LSET IoTempDesc$ = ""
|
||
PUT #1, CurrRecord + 1 + 1
|
||
LSET Valid$ = "*"
|
||
LSET IoMaxRecord$ = STR$(MaxRecord)
|
||
PUT #1, 1
|
||
|
||
GOSUB EtTransPrintWholeScreen
|
||
GOSUB EtTransGetLine
|
||
RETURN
|
||
|
||
|
||
EtTransPrintWholeScreen:
|
||
|
||
Permiso = 1
|
||
temp = CurrRow
|
||
|
||
FOR CurrRow = 1 TO 14
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
IF CurrRecord <= MaxRecord THEN
|
||
GOSUB EtTransGetLine
|
||
END IF
|
||
IF CurrRow >= 8 THEN
|
||
PosCol = 2
|
||
SELECT CASE CurrRow
|
||
CASE 8: CurrRowFalse = 2
|
||
CASE 9: CurrRowFalse = 3
|
||
CASE 10: CurrRowFalse = 4
|
||
CASE 11: CurrRowFalse = 5
|
||
CASE 12: CurrRowFalse = 6
|
||
CASE 13: CurrRowFalse = 7
|
||
CASE 14: CurrRowFalse = 8
|
||
CASE ELSE
|
||
END SELECT
|
||
END IF
|
||
|
||
GOSUB EtTransPrintLine
|
||
PosCol = 1
|
||
NEXT CurrRow
|
||
Permiso = 0
|
||
CurrRow = temp
|
||
RETURN
|
||
|
||
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ
|
||
EtTransPutLine:
|
||
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
|
||
GET #1, CurrRecord + 1
|
||
Dezplazamiento = 0
|
||
LSET TipFich$ = RTRIM$(LTRIM$(Tip$))
|
||
LSET IoCurrTempTopLine$ = RTRIM$(LTRIM$(CurrTempTopLine$))
|
||
LSET IoTempDesc$ = CurrString$(1)
|
||
PUT #1, CurrRecord + 1
|
||
RETURN
|
||
|
||
EtTransGetLine:
|
||
|
||
CurrRecord = CurrTopLine + CurrRow - 1
|
||
|
||
GET #1, CurrRecord + 1
|
||
Tip$ = TipFich$
|
||
CurrString$(1) = IoTempDesc$
|
||
CurrTempTopLine$ = IoCurrTempTopLine$
|
||
RETURN
|
||
|
||
PdCmntr:
|
||
NowRow = 1
|
||
PrintHelpLine HelpC$(NowRow) + "| <F2=Guardar> <F3=Cambiar> "
|
||
fiiniished = FALSE
|
||
'Loop until <F2> is pressed
|
||
DO
|
||
hide = 0: GOSUB ddtTrnsShwCrsr 'Show Cursor, Wait for key
|
||
DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> ""
|
||
Start$ = kbd$
|
||
hide = 1: GOSUB ddtTrnsShwCrsr
|
||
|
||
IF kbd$ >= " " AND kbd$ < "¦" OR kbd$ = CHR$(8) THEN 'If legal key, edit item
|
||
COLOR colors(8, ColorPref), colors(9, ColorPref)
|
||
SELECT CASE NowRow
|
||
CASE 1 TO 5
|
||
Start$ = kbd$
|
||
kbd$ = GetString$(RowC(NowRow), ColC(NowRow), Start$, new$, VisC(NowRow), MaxC(NowRow))
|
||
CurrStringC$(NowRow) = new$
|
||
CASE ELSE
|
||
END SELECT
|
||
|
||
END IF
|
||
hide = 0: GOSUB ddtTrnsShwCrsr 'Show Cursor, Wait for key
|
||
SELECT CASE kbd$ 'Handle Special keys
|
||
CASE CHR$(0) + "H" 'up arrow
|
||
hide = 1: GOSUB ddtTrnsShwCrsr
|
||
NowRow = NowRow - 1
|
||
IF NowRow <= 0 THEN NowRow = 5
|
||
PrintHelpLine HelpC$(NowRow) + "| <F2=Guardar y Cambiar> "
|
||
CASE CHR$(0) + "P" 'Down arrow
|
||
hide = 1: GOSUB ddtTrnsShwCrsr
|
||
NowRow = NowRow + 1
|
||
IF NowRow >= 6 THEN NowRow = 1
|
||
PrintHelpLine HelpC$(NowRow) + "| <F2=Guardar y Cambiar> "
|
||
CASE CHR$(0) + "<" 'F2
|
||
fiiniished = TRUE
|
||
CASE ELSE
|
||
BEEP
|
||
END SELECT
|
||
LOOP UNTIL fiiniished
|
||
hide = 1: GOSUB ddtTrnsShwCrsr
|
||
PrintHelpLine "Por Favor, espere... Buscando y Grabando posiciones"
|
||
LSET IoNombre$ = CurrStringC$(1)
|
||
LSET IoApellido$ = CurrStringC$(2)
|
||
LSET IoTelefono$ = CurrStringC$(3)
|
||
LSET IoCpu$ = CurrStringC$(4)
|
||
LSET IoRam$ = CurrStringC$(5)
|
||
PUT #2, 2
|
||
LSET IoVld$ = "*"
|
||
LSET IoMxRcrd$ = "1"
|
||
PUT #2, 1
|
||
RETURN
|
||
|
||
|
||
ddtTrnsShwCrsr:
|
||
IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref)
|
||
LOCATE RowC(NowRow), ColC(NowRow): PRINT CurrStringC$(NowRow); SPC(VisC(NowRow) - LEN(CurrStringC$(NowRow)));
|
||
RETURN
|
||
|
||
Imprimir:
|
||
|
||
PrintErr = FALSE
|
||
ON ERROR GOTO ERRORTRAP ' test if printer is connected
|
||
LPRINT
|
||
IF PrintErr = FALSE THEN
|
||
LPRINT "CATALOGO -- J.D. --"
|
||
LPRINT
|
||
LPRINT "Nombre: "; CurrStringC$(1)
|
||
LPRINT "Apellidos: "; CurrStringC$(2)
|
||
LPRINT "N§ Telefono: "; CurrStringC$(3)
|
||
LPRINT "C.P.U.: "; CurrStringC$(4); " "; CurrStringC$(5)
|
||
LPRINT
|
||
a = 1: b = 1
|
||
WHILE a <= MaxRecord
|
||
GET #1, a + 1
|
||
SELECT CASE b
|
||
CASE 1: LPRINT IoTempDesc$; : b = 2
|
||
CASE 2: LPRINT " "; IoTempDesc$; : b = 3
|
||
CASE 3: LPRINT " "; IoTempDesc$; : b = 4
|
||
CASE 4: LPRINT " "; IoTempDesc$: b = 1
|
||
CASE ELSE
|
||
END SELECT
|
||
a = a + 1
|
||
WEND
|
||
LPRINT
|
||
|
||
END IF
|
||
RETURN
|
||
|
||
END SUB
|
||
|
||
'PrintHelpLine:
|
||
' Prints help text on the bottom row in the proper color
|
||
SUB PrintHelpLine (Help$)
|
||
COLOR colors(5, ColorPref), colors(4, ColorPref)
|
||
LOCATE 25, 1
|
||
PRINT SPACE$(80);
|
||
Center 25, Help$
|
||
END SUB
|
||
|
||
'SaveState:
|
||
' Save color preference and account information to "MONEY.DAT" data file.
|
||
SUB SaveState
|
||
DEFINT A-Z
|
||
RANDOMIZE TIMER
|
||
x# = INT(RND * 6) + 1
|
||
Password$ = STR$(x#) + STR$(Password# * x# * 7#)
|
||
OPEN "Catalogo.CFG" FOR OUTPUT AS #2
|
||
PRINT #2, ColorPref
|
||
PRINT #2, Poseedor$
|
||
PRINT #2, Password$
|
||
CLOSE #2
|
||
END SUB
|
||
|
||
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
|
||
|