' ' 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, "<Esc, Mantener> <�� 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 T.P.V." help$(2) = "Ayuda en los men�s" help$(3) = "Modo de grabar los Datos" help$(4) = "Creditos del Terminal Punto de Venta" SubChoice = Menu(1, 4, Choice$(), menuRow(), menuCol(), help$(), false) SELECT CASE SubChoice CASE 1 RETURN CASE 2 RETURN CASE 3 RETURN CASE 4 Box 9, 10, 16, 70 center 10, "T E R M I N A L P U N T O de V E N T A" center 12, "by" center 14, "Jos� 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), Title$(9) gf = 0 Box 17, 5, 21, 75 center 18, "Por Favor Introduzca Fecha" center 19, "con la que guardar ticket del d�a." PrintHelpLine "Fecha: mm - dd - aaaa" DO emp$ = GetString$(20, 7, DATE$, end$, 10, 10) Fecha$ = end$ M = VAL(MID$(Fecha$, 1, 2)) D = VAL(MID$(Fecha$, 4, 2)) IF M <= 12 AND D <= 31 THEN gf = 1 IF LEN(Fecha$) < 10 THEN gf = 0 LOOP WHILE gf = 0 gf = 0 mes$ = MID$(Fecha$, 1, 2) dia$ = MID$(Fecha$, 4, 2) an$ = MID$(Fecha$, 7, 4) CurrDia$ = dia$ compufech$ = mes$ + dia$ + an$ help$(1) = "Vendedor 1 a 9 " help$(2) = "Referencia " help$(3) = "Unidades " Col(1) = 2: vis(1) = 4: max(1) = 1 Col(2) = 9: vis(2) = 6: max(2) = 6 Col(3) = 43: vis(3) = 5: max(3) = 2 'Open random access file OPEN "Vendedor" + Cvit$(e%) FOR RANDOM AS #1 LEN = 69 FIELD #1, 20 AS T$, 43 AS D$, 3 AS C$, 1 AS A$ FIELD #1, 2 AS valid$ FOR tAt = 1 TO 9 GET #1, tAt + 1 Title$(tAt) = T$ NEXT tAt CLOSE file$ = "T-" + dia$ + mes$ + "." + Cvit$(e) OPEN file$ FOR RANDOM AS #1 LEN = 19 FIELD #1, 2 AS IoDia$, 1 AS IoVen$, 6 AS IoRef$, 3 AS IoUnd$ FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ 'Initialize variables CurrFig#(1) = 0 CurrFig#(2) = 0 CurrFig#(3) = 0 GET #1, 1 IF valid$ <> "SI" THEN LSET IoDia$ = "" LSET IoVen$ = STR$(0) LSET IoRef$ = STR$(0) LSET IoUnd$ = STR$(0) PUT #1, 2 LSET valid$ = "SI" LSET IoMaxRecord$ = "1" PUT #1, 1 END IF RecordMin = VAL(IoMaxRecord$) MaxRecord = 1 'MaxRecord = VAL(IoMaxRecord$) GOSUB CargaReferencias 'Draw Screen COLOR colors(7, ColorPref), colors(4, ColorPref) Box 2, 1, 21, 80 Box 22, 1, 24, 80 COLOR colors(5, ColorPref), colors(4, ColorPref) LOCATE 1, 1: PRINT SPACE$(80); LOCATE 1, 4: PRINT "Empresa: " + Trim$(Account(e%).Title); COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 3, 2: PRINT " No. � Ref# � Concepto � Und � P.V.P. � Total " LOCATE 4, 2: PRINT "������������������������������������������������������������������������������" u1$ = " � � � � � " u1x$ = "�����߳�������߳�����������������������߳������߳�����������߳����������������" u2$ = "##,###,###" u3$ = "#,###,###,###" u5$ = "###" u6$ = "######" u9$ = "#,###,###,###,###" CurrTopline = 1: bajabarra = 1 vex = 1 'GOSUB EditPrintWholeScreen CurrRow = 1 vex = 0 temp = CurrRow FOR CurrRow = 1 TO 16 CurrRecord = CurrTopline + CurrRow - 1 GOSUB EditPrintLine NEXT CurrRow CurrRow = temp bajabarra = 0 CurrRow = 1 CurrCol = 1 CurrRecord = CurrTopline + CurrRow - 1 PrintHelpLine help$(CurrCol) + "| <F1=Fichar> <F2=Salir> <F3=Impr. Tiket> <F9=Insert> <F10=Supr>" 'GOSUB EditGetLine finished = false GOSUB EditPrintBalances 'Loop until <F2> is pressed DO GOSUB EditShowCursor 'Show Cursor, Wait for key DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" ed = 1: GOSUB EditShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1 bajabar = 0: bajabarra = 0 IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item GOSUB EditEditItem END IF SELECT CASE kbd$ 'Handle Special keys CASE CHR$(0) + "H" 'up arrow GOSUB EditMoveUp CASE CHR$(0) + "P" 'Down arrow GOSUB EditMoveDown CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab CurrCol = CurrCol - 1 IF CurrCol <= 0 THEN CurrCol = 3 PrintHelpLine help$(CurrCol) + "| <F1=Fichar> <F2=Salir> <F3=Impr. Tiket> <F9=Insert> <F10=Supr>" CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab CurrCol = (CurrCol) MOD 3 + 1 PrintHelpLine help$(CurrCol) + "| <F1=Fichar> <F2=Salir> <F3=Impr. Tiket> <F9=Insert> <F10=Supr>" CASE CHR$(0) + "G" 'Home CurrCol = 1 CASE CHR$(0) + "O" 'End CurrCol = 6 CASE CHR$(0) + "I" 'Page Up CurrRow = 1 CurrTopline = CurrTopline - 16 IF CurrTopline < 1 THEN CurrTopline = 1 END IF '************************ bajabarra = 1 GOSUB EditPrintWholeScreen GOSUB EditGetLine bajabarra = 0 GOSUB PrintBalan CASE CHR$(0) + "Q" 'Page Down CurrRow = 1 CurrTopline = CurrTopline + 16 IF CurrTopline > MaxRecord THEN CurrTopline = MaxRecord END IF bajabarra = 1 GOSUB EditPrintWholeScreen GOSUB EditGetLine bajabarra = 0 GOSUB PrintBalan CASE CHR$(0) + "<" 'F2 finished = true CASE CHR$(0) + "C" 'F9 GOSUB EditAddRecord CASE CHR$(0) + "D" 'F10 GOSUB EditDeleteRecord CASE CHR$(13) 'Enter CASE ELSE BEEP END SELECT LOOP UNTIL finished CLOSE EXIT SUB EditShowCursor: IF ed = 1 THEN COLOR colors(7, ColorPref), colors(4, ColorPref) ELSE COLOR colors(8, ColorPref), colors(9, ColorPref) END IF LOCATE CurrRow + 4, Col(CurrCol) + 1 SELECT CASE CurrCol CASE 1 IF CurrFig#(1) <> 0 THEN PRINT " "; CurrFig#(1); ELSE PRINT " "; CASE 2 IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING "###"; CurrFig#(2); : PRINT " " ELSE PRINT " "; CASE 3 IF CurrFig#(3) <> 0 THEN PRINT " "; : PRINT USING "##"; CurrFig#(3); : PRINT " "; ELSE PRINT " "; END SELECT RETURN EditEditItem: CurrRecord = CurrTopline + CurrRow - 1 COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 1, 63: PRINT "Fecha: "; LOCATE 1, 63: PRINT "Fecha: " + Fecha$; COLOR colors(8, ColorPref), colors(9, ColorPref) GraDat = 0: Clasifica = 0 SELECT CASE CurrCol CASE 1 DO kbd$ = GetString$(CurrRow + 4, Col(CurrCol) + 1, kbd$, new$, vis(CurrCol), max(CurrCol)) LOOP WHILE VAL(new$) > 9 OR VAL(new$) < 1 CurrFig#(1) = VAL(new$) IF RTRIM$(LTRIM$(Title$(CurrFig#(1)))) = "" THEN df = 0 FOR Ol = 16 TO 19 FOR Oc = 24 TO 49 df = df + 1 lin$(df) = CHR$(SCREEN(Ol, Oc)) NEXT Oc, Ol Box 16, 24, 19, 49 LOCATE 17, 25: PRINT "Ese Vendedor no existe" LOCATE 18, 27: PRINT "Verifique el n�mero" DO i$ = INKEY$ LOOP WHILE i$ = "" COLOR colors(7, ColorPref), colors(4, ColorPref) df = 0 FOR Ol = 16 TO 19 FOR Oc = 24 TO 49 df = df + 1 LOCATE Ol, Oc: PRINT lin$(df) NEXT Oc, Ol CurrFig#(1) = 1 ELSE LOCATE 1, 35: PRINT "Vendedor: " + Trim$(Title$(CurrFig#(1))); END IF GOSUB EditPutLine GOSUB EditGetLine CASE 2 start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(2) + 1, start$, new$, vis(2), max(2)) new2# = VAL(new$) start$ = "" LOOP WHILE new2# >= 1001# OR new2# < 0 CurrFig#(2) = new2# reg = 0: b = 1 DO IF Ca#(b) = CurrFig#(2) THEN CurrString$(1) = Cb$(b) CurrFig#(4) = Cd#(b) Clasifica = 1: Valpu = 1 EXIT DO END IF b = b + 1 LOOP WHILE Ca#(b) <> 0 OR b <= TopeRef# + 1 IF Clasifica = 0 THEN df = 0 FOR Ol = 16 TO 19 FOR Oc = 24 TO 49 df = df + 1 lin$(df) = CHR$(SCREEN(Ol, Oc)) NEXT Oc, Ol Box 16, 24, 19, 49 LOCATE 17, 25: PRINT "Esa Referencia no existe" DO i$ = INKEY$ LOOP WHILE i$ = "" COLOR colors(7, ColorPref), colors(4, ColorPref) df = 0 FOR Ol = 16 TO 19 FOR Oc = 24 TO 49 df = df + 1 LOCATE Ol, Oc: PRINT lin$(df) NEXT Oc, Ol CurrFig#(2) = 0 END IF BalTotal# = BalTotal# - Balance#(CurrRecord) Balance#(CurrRecord) = CurrFig#(3) * CurrFig#(4) BalTotal# = BalTotal# + Balance#(CurrRecord) GOSUB EditPutLine GOSUB EditGetLine CASE 3 start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(3) + 1, start$, new$, vis(3), max(3)) new3# = VAL(new$) start$ = "" CurrFig#(3) = new3# LOOP WHILE CurrFig#(3) < 1 OR CurrFig#(3) > 99 BalTotal# = BalTotal# - Balance#(CurrRecord) Balance#(CurrRecord) = CurrFig#(3) * CurrFig#(4) BalTotal# = BalTotal# + Balance#(CurrRecord) GOSUB EditPutLine GOSUB EditGetLine IF der <> CurrRecord THEN ed = 1: GOSUB EditShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1 GOSUB EditAddRecord END IF der = CurrRecord CASE ELSE END SELECT GOSUB EditPrintLine RETURN EditMoveUp: Valpu = 0 'Si La linea actual es igual a la linea minima es decir la ultima entrada. IF CurrRow = 1 THEN IF CurrTopline = 1 THEN BEEP ELSE ScrollDown CurrTopline = CurrTopline - 1 GOSUB EditGetLine GOSUB EditPrintLine END IF ELSE CurrRow = CurrRow - 1 GOSUB EditGetLine END IF GOSUB PrintBalan RETURN EditMoveDown: Valpu = 0 IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN BEEP ELSE IF CurrRow = 16 THEN ScrollUp CurrTopline = CurrTopline + 1 GOSUB EditGetLine GOSUB EditPrintLine ELSE CurrRow = CurrRow + 1 GOSUB EditGetLine END IF END IF GOSUB PrintBalan RETURN EditPrintLine: COLOR colors(7, ColorPref), colors(4, ColorPref) CurrRecord = CurrTopline + CurrRow - 1 LOCATE CurrRow + 4, 2 IF CurrRecord = MaxRecord + 1 THEN PRINT u1x$; ELSEIF CurrRecord > MaxRecord THEN PRINT u1$; ELSE IF CurrFig#(1) <> 0 THEN PRINT " "; CurrFig#(1); ELSE PRINT " "; IF CurrFig#(2) <> 0 THEN PRINT "� "; : PRINT USING "###"; CurrFig#(2); : PRINT " "; ELSE PRINT "� "; IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "� " + CurrString$(1) + " "; ELSE PRINT "� "; IF CurrFig#(3) <> 0 THEN PRINT "� "; : PRINT USING "##"; CurrFig#(3); : PRINT " "; ELSE PRINT "� "; IF CurrFig#(4) <> 0 THEN PRINT "� "; : PRINT USING u2$; CurrFig#(4); : PRINT " �"; ELSE PRINT "� �"; IF Balance#(CurrRecord) <> 0 THEN PRINT USING u3$; Balance#(CurrRecord); ELSE PRINT " " IF bajabar <> 1 THEN GOSUB EditPrintBalances END IF RETURN EditPrintBalances: COLOR colors(7, ColorPref), colors(4, ColorPref) FOR tAt = 1 TO 16 CurrRecord = CurrTopline + tAt - 1 IF CurrRecord <= MaxRecord THEN LOCATE 4 + tAt, 67 PRINT USING u3$; Balance#(CurrTopline + tAt - 1); END IF NEXT tAt CurrRecord = CurrTopline + CurrRow - 1 PrintBalan: IF bajabarra <> 1 THEN COLOR colors(7, ColorPref), colors(4, ColorPref) PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) LOCATE 21, 1: PRINT "��������������������������������������������������������������������������������" 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 = RecordMin THEN BEEP ELSE CurrRecord = CurrTopline + CurrRow - 1 MaxRecord = MaxRecord - 1 A = CurrRecord BalTotal# = BalTotal# - Balance#(CurrRecord) WHILE A <= MaxRecord GET #1, A + 2 + RecordMin PUT #1, A + 1 + RecordMin Balance#(A) = Balance#(A + 1) A = A + 1 WEND Balance#(MaxRecord + 1) = 0 LSET valid$ = "SI" LSET IoMaxRecord$ = Cvit$(MaxRecord) PUT #1, 1 GOSUB EditPrintWholeScreen CurrRecord = CurrTopline + CurrRow - 1 IF CurrRecord > MaxRecord THEN GOSUB EditMoveUp END IF bajabar = 0 GOSUB EditGetLine END IF RETURN EditAddRecord: bajabar = 1 CurrRecord = CurrTopline + CurrRow - 1 A = MaxRecord tb = 0 WHILE A > CurrRecord GET #1, A + 1 + RecordMin PUT #1, A + 2 + RecordMin Balance#(A + 1) = Balance#(A) A = A - 1 WEND Balance#(CurrRecord + 1) = 0 MaxRecord = MaxRecord + 1 LSET IoVen$ = STR$(0) LSET IoRef$ = STR$(0) LSET IoUnd$ = STR$(0) CurrString$(1) = "": CurrFig#(4) = 0 PUT #1, CurrRecord + 2 + RecordMin LSET valid$ = "SI" LSET IoMaxRecord$ = Cvit$(MaxRecord) PUT #1, 1 GOSUB EditPrintWholeScreen GOSUB EditGetLine RETURN EditPrintWholeScreen: vex = 0 temp = CurrRow FOR CurrRow = 1 TO 16 CurrRecord = CurrTopline + CurrRow - 1 IF MaxRecord <> RecordMin OR vex = 0 THEN IF CurrRecord <= MaxRecord THEN GOSUB EditGetLine END IF END IF GOSUB EditPrintLine NEXT CurrRow CurrRow = temp RETURN EditPutLine: Graba = CurrRecord + RecordMin CurrRecord = CurrTopline + CurrRow - 1 LSET IoDia$ = CurrDia$ LSET IoVen$ = LTRIM$(RTRIM$(STR$(CurrFig#(1)))) LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) LSET IoUnd$ = LTRIM$(RTRIM$(STR$(CurrFig#(3)))) PUT #1, CurrRecord + RecordMin RETURN EditGetLine: Graba = CurrRecord + RecordMin CurrRecord = CurrTopline + CurrRow - 1 GET #1, CurrRecord + RecordMin dia$ = IoDia$ CurrFig#(1) = VAL(IoVen$) CurrFig#(2) = VAL(IoRef$) CurrFig#(3) = VAL(IoUnd$) compufech$ = mes$ + "-" + dia$ + "-" + an$ LOCATE 1, 63: PRINT "Fecha: "; LOCATE 1, 63: PRINT "Fecha: " + compufech$; RETURN CargaReferencias: CLS Box 14, 28, 17, 51 center 15, "Cargando referencias" center 16, "Por favor, espere..." file2$ = "Ref#." + Cvit$(e%) OPEN file2$ FOR RANDOM AS #2 LEN = 54 FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ GET #2, 1 IF vld$ <> "SI" THEN LSET IRf$ = STR$(0) LSET IDsc$ = "" LSET ICC$ = STR$(0) LSET IPVP$ = STR$(0) LSET IPC$ = STR$(0) PUT #2, 2 LSET vld$ = "SI" LSET IMxRcrd$ = "1" PUT #2, 1 END IF TopeRef# = VAL(IMxRcrd$) b = 1 WHILE b <= TopeRef# GET #2, b + 1 Ca#(b) = VAL(IRf$) Cb$(b) = IDsc$ Cc#(b) = VAL(ICC$) Cd#(b) = VAL(IPVP$) Ce#(b) = VAL(IPC$) b = b + 1 WEND CLOSE #2 RETURN END SUB 'Trin$: ' Remove null and spaces from the end of a string. FUNCTION Trim$ (x$) IF x$ = "" THEN Trim$ = "" ELSE lastChar = 0 FOR A = 1 TO LEN(x$) y$ = MID$(x$, A, 1) IF y$ <> CHR$(0) AND y$ <> " " THEN lastChar = A END IF NEXT A Trim$ = LEFT$(x$, lastChar) END IF END FUNCTION SUB Vende (r%) Save = 0 'Information about each column REDIM help$(4), Col(4), vis(4), max(4), Title$(9), Desc$(9), Ca$(9), AType$(9) 'Draw the screen COLOR colors(7, ColorPref), colors(4, ColorPref) OPEN "Vendedor" + Cvit$(r%) FOR RANDOM AS #1 LEN = 69 FIELD #1, 20 AS T$, 43 AS D$, 3 AS C$, 1 AS A$ FIELD #1, 2 AS valid$ FOR A = 1 TO 9 GET #1, A + 1 Title$(A) = T$ Desc$(A) = D$ Ca$(A) = C$ AType$(A) = A$ NEXT A CLOSE Box 2, 1, 14, 80 Box 15, 1, 18, 80 COLOR colors(5, ColorPref), colors(4, ColorPref) LOCATE 1, 1: PRINT SPACE$(80) LOCATE 1, 4: PRINT "Editor de Vendedores, Empresa: " + Trim$(Account(r%).Title); COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 3, 2: PRINT "No� 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) = 43: vis(3) = 3: vis(4) = 1 max(1) = 20: max(2) = 43: max(3) = 3: max(4) = 1 finished = false CurrRow = 1 CurrCol = 1 PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <Esc=Anula>" 'Loop until F2 or <ESC> is pressed DO GOSUB EditAccountsShowCursor 'Show Cursor DO 'Wait for key kbd$ = INKEY$ LOOP UNTIL kbd$ <> "" IF kbd$ >= " " AND kbd$ < "~" THEN 'If legal, edit item COLOR colors(8, ColorPref), colors(9, ColorPref) ok = false start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(CurrCol), start$, end$, vis(CurrCol), max(CurrCol)) SELECT CASE CurrCol CASE 1: Title$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) CASE 2: Desc$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) CASE 3: Ca$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) CASE 4: AType$(CurrRow) = LEFT$(end$ + SPACE$(max(CurrCol)), max(CurrCol)) CASE ELSE END SELECT start$ = "" IF CurrCol = 4 THEN x$ = UCASE$(end$) IF VAL(x$) >= 1 OR VAL(x$) <= 5 THEN ok = true ELSE BEEP END IF ELSE ok = true END IF LOOP UNTIL ok END IF hide = 1: GOSUB EditAccountsShowCursor: hide = 0 'Hide Cursor so it can move 'If it needs to SELECT CASE kbd$ CASE CHR$(0) + "H" 'Up Arrow CurrRow = CurrRow - 1 IF CurrRow <= 0 THEN CurrRow = 9 CASE CHR$(0) + "P" 'Down Arrow CurrRow = (CurrRow) MOD 9 + 1 CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab CurrCol = (CurrCol + 4) MOD 3 + 1 PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <Esc=Anula>" CASE CHR$(0) + "M", CHR$(9) 'Right or Tab CurrCol = (CurrCol) MOD 4 + 1 PrintHelpLine help$(CurrCol) + "| <F2=Guardar y Salir> <Esc=Anula>" CASE CHR$(0) + "<" 'F2 finished = true Save = 1 CASE CHR$(27) 'Esc finished = true Save = false CASE CHR$(13) 'Return CASE ELSE BEEP END SELECT LOOP UNTIL finished IF Save = 1 THEN OPEN "Vendedor" + Cvit$(r%) FOR RANDOM AS #1 LEN = 69 FIELD #1, 20 AS T$, 43 AS D$, 3 AS C$, 1 AS A$ FIELD #1, 2 AS valid$ FOR A = 1 TO 9 LSET T$ = Title$(A) LSET D$ = Desc$(A) LSET C$ = Ca$(A) LSET A$ = AType$(A) PUT #1, A + 1 NEXT A CLOSE END IF EXIT SUB EditAccountsShowCursor: IF hide = 0 THEN COLOR colors(8, ColorPref), colors(9, ColorPref) ELSE COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE CurrRow + 4, Col(CurrCol) SELECT CASE CurrCol CASE 1: PRINT Title$(CurrRow) CASE 2: PRINT Desc$(CurrRow) CASE 3: PRINT Ca$(CurrRow) CASE 4: PRINT AType$(CurrRow) CASE ELSE END SELECT RETURN END SUB