' ' Q B a s i c P e r s o n a l F i n a n c i a l ' ' Copyright (C) Microsoft Corporation 1990 'Set default data type to integer for faster operation DEFINT A-Z 'Sub and function declarations DECLARE SUB ScrollUp () DECLARE SUB ScrollDown () DECLARE SUB Initialize () DECLARE SUB center (Row%, text$) DECLARE SUB FancyCls (dots%, Background%) DECLARE SUB LoadState () DECLARE SUB SaveState () DECLARE SUB MenuSystem () DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%) DECLARE SUB PrintHelpLine (help$) DECLARE SUB ImpRef (po%) DECLARE SUB ImpComp (so%) DECLARE SUB Vende (r%) DECLARE SUB Elif () DECLARE SUB Staul () DECLARE SUB Ticket (e%) DECLARE SUB Stock (EE%) DECLARE SUB Balan (EEE%) DECLARE FUNCTION Cvit$ (x%) DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, Choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%) DECLARE FUNCTION GetString$ (Row%, Col%, start$, end$, vis%, max%) DECLARE FUNCTION Trim$ (x$) 'Constants CONST true = -1 CONST false = NOT true 'User-defined types TYPE AccountType Title AS STRING * 20 AType AS STRING * 1 Desc AS STRING * 50 END TYPE TYPE Recordtype Date AS STRING * 8 Ref AS STRING * 10 Desc AS STRING * 50 Fig1 AS DOUBLE Fig2 AS DOUBLE END TYPE 'Global variables DIM SHARED Account(1 TO 19) AS AccountType 'Stores the 19 account titles DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors DIM SHARED ScrollUpAsm(1 TO 7) 'Assembly Language Routines DIM SHARED ScrollDownAsm(1 TO 7) DIM SHARED Fecha$(1), fech$(1) COMMON SHARED Account() AS AccountType, ColorPref, colors(), ScrollUpAsm(), ScrollDownAsm(), printerr AS INTEGER, Choice, SubChoice DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock KeyFlags = PEEK(1047) POKE 1047, &H0 DEF SEG 'Open money manager data file. If it does not exist in current directory, ' goto error handler to create and initialize it. ON ERROR GOTO ErrorTrap OPEN "Personal.cfg" FOR INPUT AS #1 CLOSE ON ERROR GOTO 0 'Reset error handler Initialize 'Initialize program MenuSystem 'This is the main program COLOR 7, 0 'Clear screen and end CLS DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states POKE 1047, KeyFlags DEF SEG END ' Error handler for program ' If data file not found, create and initialize a new one. ErrorTrap: SELECT CASE ERR ' If data file not found, create and initialize a new one. CASE 53 CLOSE ColorPref = 1 FOR A = 1 TO 19 Account(A).Title = "" Account(A).AType = "" Account(A).Desc = "" NEXT A SaveState RESUME CASE 24, 25 printerr = true Box 8, 13, 14, 69 center 11, "La impresora no responde ..." center 12, "Presione Barra espaciadora para continuar" WHILE INKEY$ <> "": WEND RESUME NEXT CASE ELSE END SELECT RESUME NEXT ErrorCaj: OPEN "Caja.cfg" FOR OUTPUT AS #1 PRINT #1, "N" CLOSE RESUME NEXT 'The following data defines the color schemes available via the main menu. ' ' scrn dots bar back title shdow choice curs cursbk shdow DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0 DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0 DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0 DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0 'The following data is actually a machine language program to 'scroll the screen up or down very fast using a BIOS call. DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB SUB Balan (EE%) END SUB 'Box: ' Draw a box on the screen between the given coordinates. SUB Box (Row1, Col1, Row2, Col2) STATIC BoxWidth = Col2 - Col1 + 1 LOCATE Row1, Col1 PRINT "Ú"; 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, "Ä"); "Ù"; END SUB 'Center: ' Center text on the given row. SUB center (Row, text$) LOCATE Row, 41 - LEN(text$) / 2 PRINT text$; END SUB 'Cvit$: ' Convert an integer to a string WITHOUT a leading space. FUNCTION Cvit$ (x) Cvit$ = RIGHT$(STR$(x), LEN(STR$(x)) - 1) END FUNCTION SUB Elif END SUB 'FancyCls: ' Clears screen in the right color, and draws nice dots. SUB FancyCls (dots, Background) VIEW PRINT 2 TO 24 COLOR dots, Background CLS 2 FOR A = 95 TO 1820 STEP 45 Row = A / 80 + 1 Col = A MOD 80 + 1 LOCATE Row, Col PRINT CHR$(250); NEXT A VIEW PRINT END SUB 'GetString$: ' Given a row and col, and an initial string, edit a string ' VIS is the length of the visible field of entry ' MAX is the maximum number of characters allowed in the string FUNCTION GetString$ (Row, Col, start$, end$, vis, max) Curr$ = Trim$(LEFT$(start$, max)) IF Curr$ = CHR$(8) THEN Curr$ = "" LOCATE , , 1 finished = false DO GOSUB GetStringShowText GOSUB GetStringGetKey IF LEN(kbd$) > 1 THEN finished = true GetString$ = kbd$ ELSE SELECT CASE kbd$ CASE CHR$(13), CHR$(27), CHR$(9) finished = true GetString$ = kbd$ CASE CHR$(8) IF Curr$ <> "" THEN Curr$ = LEFT$(Curr$, LEN(Curr$) - 1) END IF CASE " " TO "}" IF LEN(Curr$) < max THEN Curr$ = Curr$ + kbd$ ELSE BEEP END IF CASE ELSE BEEP END SELECT END IF LOOP UNTIL finished end$ = Curr$ LOCATE , , 0 EXIT FUNCTION GetStringShowText: LOCATE Row, Col IF LEN(Curr$) > vis THEN PRINT RIGHT$(Curr$, vis); ELSE PRINT Curr$; SPACE$(vis - LEN(Curr$)); LOCATE Row, Col + LEN(Curr$) END IF RETURN GetStringGetKey: kbd$ = "" WHILE kbd$ = "" kbd$ = INKEY$ WEND RETURN END FUNCTION SUB ImpComp (so%) 'Stores info about each column 'Array to keep the current balance at all the transactions REDIM Col(6), Balance#(1000) mes$ = MID$(DATE$, 1, 2) an$ = MID$(DATE$, 7, 4) comes$ = mes$ + "-" + an$ gf = 0 Box 17, 5, 21, 75 center 18, "Por Favor Introduzca Mes y a¤o" center 19, "para imprimir gastos." PrintHelpLine "Mes y A¤o: mm-aaaa" DO emp$ = GetString$(20, 7, comes$, end$, 10, 10) Fecha$ = end$ mes$ = MID$(Fecha$, 1, 2) IF VAL(mes$) <= 12 THEN gf = 1 IF LEN(Fecha$) < 7 THEN gf = 0 LOOP WHILE gf = 0 gf = 0 mes$ = MID$(Fecha$, 1, 2) an$ = MID$(Fecha$, 4, 4) center 18, "Imprimiendo Fecha Seleccionada" center 19, "Por favor, espere ..." 'Open random access file file$ = "E-" + mes$ + an$ + "." + Cvit$(so%) OPEN file$ FOR RANDOM AS #1 LEN = 59 FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ GET #1, 1 IF valid$ <> "SI" THEN center 18, "Este mes, esta vacio, verifique esto." center 19, "--> Pulse una tecla <--" SLEEP EXIT SUB END IF MaxRecord = VAL(IoMaxRecord$) Balance#(0) = 0 A = 1 WHILE A <= MaxRecord GET #1, A + 1 p# = VAL(IoPvp$) p1# = VAL(IoUnd$) p2# = VAL(IoCC$) p3# = VAL(IoPc$) Balance#(A) = p# * p1# * p2# - p1# * p2# * p3# BalTotal# = BalTotal# + Balance#(A) A = A + 1 WEND DO printerr = false ON ERROR GOTO ErrorTrap LPRINT kdb$ = INKEY$ WHILE kdb$ = "": kdb$ = INKEY$: WEND IF kdb$ = CHR$(27) THEN EXIT SUB LOOP WHILE printerr = true Box 8, 13, 14, 69 LPRINT SPACE$(80); LPRINT "Empresa: " + Trim$(Account(so%).Title); GOSUB ObtMes LPRINT TAB(63); "Fecha: " + Fecha$; LPRINT LPRINT "Dia³ Ref# ³ Concepto ³ Und ³Und/C³ P.V.P. ³ P.C. ³ Beneficios "; LPRINT "ÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄ"; LPRINT " ³ ³ ³ ³ ³ ³ ³ "; 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$ + "³"; ELSE LPRINT TAB(2); dia$ + "³"; IF r# <> 0 THEN LPRINT USING u6$; r#; ELSE LPRINT " "; IF RTRIM$(LTRIM$(D$)) <> "" THEN LPRINT "³" + D$; ELSE LPRINT "³ "; IF p1# <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; p1#; : LPRINT " "; ELSE LPRINT "³ "; IF p2# <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; p2#; : LPRINT " "; ELSE LPRINT "³ "; IF p3# <> 0 THEN LPRINT "³"; : LPRINT USING u2$; p3#; ELSE LPRINT "³ "; IF p2# <> 0 THEN LPRINT "³"; : LPRINT USING u2$; p2#; ELSE LPRINT "³ "; LPRINT "³"; LPRINT USING u3$; Balance#(A); A = A + 1 WEND LPRINT "ßßß³ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßß³ßßßßß³ßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßß"; LPRINT "ÄÄÄÁÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄ"; LPRINT " Balance total:"; USING u9$; BalTotal#; LPRINT "ÄÄÄÂÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄ"; LPRINT "ÜÜܳÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜܳÜÜÜÜܳÜÜÜÜܳÜÜÜÜÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜܳÜÜÜÜÜÜÜÜÜÜÜÜ" LPRINT "Programa Realizado por J.D. para Guill‚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# ³ Concepto ³ Und/C ³ P.V.P. ³ P.C. "; LPRINT "ÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ"; LPRINT " ³ ³ ³ ³ " u1x$ = "ßßßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßß" 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 "³ " + CurrString$(1); ELSE LPRINT "³ "; IF CurrFig#(3) <> 0 THEN LPRINT " ³ "; : LPRINT USING u5$; CurrFig#(3); : LPRINT " "; ELSE LPRINT " ³ "; IF CurrFig#(4) <> 0 THEN LPRINT "³ "; : LPRINT USING u5$; CurrFig#(4); : LPRINT " "; ELSE LPRINT "³ "; IF CurrFig#(5) <> 0 THEN LPRINT "³ "; : LPRINT USING u2$; CurrFig#(5) ELSE LPRINT "³ " A = A + 1 WEND EXIT SUB finpage: center 18, "Inserte una hoja en la impresora" center 19, "Y pulse una tecla... " SLEEP DO kop = 0 printerr = false ON ERROR GOTO ErrorTrap LPRINT kdb$ = INKEY$ WHILE kdb$ = "": kdb$ = INKEY$: WEND IF kdb$ = CHR$(27) THEN EXIT SUB Box 8, 13, 14, 69 LOOP WHILE printerr <> true center 18, "Imprimiendo Fecha Seleccionada" center 19, "Por favor, espere ..." RETURN END SUB 'Initialize: ' Read colors in and set up assembly routines SUB Initialize WIDTH , 25 VIEW PRINT FOR ColorSet = 1 TO 4 FOR x = 1 TO 10 READ colors(x, ColorSet) NEXT x NEXT ColorSet LoadState p = VARPTR(ScrollUpAsm(1)) DEF SEG = VARSEG(ScrollUpAsm(1)) FOR i = 0 TO 13 READ J POKE (p + i), J NEXT i p = VARPTR(ScrollDownAsm(1)) DEF SEG = VARSEG(ScrollDownAsm(1)) FOR i = 0 TO 13 READ J POKE (p + i), J NEXT i DEF SEG END SUB 'LoadState: ' Load color preferences and account info from Personal.cfg SUB LoadState OPEN "Personal.cfg" FOR INPUT AS #1 INPUT #1, ColorPref FOR A = 1 TO 10 LINE INPUT #1, Account(A).Title NEXT A CLOSE END SUB 'Menu: ' Handles Menu Selection for a single menu (either sub menu, or menu bar) ' currChoiceX : Number of current choice ' maxChoice : Number of choices in the list ' choice$() : Array with the text of the choices ' itemRow() : Array with the row of the choices ' itemCol() : Array with the col of the choices ' help$() : Array with the help text for each choice ' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style ' ' Returns the number of the choice that was made by changing currChoiceX ' and returns the scan code of the key that was pressed to exit ' FUNCTION Menu (CurrChoiceX, MaxChoice, Choice$(), ItemRow(), ItemCol(), help$(), BarMode) currChoice = CurrChoiceX 'if in bar mode, color in menu bar, else color box/shadow 'bar mode means you are currently in the menu bar, not a sub menu IF BarMode THEN COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 1, 1 PRINT SPACE$(80); ELSE IF boorra <> 0 THEN FancyCls colors(2, ColorPref), colors(1, ColorPref) COLOR colors(7, ColorPref), colors(4, ColorPref) Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(Choice$(1)) + 1 COLOR colors(10, ColorPref), colors(6, ColorPref) FOR A = 1 TO MaxChoice + 1 LOCATE ItemRow(1) + A - 1, ItemCol(1) + LEN(Choice$(1)) + 2 PRINT CHR$(178); CHR$(178); NEXT A LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2 PRINT STRING$(LEN(Choice$(MaxChoice)) + 2, 178); END IF 'print the choices COLOR colors(7, ColorPref), colors(4, ColorPref) FOR A = 1 TO MaxChoice LOCATE ItemRow(A), ItemCol(A) PRINT Choice$(A); NEXT A finished = false WHILE NOT finished GOSUB MenuShowCursor GOSUB MenuGetKey GOSUB MenuHideCursor SELECT CASE kbd$ CASE CHR$(0) + "H": GOSUB MenuUp CASE CHR$(0) + "P": GOSUB MenuDown CASE CHR$(0) + "K": GOSUB MenuLeft CASE CHR$(0) + "M": GOSUB MenuRight CASE CHR$(13): GOSUB MenuEnter CASE CHR$(27): GOSUB MenuEscape CASE ELSE: BEEP END SELECT WEND Menu = currChoice EXIT FUNCTION MenuEnter: finished = true RETURN MenuEscape: currChoice = 0 finished = true RETURN MenuUp: IF BarMode THEN BEEP ELSE currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 END IF RETURN MenuLeft: IF BarMode THEN currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 ELSE currChoice = -2 finished = true END IF RETURN MenuRight: IF BarMode THEN currChoice = (currChoice) MOD MaxChoice + 1 ELSE currChoice = -3 finished = true END IF RETURN MenuDown: IF BarMode THEN finished = true ELSE currChoice = (currChoice) MOD MaxChoice + 1 END IF RETURN MenuShowCursor: COLOR colors(8, ColorPref), colors(9, ColorPref) LOCATE ItemRow(currChoice), ItemCol(currChoice) PRINT Choice$(currChoice); PrintHelpLine help$(currChoice) RETURN MenuGetKey: kbd$ = "" WHILE kbd$ = "" kbd$ = INKEY$ WEND RETURN MenuHideCursor: COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE ItemRow(currChoice), ItemCol(currChoice) PRINT Choice$(currChoice); RETURN END FUNCTION 'MenuSystem: ' Main routine that controls the program. Uses the MENU function ' to implement menu system and calls the appropriate function to handle ' the user's selection SUB MenuSystem boorra = 1 DIM Choice$(20), menuRow(20), menuCol(20), help$(20) LOCATE , , 0 Choice = 1 finished = false WHILE NOT finished GOSUB MenuSystemMain SubChoice = -1 WHILE SubChoice < 0 SELECT CASE Choice CASE 1: GOSUB MenuSystemFile CASE 2: GOSUB MenuSystemEdit CASE 3: GOSUB MenuSystemAccount CASE 4: GOSUB MenuSystemReport CASE 5: GOSUB MenuSystemColors CASE 6: GOSUB help END SELECT FancyCls colors(2, ColorPref), colors(1, ColorPref) SELECT CASE SubChoice CASE -2: Choice = (Choice + 3) MOD 5 + 1 CASE -3: Choice = (Choice) MOD 6 + 1 END SELECT WEND WEND EXIT SUB MenuSystemMain: FancyCls colors(2, ColorPref), colors(1, ColorPref) COLOR colors(7, ColorPref), colors(4, ColorPref) Box 9, 19, 14, 61 center 11, "Use las teclas de direcci¢n para el men£" center 12, "Presione Entrar para elegir elemento" Choice$(1) = " Archivo " Choice$(2) = " Proveedores " Choice$(3) = " Transacciones " Choice$(4) = " Clientes " Choice$(5) = " Colores " Choice$(6) = " Ayuda " menuRow(1) = 1: menuCol(1) = 2 menuRow(2) = 1: menuCol(2) = 12 menuRow(3) = 1: menuCol(3) = 26 menuRow(4) = 1: menuCol(4) = 42 menuRow(5) = 1: menuCol(5) = 53 menuRow(6) = 1: menuCol(6) = 72 help$(1) = "Salir del T.P.V" help$(2) = "Agregar/edit/supr Proveedores" help$(3) = "Agregar/edit/supr Transacciones" help$(4) = "Ver e imprimir clientes" help$(5) = "Fijar color en pantalla" help$(6) = " Ayuda " DO NewChoice = Menu((Choice), 6, Choice$(), menuRow(), menuCol(), help$(), true) LOOP WHILE NewChoice = 0 Choice = NewChoice RETURN MenuSystemFile: FancyCls colors(2, ColorPref), colors(1, ColorPref) Choice$(1) = " Ficheros " Choice$(2) = " Status " Choice$(3) = " Salir " menuRow(1) = 3: menuCol(1) = 2 menuRow(2) = 4: menuCol(2) = 2 menuRow(3) = 5: menuCol(3) = 2 help$(1) = "Operaciones de Configuraci¢n" help$(2) = "Status actual" help$(3) = "Salir del T.P.V." SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false) SELECT CASE SubChoice CASE 1 Choice$(1) = " Eliminar Fich. " Choice$(2) = " Vendedores " Choice$(3) = " Caja (S/N) " menuRow(1) = 5: menuCol(1) = 6 menuRow(2) = 6: menuCol(2) = 6 menuRow(3) = 7: menuCol(3) = 6 help$(1) = "Eliminaci¢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, "¨Hay una caja registradora instalada" center 12, "en el puerto RS232?" LOCATE 13, 15: PRINT "Actual: ", act$ center 14, " <ÄÙ Cambiar" kbd$ = INKEY$ WHILE kbd$ = "": kbd$ = INKEY$: WEND IF kbd$ <> CHR$(13) THEN RETURN LOCATE 13, 15: INPUT "Nuevo: ", act$ IF UCASE$(RTRIM$(LTRIM$(act$))) <> "S" THEN act$ = "N" OPEN "Caja.cfg" FOR OUTPUT AS #1 PRINT #1, act$ CLOSE CASE ELSE END SELECT CASE 2: Staul CASE 3: finished = true CASE ELSE END SELECT RETURN MenuSystemEdit: FancyCls colors(2, ColorPref), colors(1, ColorPref) Choice$(1) = " Altas " Choice$(2) = " Editar/Modificar " Choice$(3) = " Buscar " Choice$(4) = " Eliminar " Choice$(5) = " Imprimir (1, 2) " menuRow(1) = 3: menuCol(1) = 9 menuRow(2) = 4: menuCol(2) = 9 menuRow(3) = 5: menuCol(3) = 9 menuRow(4) = 6: menuCol(4) = 9 menuRow(5) = 7: menuCol(5) = 9 help$(1) = "Agregar Proveedores" help$(2) = "Editar/Modificar Proveedores" help$(3) = "Busqueda de Proveedores" help$(4) = "Eliminar Proveedores" help$(5) = "Imprimir lista individual o r pida" SubChoice = Menu(1, 5, Choice$(), menuRow(), menuCol(), help$(), false) SELECT CASE SubChoice CASE 1 TO 5 CHAIN "Proveed" END SELECT RETURN MenuSystemAccount: don = 0 FancyCls colors(2, ColorPref), colors(1, ColorPref) Choice$(1) = " Compras " Choice$(2) = " Referencias " Choice$(3) = " Imprimir (1) " Choice$(4) = " Imprimir (2) " menuRow(1) = 3: menuCol(1) = 26 menuRow(2) = 4: menuCol(2) = 26 menuRow(3) = 5: menuCol(3) = 26 menuRow(4) = 6: menuCol(4) = 26 help$(1) = "Agregar/Eliminar/Editar Compras" help$(2) = "Agregar/Eliminar/Editar Referencias" help$(3) = "Imprimir Compras del mes" help$(4) = "Imprimir Referencias" SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false) item% = SubChoice SELECT CASE SubChoice CASE 1: vaw = 1: GOTO empresa CASE 2: vaw = 2: GOTO empresa CASE 3: vaw = 3: GOTO empresa CASE 4: vaw = 4: GOTO empresa END SELECT RETURN empresa: boorra = 1 FOR A = 1 TO 10 IF Trim$(Account(A).Title) = "" THEN Choice$(A) = RIGHT$(STR$(A), 2) + ". ------------------- " ELSE Choice$(A) = RIGHT$(STR$(A), 2) + ". " + Account(A).Title END IF menuRow(A) = A + 4 menuCol(A) = 32 help$(A) = RTRIM$(Account(A).Title) NEXT A SubChoice = Menu(1, 10, Choice$(), menuRow(), menuCol(), help$(), false) boorra = 0 IF SubChoice > 0 THEN IF Choice$(SubChoice) = RIGHT$(STR$(SubChoice), 2) + ". ------------------- " THEN Box 17, 5, 21, 75 center 19, "Esa empresa no EXISTE, ¨Desea crearla?" DO: K$ = INKEY$ LOOP WHILE K$ = "" IF K$ = "s" OR K$ = "S" THEN Box 17, 5, 21, 75 center 18, "Introduzca el nombre de la Empresa" emp$ = GetString$(19, 7, "", end$, 20, 20) 'end$ contiene la informacion Account(SubChoice).Title = end$ SaveState ELSE Box 17, 5, 21, 75 center 19, "Escoja una empresa" GOTO empresa END IF END IF item% = SubChoice IF vaw = 2 THEN Box 17, 5, 21, 75 center 18, "Por Favor, espere mientras" center 19, "inicio el modulo de REFERENCIAS" CHAIN "ref#" END IF IF vaw = 1 THEN Box 17, 5, 21, 75 center 18, "Por Favor, espere mientras" center 19, "inicio el modulo de COMPRAS" CHAIN "compras" END IF IF vaw = 3 THEN ImpComp (SubChoice) IF vaw = 4 THEN ImpRef (SubChoice) END IF IF don = 2 THEN RETURN GOTO MenuSystemMain MenuSystemReport: FancyCls colors(2, ColorPref), colors(1, ColorPref) Choice$(1) = " Ticket " Choice$(2) = " Balance " Choice$(3) = " Stock actual " menuRow(1) = 3: menuCol(1) = 39 menuRow(2) = 4: menuCol(2) = 39 menuRow(3) = 5: menuCol(3) = 39 help$(1) = "Ticket, comenzar a fichar" help$(2) = "Total Vendido, dia, mes" help$(3) = "Ver o imprimir Stock actual" SubChoice = Menu(1, 3, Choice$(), menuRow(), menuCol(), help$(), false) don = 2 SELECT CASE SubChoice CASE 1 GOSUB empresa Ticket (SubChoice%) CASE 2 GOSUB empresa Balan (SubChoice%) CASE 3 GOSUB empresa Stock (SubChoice%) CASE ELSE END SELECT RETURN MenuSystemColors: FancyCls colors(2, ColorPref), colors(1, ColorPref) Choice$(1) = " Monocrom 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¢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 help: FancyCls colors(2, ColorPref), colors(1, ColorPref) Choice$(1) = " Uso de la ayuda " Choice$(2) = " Sobre los Men£s " Choice$(3) = " Grabaci¢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£s" help$(3) = "Modo de grabar los Datos" help$(4) = "Creditos del Personal Financial" SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false) SELECT CASE SubChoice CASE 1 RETURN CASE 2 RETURN CASE 3 RETURN CASE 4 Box 9, 10, 16, 70 center 10, "T E R M I N A L P U N T O de V E N T A" center 12, "by" center 14, "Jos‚ David Guill‚n (c) 1993" center 16, "Pulse una tecla" SLEEP CASE ELSE END SELECT RETURN END SUB 'PrintHelpLine: ' Prints help text on the bottom row in the proper color SUB PrintHelpLine (help$) COLOR colors%(5, ColorPref), colors%(4, ColorPref) LOCATE 25, 1 PRINT SPACE$(80); center 25, help$ END SUB 'SaveState: ' Save color preference and account information to "Personal.cfg" data file. SUB SaveState OPEN "Personal.cfg" FOR OUTPUT AS #2 PRINT #2, ColorPref FOR A = 1 TO 19 PRINT #2, Account(A).Title NEXT A CLOSE #2 END SUB 'ScrollDown: ' Call the assembly program to scroll the screen down SUB ScrollDown DEF SEG = VARSEG(ScrollDownAsm(1)) CALL Absolute(VARPTR(ScrollDownAsm(1))) DEF SEG END SUB 'ScrollUp: ' Calls the assembly program to scroll the screen up SUB ScrollUp DEF SEG = VARSEG(ScrollUpAsm(1)) CALL Absolute(VARPTR(ScrollUpAsm(1))) DEF SEG END SUB SUB Staul END SUB SUB Stock (EEE%) END SUB SUB Ticket (e%) 'Stores info about each column REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6) 'Array to keep the current balance at all the transactions REDIM Balance#(1000), Ca#(1000), Cb$(1000), Cc#(1000), Cd#(1000), Ce#(1000), lin$(155) gf = 0 Box 17, 5, 21, 75 center 18, "Por Favor Introduzca Fecha" center 19, "con la que guardar ticket del d¡a." PrintHelpLine "Fecha: mm - dd - aaaa" DO emp$ = GetString$(20, 7, DATE$, end$, 10, 10) Fecha$ = end$ M = VAL(MID$(Fecha$, 1, 2)) D = VAL(MID$(Fecha$, 4, 2)) IF M <= 12 AND D <= 31 THEN gf = 1 IF LEN(Fecha$) < 10 THEN gf = 0 LOOP WHILE gf = 0 gf = 0 mes$ = MID$(Fecha$, 1, 2) dia$ = MID$(Fecha$, 4, 2) an$ = MID$(Fecha$, 7, 4) CurrDia$ = dia$ compufech$ = mes$ + dia$ + an$ help$(1) = "Vendedor 1 a 9 " help$(2) = "Referencia " help$(3) = "Producto " help$(4) = "Unidades " help$(5) = "P.V.P. (Unidad) " Col(1) = 2: vis(1) = 3: max(1) = 1 Col(2) = 9: vis(2) = 6: max(2) = 6 Col(3) = 19: vis(3) = 22: max(3) = 22 Col(4) = 43: vis(4) = 5: max(4) = 3 Col(5) = 51: vis(5) = 10: max(5) = 8 'Open random access file file$ = "T-" + dia$ + mes$ + "." + Cvit$(e) OPEN file$ FOR RANDOM AS #1 LEN = 59 FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ 'Initialize variables CurrString$(1) = "" CurrFig#(2) = 0 CurrFig#(3) = 0 CurrFig#(4) = 0 CurrFig#(5) = 0 CurrFig#(6) = 0 GET #1, 1 IF valid$ <> "SI" THEN LSET IoDia$ = "" LSET IoRef$ = STR$(0) LSET IoDesc$ = "" LSET IoUnd$ = STR$(0) LSET IoCC$ = STR$(0) LSET IoPvp$ = STR$(0) LSET IoPc$ = STR$(0) PUT #1, 2 LSET valid$ = "SI" LSET IoMaxRecord$ = "1" PUT #1, 1 END IF MaxRecord = VAL(IoMaxRecord$) Balance#(0) = 0 A = 1 WHILE A <= MaxRecord GET #1, A + 1 p# = VAL(IoPvp$) p1# = VAL(IoUnd$) p2# = VAL(IoCC$) p3# = VAL(IoPc$) Balance#(A) = p# * p1# * p2# - p1# * p2# * p3# BalTotal# = BalTotal# + Balance#(A) A = A + 1 WEND GOSUB CargaReferencias 'Draw Screen COLOR colors(7, ColorPref), colors(4, ColorPref) Box 2, 1, 21, 80 Box 22, 1, 24, 80 COLOR colors(5, ColorPref), colors(4, ColorPref) LOCATE 1, 1: PRINT SPACE$(80); LOCATE 1, 4: PRINT "Empresa: " + Trim$(Account(e%).Title); 'LOCATE 1, 63: PRINT "Fecha: "; 'LOCATE 1, 63: PRINT "Fecha: " + Fecha$; COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 3, 2: PRINT " No. ³ Ref# ³ Concepto ³ Und ³ P.V.P. ³ Total " LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" u1$ = " ³ ³ ³ ³ ³ " u1x$ = "ßßßßßß³ßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßßßßß" u2$ = "##,###,###" u3$ = "##,###,###,###" u5$ = "###" u6$ = "######" u9$ = "#,###,###,###,###" CurrTopline = 1: bajabarra = 1 GOSUB EditPrintWholeScreen bajabarra = 0 CurrRow = 1 CurrCol = 1 PrintHelpLine help$(CurrCol) + "| " GOSUB EditGetLine finished = false GOSUB EditPrintBalances 'Loop until 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) + "| " CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab CurrCol = (CurrCol) MOD 5 + 1 PrintHelpLine help$(CurrCol) + "| " 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 "¨ 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 "³" + CurrString$(1); ELSE PRINT "³ "; IF CurrFig#(3) <> 0 THEN PRINT "³ "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT "³ "; IF CurrFig#(4) <> 0 THEN PRINT "³ "; : PRINT USING u5$; CurrFig#(4); : PRINT " "; ELSE PRINT "³ "; IF CurrFig#(5) <> 0 THEN PRINT "³"; : PRINT USING u2$; CurrFig#(5); ELSE PRINT "³ "; IF CurrFig#(6) <> 0 THEN PRINT "³"; : PRINT USING u2$; CurrFig#(6); ELSE PRINT "³ "; PRINT "³"; 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 "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" Box 22, 1, 24, 80 LOCATE 23, 2: PRINT CurrString$(1) LOCATE 23, 25: PRINT "³"; LOCATE 23, 26: PRINT USING u9$; PvpTotal#; PRINT "³"; PRINT USING u9$; PcTotal#; PRINT "³"; 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³ Vendedor/a ³ Otros Datos ³ C.A ³N.A" LOCATE 4, 2: PRINT "ÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄ" u$ = "##³\ \³\ \³\ \³ ! " 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¢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) + "| " 'Loop until F2 or 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) + "| " CASE CHR$(0) + "M", CHR$(9) 'Right or Tab CurrCol = (CurrCol) MOD 4 + 1 PrintHelpLine help$(CurrCol) + "| " 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