DECLARE SUB Vende (r%) DECLARE SUB Elif () DECLARE SUB Staul () DECLARE SUB Ticket (e%) DECLARE SUB Stock (EE%) DECLARE SUB Balan (EEE%) ' ' Q B a s i c P e r s o n a l F i n a n c i a l ' ' Copyright (C) Microsoft Corporation 1990 'Set default data type to integer for faster operation DEFINT A-Z 'Sub and function declarations DECLARE SUB Proveedores (lug%) DECLARE SUB LCenter (text$) DECLARE SUB ScrollUp () DECLARE SUB ScrollDown () DECLARE SUB Initialize () DECLARE SUB center (Row%, text$) DECLARE SUB FancyCls (dots%, Background%) DECLARE SUB LoadState () DECLARE SUB SaveState () DECLARE SUB MenuSystem () DECLARE SUB box (Row1%, Col1%, Row2%, Col2%) DECLARE SUB PrintHelpLine (help$) DECLARE SUB EditTrans (item%) DECLARE SUB Referencias (op%) DECLARE SUB ImpRef (po%) DECLARE SUB ImpComp (so%) DECLARE FUNCTION Cvdt$ (x#) DECLARE FUNCTION Cvst$ (x!) DECLARE FUNCTION Cvit$ (x%) DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%) DECLARE FUNCTION GetString$ (Row%, Col%, start$, end$, vis%, max%) DECLARE FUNCTION Trim$ (x$) 'Constants CONST true = -1 CONST false = NOT true 'User-defined types TYPE AccountType Title AS STRING * 20 AType AS STRING * 1 Desc AS STRING * 50 END TYPE TYPE Recordtype Date AS STRING * 8 Ref AS STRING * 10 Desc AS STRING * 50 Fig1 AS DOUBLE Fig2 AS DOUBLE END TYPE 'Global variables DIM SHARED account(1 TO 19) AS AccountType 'Stores the 19 account titles DIM SHARED ColorPref 'Color Preference DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors DIM SHARED ScrollUpAsm(1 TO 7) 'Assembly Language Routines DIM SHARED ScrollDownAsm(1 TO 7) DIM SHARED printerr AS INTEGER 'Printer error flag DIM SHARED Fecha$(1), fech$(1) DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock KeyFlags = PEEK(1047) POKE 1047, &H0 DEF SEG 'Open money manager data file. If it does not exist in current directory, ' goto error handler to create and initialize it. ON ERROR GOTO ErrorTrap OPEN "Personal.cfg" FOR INPUT AS #1 CLOSE ON ERROR GOTO 0 'Reset error handler Initialize 'Initialize program MenuSystem 'This is the main program COLOR 7, 0 'Clear screen and end CLS DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states POKE 1047, KeyFlags DEF SEG END ' Error handler for program ' If data file not found, create and initialize a new one. ErrorTrap: SELECT CASE ERR ' If data file not found, create and initialize a new one. CASE 53 CLOSE ColorPref = 1 FOR a = 1 TO 19 account(a).Title = "" account(a).AType = "" account(a).Desc = "" NEXT a SaveState RESUME CASE 24, 25 printerr = true box 8, 13, 14, 69 center 11, "La impresora no responde ..." center 12, "Presione Barra espaciadora para continuar" WHILE INKEY$ <> "": WEND RESUME NEXT CASE ELSE END SELECT RESUME NEXT ErrorCaj: OPEN "Caja.cfg" FOR OUTPUT AS #1 PRINT #1, "N" CLOSE RESUME NEXT 'The following data defines the color schemes available via the main menu. ' ' scrn dots bar back title shdow choice curs cursbk shdow DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0 DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0 DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0 DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0 'The following data is actually a machine language program to 'scroll the screen up or down very fast using a BIOS call. DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB SUB Balan (EE%) END SUB 'Box: ' Draw a box on the screen between the given coordinates. SUB box (Row1, Col1, Row2, Col2) STATIC BoxWidth = Col2 - Col1 + 1 LOCATE Row1, Col1 PRINT "Ú"; 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 'Cvdt$: ' Convert a double precision number to a string WITHOUT a leading space. FUNCTION Cvdt$ (x#) Cvdt$ = RIGHT$(STR$(x#), LEN(STR$(x#)) - 1) END FUNCTION 'Cvit$: ' Convert an integer to a string WITHOUT a leading space. FUNCTION Cvit$ (x) Cvit$ = RIGHT$(STR$(x), LEN(STR$(x)) - 1) END FUNCTION 'Cvst$: ' Convert a single precision number to a string WITHOUT a leading space FUNCTION Cvst$ (x!) Cvst$ = RIGHT$(STR$(x!), LEN(STR$(x!)) - 1) END FUNCTION 'EditTrans: ' This is the full-screen editor which allows you to enter and change ' transactions SUB EditTrans (item%) 'Stores info about each column REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6) 'Array to keep the current balance at all the transactions REDIM Balance#(1000), Ca#(1000), Cb$(1000), Cc#(1000), Cd#(1000), Ce#(1000), lin$(155) gf = 0 box 17, 5, 21, 75 center 18, "Por Favor Introduzca Fecha" center 19, "con la que realizar la transacci¢n" PrintHelpLine "Fecha: mm - dd - aaaa" DO emp$ = GetString$(20, 7, DATE$, end$, 10, 10) Fecha$ = end$ M = VAL(MID$(Fecha$, 1, 2)) D = VAL(MID$(Fecha$, 4, 2)) IF M <= 12 AND D <= 31 THEN gf = 1 IF LEN(Fecha$) < 10 THEN gf = 0 LOOP WHILE gf = 0 gf = 0 mes$ = MID$(Fecha$, 1, 2) dia$ = MID$(Fecha$, 4, 2) an$ = MID$(Fecha$, 7, 4) CurrDia$ = dia$ compufech$ = mes$ + dia$ + an$ 'Open random access file file$ = "E-" + mes$ + an$ + "." + Cvit$(item) OPEN file$ FOR RANDOM AS #1 LEN = 59 FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ 'Initialize variables CurrString$(1) = "" CurrFig#(2) = 0 CurrFig#(3) = 0 CurrFig#(4) = 0 CurrFig#(5) = 0 CurrFig#(6) = 0 GET #1, 1 IF valid$ <> "SI" THEN LSET IoDia$ = "" LSET IoRef$ = STR$(0) LSET IoDesc$ = "" LSET IoUnd$ = STR$(0) LSET IoCC$ = STR$(0) LSET IoPvp$ = STR$(0) LSET IoPc$ = STR$(0) PUT #1, 2 LSET valid$ = "SI" LSET IoMaxRecord$ = "1" PUT #1, 1 END IF MaxRecord = VAL(IoMaxRecord$) Balance#(0) = 0 a = 1 WHILE a <= MaxRecord GET #1, a + 1 p# = VAL(IoPvp$) p1# = VAL(IoUnd$) p2# = VAL(IoCC$) p3# = VAL(IoPc$) Balance#(a) = p# * p1# * p2# - p1# * p2# * p3# BalTotal# = BalTotal# + Balance#(a) a = a + 1 WEND GOSUB CargaCienReferencias help$(1) = "Referencia del Producto " help$(2) = "Producto (sin Referencia o nuevo) " help$(3) = "Unidades totales " help$(4) = "Unidades parciales, ( o por caja ) " help$(5) = "P.V.P. del Producto, ( por unidad )" help$(6) = "Precio de Costo, ( la unidad ) " Col(1) = 2: vis(1) = 6: max(1) = 6 Col(2) = 9: vis(2) = 22: max(2) = 22 Col(3) = 32: vis(3) = 5: max(3) = 3 Col(4) = 38: vis(4) = 5: max(4) = 3 Col(5) = 44: vis(5) = 10: max(5) = 8 Col(6) = 55: vis(6) = 10: max(6) = 8 'Draw Screen COLOR colors(7, ColorPref), colors(4, ColorPref) box 2, 1, 21, 80 box 22, 1, 24, 80 COLOR colors(5, ColorPref), colors(4, ColorPref) LOCATE 1, 1: PRINT SPACE$(80); LOCATE 1, 4: PRINT "Empresa: " + Trim$(account(item).Title); 'LOCATE 1, 63: PRINT "Fecha: "; 'LOCATE 1, 63: PRINT "Fecha: " + Fecha$; COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 3, 2: PRINT " Ref# ³ Concepto ³ Und ³Und/C³ P.V.P. ³ P.C. ³ Beneficios " LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" u1$ = " ³ ³ ³ ³ ³ ³ " u1x$ = "ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßß³ßßßßß³ßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßßßß" u2$ = "##,###,###" u3$ = "##,###,###,###" u5$ = "###" u6$ = "######" u9$ = "#,###,###,###,###" CurrTopline = 1: bajabarra = 1 GOSUB EditTransPrintWholeScreen bajabarra = 0 CurrRow = 1 CurrCol = 1 PrintHelpLine help$(CurrCol) + "| " GOSUB EditTransGetLine finished = false GOSUB EditTransPrintBalances 'Loop until is pressed DO GOSUB EditTransShowCursor 'Show Cursor, Wait for key DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" ed = 1: GOSUB EditTransShowCursor: ed = 0: 'Oculta el cursor para obtener datos ED=1 bajabar = 0: bajabarra = 0 IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item GOSUB EditTransEditItem END IF SELECT CASE kbd$ 'Handle Special keys CASE CHR$(0) + "H" 'up arrow GOSUB EditTransMoveUp CASE CHR$(0) + "P" 'Down arrow GOSUB EditTransMoveDown CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab CurrCol = (CurrCol + 4) MOD 6 + 1 PrintHelpLine help$(CurrCol) + "| " CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab CurrCol = (CurrCol) MOD 6 + 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 EditTransPrintWholeScreen GOSUB EditTransGetLine bajabarra = 0 GOSUB PrintBalances CASE CHR$(0) + "Q" 'Page Down CurrRow = 1 CurrTopline = CurrTopline + 16 IF CurrTopline > MaxRecord THEN CurrTopline = MaxRecord END IF bajabarra = 1 GOSUB EditTransPrintWholeScreen GOSUB EditTransGetLine bajabarra = 0 GOSUB PrintBalances CASE CHR$(0) + "<" 'F2 finished = true CASE CHR$(0) + "C" 'F9 GOSUB EditTransAddRecord CASE CHR$(0) + "D" 'F10 GOSUB EditTransDeleteRecord CASE CHR$(13) 'Enter CASE ELSE BEEP END SELECT LOOP UNTIL finished CLOSE EXIT SUB EditTransShowCursor: IF ed = 1 THEN COLOR colors(7, ColorPref), colors(4, ColorPref) ELSE COLOR colors(8, ColorPref), colors(9, ColorPref) END IF LOCATE CurrRow + 4, Col(CurrCol) SELECT CASE CurrCol CASE 1 IF CurrFig#(2) <> 0 THEN PRINT USING u6$; CurrFig#(2); ELSE PRINT " "; END IF CASE 2 IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT LEFT$(CurrString$(1), vis(2)); ELSE PRINT SPACE$(vis(2)) END IF CASE 3 IF CurrFig#(3) <> 0 THEN PRINT " "; PRINT USING u5$; CurrFig#(3); PRINT " "; ELSE PRINT " "; END IF CASE 4 IF CurrFig#(4) <> 0 THEN PRINT " "; PRINT USING u5$; CurrFig#(4); PRINT " "; ELSE PRINT " "; END IF CASE 5 IF CurrFig#(5) <> 0 THEN PRINT USING u2$; CurrFig#(5); ELSE PRINT " "; END IF CASE 6 IF CurrFig#(6) <> 0 THEN PRINT USING u2$; CurrFig#(6); ELSE PRINT " "; END IF END SELECT RETURN EditTransEditItem: CurrRecord = CurrTopline + CurrRow - 1 COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 1, 63: PRINT "Fecha: "; LOCATE 1, 63: PRINT "Fecha: " + Fecha$; COLOR colors(8, ColorPref), colors(9, ColorPref) GraDat = 0: Clasifica = 0 SELECT CASE CurrCol CASE 1 start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(1), start$, new$, vis(1), max(1)) new1# = VAL(new$) start$ = "" LOOP WHILE new1# >= 1001# OR new1# < 0 CurrFig#(2) = new1# reg = 0: b = 1 DO IF Ca#(b) = CurrFig#(2) THEN CurrString$(1) = Cb$(b) CurrFig#(4) = Cc#(b) CurrFig#(5) = Cd#(b) CurrFig#(6) = Ce#(b) Clasifica = 1: Valpu = 1 EXIT DO END IF b = b + 1 LOOP WHILE Ca#(b) <> 0 OR b <= TopeRef# + 1 IF Clasifica = 0 THEN df = 0 FOR Ol = 16 TO 19 FOR Oc = 24 TO 49 df = df + 1 lin$(df) = CHR$(SCREEN(Ol, Oc)) NEXT Oc, Ol box 16, 24, 19, 49 IF TopeRef# = 999 THEN LOCATE 17, 25: PRINT " Lo siento, referencias " LOCATE 18, 25: PRINT "AGOTADAS, elimine alguna" ELSE LOCATE 17, 25: PRINT "Esa Referencia no existe" LOCATE 18, 25: PRINT "¨ Desea crearla ? (S/N) " DO i$ = INKEY$ LOOP WHILE i$ = "" COLOR colors(7, ColorPref), colors(4, ColorPref) df = 0 FOR Ol = 16 TO 19 FOR Oc = 24 TO 49 df = df + 1 LOCATE Ol, Oc: PRINT lin$(df) NEXT Oc, Ol IF i$ = "s" OR i$ = "S" THEN Valpu = 0 TopeRef# = TopeRef# + 1 GraDat = 1 GraCurrDat = CurrTopline + CurrRow - 1 ELSEIF i$ = "n" OR i$ = "N" THEN CurrFig#(2) = 0 END IF END IF END IF GOSUB EditTransPutLine GOSUB EditTransGetLine BalTotal# = BalTotal# - Balance#(CurrRecord) PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) Balance#(CurrRecord) = PvpTotal# - PcTotal# BalTotal# = BalTotal# + Balance#(CurrRecord) CASE 2 IF Valpu = 0 THEN kbd$ = GetString$(CurrRow + 4, Col(CurrCol), kbd$, new$, vis(CurrCol), max(CurrCol)) CurrString$(1) = new$ END IF GOSUB EditTransPutLine GOSUB EditTransGetLine CASE 3 start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(3), start$, new$, vis(3), max(3)) new3# = VAL(new$) start$ = "" IF CurrFig#(4) <= 100# AND new3# <= 601# OR new3# <= 0 THEN EXIT DO IF CurrFig#(4) > 100# AND new3# <= 11 OR new3# <= 0 THEN EXIT DO LOOP CurrFig#(3) = new3# GOSUB EditTransPutLine GOSUB EditTransGetLine BalTotal# = BalTotal# - Balance#(CurrRecord) PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) Balance#(CurrRecord) = PvpTotal# - PcTotal# BalTotal# = BalTotal# + Balance#(CurrRecord) CASE 4 IF Valpu = 0 THEN start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(4), start$, new$, vis(4), max(4)) new4# = VAL(new$) start$ = "" IF CurrFig#(3) <= 10 AND new4# <= 601 OR new4# <= 0 THEN EXIT DO IF CurrFig#(3) > 10 AND new4# <= 101 OR new4# <= 0 THEN EXIT DO LOOP CurrFig#(4) = new4# END IF GOSUB EditTransPutLine GOSUB EditTransGetLine BalTotal# = BalTotal# - Balance#(CurrRecord) PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) Balance#(CurrRecord) = PvpTotal# - PcTotal# BalTotal# = BalTotal# + Balance#(CurrRecord) CASE 5 IF Valpu = 0 THEN start$ = kbd$ old3# = CurrFig#(5) DO kbd$ = GetString$(CurrRow + 4, Col(5), start$, new$, vis(5), max(5)) new5# = VAL(new$) start$ = "" LOOP WHILE new5# >= 75001# OR new5# < 0 a = CurrRecord CurrFig#(5) = new5# END IF GOSUB EditTransPutLine GOSUB EditTransGetLine BalTotal# = BalTotal# - Balance#(CurrRecord) PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) Balance#(CurrRecord) = PvpTotal# - PcTotal# BalTotal# = BalTotal# + Balance#(CurrRecord) CASE 6 IF Valpu = 0 THEN start$ = kbd$ old4# = CurrFig#(6) DO kbd$ = GetString$(CurrRow + 4, Col(6), start$, new$, vis(6), max(6)) new6# = VAL(new$) start$ = "" LOOP WHILE new6# >= 75001# OR new6# < 0 a = CurrRecord CurrFig#(6) = new6# END IF GOSUB EditTransPutLine GOSUB EditTransGetLine BalTotal# = BalTotal# - Balance#(CurrRecord) PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) Balance#(CurrRecord) = PvpTotal# - PcTotal# BalTotal# = BalTotal# + Balance#(CurrRecord) CASE ELSE END SELECT GOSUB EditTransPrintLine RETURN EditTransMoveUp: Valpu = 0 IF CurrRow = 1 THEN IF CurrTopline = 1 THEN BEEP ELSE ScrollDown CurrTopline = CurrTopline - 1 GOSUB EditTransGetLine GOSUB EditTransPrintLine END IF ELSE CurrRow = CurrRow - 1 GOSUB EditTransGetLine END IF GOSUB PrintBalances RETURN EditTransMoveDown: Valpu = 0 IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN BEEP ELSE IF CurrRow = 16 THEN ScrollUp CurrTopline = CurrTopline + 1 GOSUB EditTransGetLine GOSUB EditTransPrintLine ELSE CurrRow = CurrRow + 1 GOSUB EditTransGetLine END IF END IF GOSUB PrintBalances RETURN EditTransPrintLine: COLOR colors(7, ColorPref), colors(4, ColorPref) CurrRecord = CurrTopline + CurrRow - 1 LOCATE CurrRow + 4, 2 IF CurrRecord = MaxRecord + 1 THEN PRINT u1x$; ELSEIF CurrRecord > MaxRecord THEN PRINT u1$; ELSE IF CurrFig#(2) <> 0 THEN PRINT USING u6$; CurrFig#(2); ELSE PRINT " "; IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "³" + 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 EditTransPrintBalances END IF RETURN EditTransPrintBalances: COLOR colors(7, ColorPref), colors(4, ColorPref) FOR a = 1 TO 16 CurrRecord = CurrTopline + a - 1 IF CurrRecord <= MaxRecord THEN LOCATE 4 + a, 66 PRINT USING u3$; Balance#(CurrTopline + a - 1); END IF NEXT a PrintBalances: IF bajabarra <> 1 THEN COLOR colors(7, ColorPref), colors(4, ColorPref) PvpTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(5) PcTotal# = CurrFig#(3) * CurrFig#(4) * CurrFig#(6) LOCATE 21, 1: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ" 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 EditTransDeleteRecord: bajabar = 1 IF MaxRecord = 1 THEN BEEP ELSE CurrRecord = CurrTopline + CurrRow - 1 MaxRecord = MaxRecord - 1 a = CurrRecord BalTotal# = BalTotal# - Balance#(CurrRecord) WHILE a <= MaxRecord GET #1, a + 2 PUT #1, a + 1 Balance#(a) = Balance#(a + 1) a = a + 1 WEND Balance#(MaxRecord + 1) = 0 LSET valid$ = "SI" LSET IoMaxRecord$ = Cvit$(MaxRecord) PUT #1, 1 GOSUB EditTransPrintWholeScreen CurrRecord = CurrTopline + CurrRow - 1 IF CurrRecord > MaxRecord THEN GOSUB EditTransMoveUp END IF bajabar = 0 GOSUB EditTransGetLine END IF RETURN EditTransAddRecord: bajabar = 1 CurrRecord = CurrTopline + CurrRow - 1 a = MaxRecord tb = 0 WHILE a > CurrRecord GET #1, a + 1 PUT #1, a + 2 Balance#(a + 1) = Balance#(a) a = a - 1 WEND Balance#(CurrRecord + 1) = 0 MaxRecord = MaxRecord + 1 LSET IoRef$ = STR$(0) LSET IoDesc$ = "" LSET IoUnd$ = STR$(0) LSET IoCC$ = STR$(0) LSET IoPvp$ = STR$(0) LSET IoPc$ = STR$(0) PUT #1, CurrRecord + 2 LSET valid$ = "SI" LSET IoMaxRecord$ = Cvit$(MaxRecord) PUT #1, 1 GOSUB EditTransPrintWholeScreen GOSUB EditTransGetLine RETURN EditTransPrintWholeScreen: temp = CurrRow FOR CurrRow = 1 TO 16 CurrRecord = CurrTopline + CurrRow - 1 IF CurrRecord <= MaxRecord THEN GOSUB EditTransGetLine END IF GOSUB EditTransPrintLine NEXT CurrRow CurrRow = temp RETURN EditTransPutLine: CurrRecord = CurrTopline + CurrRow - 1 LSET IoDia$ = CurrDia$ LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) LSET IoDesc$ = CurrString$(1) LSET IoUnd$ = LTRIM$(RTRIM$(STR$(CurrFig#(3)))) LSET IoCC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) LSET IoPvp$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) LSET IoPc$ = LTRIM$(RTRIM$(STR$(CurrFig#(6)))) PUT #1, CurrRecord + 1 IF GraCurrDat = CurrRecord THEN file2$ = "Ref#." + Cvit$(item%) OPEN file2$ FOR RANDOM AS #2 LEN = 54 FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ LSET IRf$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) LSET IDsc$ = CurrString$(1) LSET ICC$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) LSET IPVP$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) LSET IPC$ = LTRIM$(RTRIM$(STR$(CurrFig#(6)))) PUT #2, TopeRef# LSET vld$ = "SI" LSET IMxRcrd$ = LTRIM$(RTRIM$(STR$(TopeRef#))) PUT #2, 1 TopeRef# = VAL(IMxRcrd$) Ca#(TopeRef#) = CurrFig#(2) Cb$(TopeRef#) = CurrString$(1) Cc#(TopeRef#) = CurrFig#(4) Cd#(TopeRef#) = CurrFig#(5) Ce#(TopeRef#) = CurrFig#(6) CLOSE #2 END IF RETURN EditTransGetLine: CurrRecord = CurrTopline + CurrRow - 1 GET #1, CurrRecord + 1 dia$ = IoDia$ CurrFig#(2) = VAL(IoRef$) CurrString$(1) = IoDesc$ CurrFig#(3) = VAL(IoUnd$) CurrFig#(4) = VAL(IoCC$) CurrFig#(5) = VAL(IoPvp$) CurrFig#(6) = VAL(IoPc$) compufech$ = mes$ + "-" + dia$ + "-" + an$ LOCATE 1, 63: PRINT "Fecha: "; LOCATE 1, 63: PRINT "Fecha: " + compufech$; RETURN CargaCienReferencias: CLS box 14, 28, 17, 51 LOCATE 15, 30: PRINT "Cargando referencias" LOCATE 16, 30: PRINT "Por favor, espere..." file2$ = "Ref#." + Cvit$(item%) OPEN file2$ FOR RANDOM AS #2 LEN = 54 FIELD #2, 6 AS IRf$, 22 AS IDsc$, 3 AS ICC$, 8 AS IPVP$, 8 AS IPC$ FIELD #2, 2 AS vld$, 5 AS IMxRcrd$ GET #2, 1 IF vld$ <> "SI" THEN LSET IRf$ = STR$(0) LSET IDsc$ = "" LSET ICC$ = STR$(0) LSET IPVP$ = STR$(0) LSET IPC$ = STR$(0) PUT #2, 2 LSET vld$ = "SI" LSET IMxRcrd$ = "1" PUT #2, 1 END IF TopeRef# = VAL(IMxRcrd$) b = 1 WHILE b <= TopeRef# GET #2, b + 1 Ca#(b) = VAL(IRf$) Cb$(b) = IDsc$ Cc#(b) = VAL(ICC$) Cd#(b) = VAL(IPVP$) Ce#(b) = VAL(IPC$) b = b + 1 WEND CLOSE #2 RETURN END SUB SUB Elif END SUB 'FancyCls: ' Clears screen in the right color, and draws nice dots. SUB FancyCls (dots, Background) VIEW PRINT 2 TO 24 COLOR dots, Background CLS 2 FOR a = 95 TO 1820 STEP 45 Row = a / 80 + 1 Col = a MOD 80 + 1 LOCATE Row, Col PRINT CHR$(250); NEXT a VIEW PRINT END SUB 'GetString$: ' Given a row and col, and an initial string, edit a string ' VIS is the length of the visible field of entry ' MAX is the maximum number of characters allowed in the string FUNCTION GetString$ (Row, Col, start$, end$, vis, max) Curr$ = Trim$(LEFT$(start$, max)) IF Curr$ = CHR$(8) THEN Curr$ = "" LOCATE , , 1 finished = false DO GOSUB GetStringShowText GOSUB GetStringGetKey IF LEN(kbd$) > 1 THEN finished = true GetString$ = kbd$ ELSE SELECT CASE kbd$ CASE CHR$(13), CHR$(27), CHR$(9) finished = true GetString$ = kbd$ CASE CHR$(8) IF Curr$ <> "" THEN Curr$ = LEFT$(Curr$, LEN(Curr$) - 1) END IF CASE " " TO "}" IF LEN(Curr$) < max THEN Curr$ = Curr$ + kbd$ ELSE BEEP END IF CASE ELSE BEEP END SELECT END IF LOOP UNTIL finished end$ = Curr$ LOCATE , , 0 EXIT FUNCTION GetStringShowText: LOCATE Row, Col IF LEN(Curr$) > vis THEN PRINT RIGHT$(Curr$, vis); ELSE PRINT Curr$; SPACE$(vis - LEN(Curr$)); LOCATE Row, Col + LEN(Curr$) END IF RETURN GetStringGetKey: kbd$ = "" WHILE kbd$ = "" kbd$ = INKEY$ WEND RETURN END FUNCTION SUB ImpComp (so%) 'Stores info about each column 'Array to keep the current balance at all the transactions REDIM Col(6), Balance#(1000) mes$ = MID$(DATE$, 1, 2) an$ = MID$(DATE$, 7, 4) comes$ = mes$ + "-" + an$ gf = 0 box 17, 5, 21, 75 center 18, "Por Favor Introduzca Mes y a¤o" center 19, "para imprimir gastos." PrintHelpLine "Mes y A¤o: mm-aaaa" DO emp$ = GetString$(20, 7, comes$, end$, 10, 10) Fecha$ = end$ mes$ = MID$(Fecha$, 1, 2) IF VAL(mes$) <= 12 THEN gf = 1 IF LEN(Fecha$) < 7 THEN gf = 0 LOOP WHILE gf = 0 gf = 0 mes$ = MID$(Fecha$, 1, 2) an$ = MID$(Fecha$, 4, 4) center 18, "Imprimiendo Fecha Seleccionada" center 19, "Por favor, espere ..." 'Open random access file file$ = "E-" + mes$ + an$ + "." + Cvit$(so%) OPEN file$ FOR RANDOM AS #1 LEN = 59 FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ GET #1, 1 IF valid$ <> "SI" THEN center 18, "Este mes, esta vacio, verifique esto." center 19, "--> Pulse una tecla <--" SLEEP EXIT SUB END IF MaxRecord = VAL(IoMaxRecord$) Balance#(0) = 0 a = 1 WHILE a <= MaxRecord GET #1, a + 1 p# = VAL(IoPvp$) p1# = VAL(IoUnd$) p2# = VAL(IoCC$) p3# = VAL(IoPc$) Balance#(a) = p# * p1# * p2# - p1# * p2# * p3# BalTotal# = BalTotal# + Balance#(a) a = a + 1 WEND DO printerr = false ON ERROR GOTO ErrorTrap LPRINT kdb$ = INKEY$ WHILE kdb$ = "": kdb$ = INKEY$: WEND IF kdb$ = CHR$(27) THEN EXIT SUB LOOP WHILE printerr = true box 8, 13, 14, 69 LPRINT SPACE$(80); LPRINT "Empresa: " + Trim$(account(so%).Title); GOSUB ObtMes LPRINT TAB(63); "Fecha: " + Fecha$; LPRINT LPRINT "Dia³ 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 'LCenter: ' Center TEXT$ on the line printer SUB LCenter (text$) LPRINT TAB(41 - LEN(text$) / 2); text$ END SUB 'LoadState: ' Load color preferences and account info from Personal.cfg SUB LoadState OPEN "Personal.cfg" FOR INPUT AS #1 INPUT #1, ColorPref FOR a = 1 TO 10 LINE INPUT #1, account(a).Title NEXT a CLOSE END SUB 'Menu: ' Handles Menu Selection for a single menu (either sub menu, or menu bar) ' currChoiceX : Number of current choice ' maxChoice : Number of choices in the list ' choice$() : Array with the text of the choices ' itemRow() : Array with the row of the choices ' itemCol() : Array with the col of the choices ' help$() : Array with the help text for each choice ' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style ' ' Returns the number of the choice that was made by changing currChoiceX ' and returns the scan code of the key that was pressed to exit ' FUNCTION Menu (CurrChoiceX, MaxChoice, choice$(), ItemRow(), ItemCol(), help$(), BarMode) currChoice = CurrChoiceX 'if in bar mode, color in menu bar, else color box/shadow 'bar mode means you are currently in the menu bar, not a sub menu IF BarMode THEN COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 1, 1 PRINT SPACE$(80); ELSE IF boorra <> 0 THEN FancyCls colors(2, ColorPref), colors(1, ColorPref) COLOR colors(7, ColorPref), colors(4, ColorPref) box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1 COLOR colors(10, ColorPref), colors(6, ColorPref) FOR a = 1 TO MaxChoice + 1 LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2 PRINT CHR$(178); CHR$(178); NEXT a LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2 PRINT STRING$(LEN(choice$(MaxChoice)) + 2, 178); END IF 'print the choices COLOR colors(7, ColorPref), colors(4, ColorPref) FOR a = 1 TO MaxChoice LOCATE ItemRow(a), ItemCol(a) PRINT choice$(a); NEXT a finished = false WHILE NOT finished GOSUB MenuShowCursor GOSUB MenuGetKey GOSUB MenuHideCursor SELECT CASE kbd$ CASE CHR$(0) + "H": GOSUB MenuUp CASE CHR$(0) + "P": GOSUB MenuDown CASE CHR$(0) + "K": GOSUB MenuLeft CASE CHR$(0) + "M": GOSUB MenuRight CASE CHR$(13): GOSUB MenuEnter CASE CHR$(27): GOSUB MenuEscape CASE ELSE: BEEP END SELECT WEND Menu = currChoice EXIT FUNCTION MenuEnter: finished = true RETURN MenuEscape: currChoice = 0 finished = true RETURN MenuUp: IF BarMode THEN BEEP ELSE currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 END IF RETURN MenuLeft: IF BarMode THEN currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 ELSE currChoice = -2 finished = true END IF RETURN MenuRight: IF BarMode THEN currChoice = (currChoice) MOD MaxChoice + 1 ELSE currChoice = -3 finished = true END IF RETURN MenuDown: IF BarMode THEN finished = true ELSE currChoice = (currChoice) MOD MaxChoice + 1 END IF RETURN MenuShowCursor: COLOR colors(8, ColorPref), colors(9, ColorPref) LOCATE ItemRow(currChoice), ItemCol(currChoice) PRINT choice$(currChoice); PrintHelpLine help$(currChoice) RETURN MenuGetKey: kbd$ = "" WHILE kbd$ = "" kbd$ = INKEY$ WEND RETURN MenuHideCursor: COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE ItemRow(currChoice), ItemCol(currChoice) PRINT choice$(currChoice); RETURN END FUNCTION 'MenuSystem: ' Main routine that controls the program. Uses the MENU function ' to implement menu system and calls the appropriate function to handle ' the user's selection SUB MenuSystem boorra = 1 DIM choice$(20), menuRow(20), menuCol(20), help$(20) LOCATE , , 0 choice = 1 finished = false WHILE NOT finished GOSUB MenuSystemMain Subchoice = -1 WHILE Subchoice < 0 SELECT CASE choice CASE 1: GOSUB MenuSystemFile CASE 2: GOSUB MenuSystemEdit CASE 3: GOSUB MenuSystemAccount CASE 4: GOSUB MenuSystemReport CASE 5: GOSUB MenuSystemColors CASE 6: GOSUB help END SELECT FancyCls colors(2, ColorPref), colors(1, ColorPref) SELECT CASE Subchoice CASE -2: choice = (choice + 3) MOD 5 + 1 CASE -3: choice = (choice) MOD 6 + 1 END SELECT WEND WEND EXIT SUB MenuSystemMain: FancyCls colors(2, ColorPref), colors(1, ColorPref) COLOR colors(7, ColorPref), colors(4, ColorPref) box 9, 19, 14, 61 center 11, "Use las teclas de direcci¢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 Administrador" help$(2) = "Agregar/edit/supr Proveedores" help$(3) = "Agregar/edit/supr Transacciones" help$(4) = "Ver e imprimir clientes" help$(5) = "Fijar color en pantalla" help$(6) = " Ayuda " DO NewChoice = Menu((choice), 6, choice$(), menuRow(), menuCol(), help$(), true) LOOP WHILE NewChoice = 0 choice = NewChoice RETURN MenuSystemFile: FancyCls colors(2, ColorPref), colors(1, ColorPref) choice$(1) = " Ficheros " choice$(2) = " Status " choice$(3) = " Salir " menuRow(1) = 3: menuCol(1) = 2 menuRow(2) = 4: menuCol(2) = 2 menuRow(3) = 5: menuCol(3) = 2 help$(1) = "Operaciones de Configuraci¢n" help$(2) = "Status actual" help$(3) = "Salir del Administrador" Subchoice = Menu(1, 3, choice$(), menuRow(), menuCol(), help$(), false) SELECT CASE Subchoice CASE 1 choice$(1) = " Eliminar Fich. " choice$(2) = " Vendedores " choice$(3) = " Caja (S/N) " menuRow(1) = 5: menuCol(1) = 6 menuRow(2) = 6: menuCol(2) = 6 menuRow(3) = 7: menuCol(3) = 6 help$(1) = "Eliminaci¢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 Proveedores (Subchoice) END SELECT RETURN MenuSystemAccount: don = 0 FancyCls colors(2, ColorPref), colors(1, ColorPref) choice$(1) = " Compras " choice$(2) = " Referencias " choice$(3) = " Imprimir (1) " choice$(4) = " Imprimir (2) " menuRow(1) = 3: menuCol(1) = 26 menuRow(2) = 4: menuCol(2) = 26 menuRow(3) = 5: menuCol(3) = 26 menuRow(4) = 6: menuCol(4) = 26 help$(1) = "Agregar/Eliminar/Editar Compras" help$(2) = "Agregar/Eliminar/Editar Referencias" help$(3) = "Imprimir Compras del mes" help$(4) = "Imprimir Referencias" Subchoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), false) SELECT CASE Subchoice CASE 1: vaw = 1: GOTO empresa CASE 2: vaw = 2: GOTO empresa CASE 3: vaw = 3: GOTO empresa CASE 4: vaw = 4: GOTO empresa END SELECT RETURN empresa: boorra = 1 FOR a = 1 TO 10 IF Trim$(account(a).Title) = "" THEN choice$(a) = RIGHT$(STR$(a), 2) + ". ------------------- " ELSE choice$(a) = RIGHT$(STR$(a), 2) + ". " + account(a).Title END IF menuRow(a) = a + 4 menuCol(a) = 32 help$(a) = RTRIM$(account(a).Title) NEXT a Subchoice = Menu(1, 10, choice$(), menuRow(), menuCol(), help$(), false) boorra = 0 IF Subchoice > 0 THEN IF choice$(Subchoice) = RIGHT$(STR$(Subchoice), 2) + ". ------------------- " THEN box 17, 5, 21, 75 center 19, "Esa empresa no EXISTE, ¨Desea crearla?" DO: K$ = INKEY$ LOOP WHILE K$ = "" IF K$ = "s" OR K$ = "S" THEN box 17, 5, 21, 75 center 18, "Introduzca el nombre de la Empresa" emp$ = GetString$(19, 7, "", end$, 20, 20) 'end$ contiene la informacion account(Subchoice).Title = end$ SaveState ELSE box 17, 5, 21, 75 center 19, "Escoja una empresa" GOTO empresa END IF END IF IF vaw = 2 THEN Referencias (Subchoice) IF vaw = 1 THEN EditTrans (Subchoice) IF vaw = 3 THEN ImpComp (Subchoice) IF vaw = 4 THEN ImpRef (Subchoice) END IF IF don = 2 THEN RETURN GOTO MenuSystemMain MenuSystemReport: FancyCls colors(2, ColorPref), colors(1, ColorPref) choice$(1) = " Ticket " choice$(2) = " Balance " choice$(3) = " Stock actual " menuRow(1) = 3: menuCol(1) = 39 menuRow(2) = 4: menuCol(2) = 39 menuRow(3) = 5: menuCol(3) = 39 help$(1) = "Ticket, comenzar a fichar" help$(2) = "Total Vendido, dia, mes" help$(3) = "Ver o imprimir Stock actual" Subchoice = Menu(1, 3, choice$(), menuRow(), menuCol(), help$(), false) don = 2 SELECT CASE Subchoice CASE 1 GOSUB empresa Ticket (Subchoice%) CASE 2 GOSUB empresa Balan (Subchoice%) CASE 3 GOSUB empresa Stock (Subchoice%) CASE ELSE END SELECT RETURN MenuSystemColors: FancyCls colors(2, ColorPref), colors(1, ColorPref) choice$(1) = " Monocrom 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, "P E R S O N A L F I N A N C I A L" 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 SUB Proveedores (lug%) DIM Row(12), Col(12), vis(12), max(12), help$(12), CurrString$(12), she$(4) Row(1) = 4: Col(1) = 11: vis(1) = 40: max(1) = 40 Row(2) = 6: Col(2) = 14: vis(2) = 32: max(2) = 32 Row(3) = 6: Col(3) = 62: vis(3) = 10: max(3) = 10 Row(4) = 8: Col(4) = 14: vis(4) = 32: max(4) = 32 Row(5) = 8: Col(5) = 59: vis(5) = 19: max(5) = 19 Row(6) = 10: Col(6) = 14: vis(6) = 16: max(6) = 16 Row(7) = 10: Col(7) = 58: vis(7) = 19: max(7) = 19 Row(8) = 15: Col(8) = 21: vis(8) = 50: max(8) = 50 Row(9) = 17: Col(9) = 13: vis(9) = 58: max(9) = 58 Row(10) = 19: Col(10) = 21: vis(10) = 50: max(10) = 50 Row(11) = 21: Col(11) = 14: vis(11) = 32: max(11) = 32 Row(12) = 21: Col(12) = 59: vis(12) = 16: max(12) = 16 help$(1) = "Nombre de la entidad Proveedora " help$(2) = "Direcci¢n " help$(3) = "Codigo Postal " help$(4) = "Localidad " help$(5) = "Provincia " help$(6) = "Tel‚fono " help$(7) = "C.I.F. " help$(8) = "Entidad Bancaria " help$(9) = "Material que Provee " help$(10) = "Jefe de Ventas " help$(11) = "Direcci¢n del Jefe V. " help$(12) = "Tel‚fono del Jefe de V. " ON lug GOTO ip, mp, sp, bp, impr ip: COLOR colors(7, ColorPref), colors(4, ColorPref): PRINT "SD" entrada = 0: jk = 0 nom$ = "": ape$ = "": Cal$ = "": num$ = "": Pis$ = "": lettt$ = "": tel$ = "" GOSUB menu2 OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56 FOR x = 1 TO LOF(1) / 56 jk = jk + 1 FIELD #1, 40 AS nom$, 16 AS tel$ GET #1, x IF RTRIM$(LTRIM$(nom$)) = "" THEN entrada = jk: GOTO ent NEXT x entrada = jk + 1 ent: CLOSE #1 IF entrada = 0 THEN entrada = 1 LOCATE 2, 47: PRINT entrada pieza = 0 empi: IF pieza = 3 THEN PrintHelpLine help$(1) + " | " IF pieza = 0 THEN PrintHelpLine help$(1) + "| " a = 1 DO GOSUB showline DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" ed = 1: GOSUB showline: ed = 0 IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item kbd$ = GetString$(Row(a), Col(a), kbd$, new$, vis(a), max(a)) CurrString$(a) = new$ END IF SELECT CASE kbd$ 'Handle Special keys CASE CHR$(0) + "H" 'up arrow IF pieza = 3 AND a = 1 THEN a = 4 ELSE IF pieza = 3 THEN a = a - 1 IF pieza = 0 AND a = 1 THEN a = 12 ELSE IF pieza = 0 THEN a = a - 1 IF pieza = 3 THEN PrintHelpLine help$(a) + " | " IF pieza = 0 THEN PrintHelpLine help$(a) + "| " CASE CHR$(0) + "P" 'Down arrow IF pieza = 3 AND a = 4 THEN a = 1 ELSE IF pieza = 3 THEN a = a + 1 IF pieza = 0 AND a = 12 THEN a = 1 ELSE IF pieza = 0 THEN a = a + 1 IF pieza = 3 THEN PrintHelpLine help$(a) + " | " IF pieza = 0 THEN PrintHelpLine help$(a) + "| " CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab IF pieza = 3 AND a = 1 THEN a = 4 ELSE IF pieza = 3 THEN a = a - 1 IF pieza = 0 AND a = 1 THEN a = 12 ELSE IF pieza = 0 THEN a = a - 1 IF pieza = 3 THEN PrintHelpLine help$(a) + " | " IF pieza = 0 THEN PrintHelpLine help$(a) + "| " CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab IF pieza = 3 AND a = 4 THEN a = 1 ELSE IF pieza = 3 THEN a = a + 1 IF pieza = 0 AND a = 12 THEN a = 1 ELSE IF pieza = 0 THEN a = a + 1 IF pieza = 3 THEN PrintHelpLine help$(a) + " | " IF pieza = 0 THEN PrintHelpLine help$(a) + "| " CASE CHR$(0) + "<" 'F2 finished = true CASE CHR$(0) + "D" 'F10 CLOSE : EXIT SUB CASE CHR$(13) 'Enter CASE ELSE BEEP END SELECT LOOP UNTIL finished IF pieza = 3 THEN RETURN cont: OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56 OPEN "proo2.dat" FOR RANDOM AS #2 LEN = 112 OPEN "proo3.dat" FOR RANDOM AS #3 LEN = 206 FIELD #1, 40 AS nom2$, 16 AS Tel2$ FIELD #2, 32 AS cal2$, 10 AS num2$, 32 AS Pis2$, 19 AS LET2$, 19 AS loc2$ FIELD #3, 50 AS Cpu2$, 58 AS Ram2$, 50 AS TG2$, 32 AS Hd2$, 16 AS tel3$ LSET nom2$ = CurrString$(1): LSET Tel2$ = CurrString$(6) LSET cal2$ = CurrString$(2): LSET num2$ = CurrString$(3): LSET Pis2$ = CurrString$(4): LSET LET2$ = CurrString$(5): LSET loc2$ = CurrString$(7) LSET Cpu2$ = CurrString$(8): LSET Ram2$ = CurrString$(9): LSET TG2$ = CurrString$(10): LSET Hd2$ = CurrString$(11): LSET tel3$ = CurrString$(12) IF valor = 3 THEN PUT #1, lf ELSE PUT #1, entrada IF valor = 3 THEN PUT #2, lf ELSE PUT #2, entrada IF valor = 3 THEN PUT #3, lf ELSE PUT #3, entrada CLOSE #1, #2, #3 IF valor = 3 THEN RETURN IF pieza = 3 THEN RETURN LOCATE 13, 2: PRINT "¨Seguir introduciendo?" we: i$ = INKEY$ IF i$ = "" THEN GOTO we IF i$ = "S" OR i$ = "s" THEN GOTO ip ELSE CLOSE : EXIT SUB ep: GOSUB menu2 center 23, "Utilice + y - para ver las Fichas" K = 0 mirp: lf = 0 CLOSE #1, #2, #3 OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56 OPEN "proo2.dat" FOR RANDOM AS #2 LEN = 112 OPEN "proo3.dat" FOR RANDOM AS #3 LEN = 206 lf = 0 vez = 1 DO pro: IF lf = 0 THEN lf = 1 FIELD #1, 40 AS nom$, 16 AS tel$ FIELD #2, 32 AS Cal$, 10 AS num$, 32 AS Pis$, 19 AS lettt$, 19 AS locc$ FIELD #3, 50 AS cpu$, 58 AS ram$, 50 AS tg$, 32 AS hd$, 16 AS tel4$ GET #1, lf GET #2, lf GET #3, lf g = 0 IF K = 1 AND UCASE$(RTRIM$(LTRIM$(she$(1)))) <> UCASE$(MID$(nom$, 1, LEN(RTRIM$(LTRIM$(she$(1)))))) THEN GOSUB pw IF K = 2 AND UCASE$(RTRIM$(LTRIM$(she$(2)))) <> UCASE$(MID$(Cal$, 1, LEN(RTRIM$(LTRIM$(she$(2)))))) THEN GOSUB pw IF K = 3 AND UCASE$(RTRIM$(LTRIM$(she$(3)))) <> UCASE$(MID$(num$, 1, LEN(RTRIM$(LTRIM$(she$(3)))))) THEN GOSUB pw IF K = 4 AND UCASE$(RTRIM$(LTRIM$(she$(4)))) <> UCASE$(MID$(tg$, 1, LEN(RTRIM$(LTRIM$(she$(4)))))) THEN GOSUB pw IF g = 1 THEN GOTO pro IF RTRIM$(LTRIM$(nom$)) = "" AND r = 0 THEN lf = lf + 1: GOTO pro IF RTRIM$(LTRIM$(nom$)) = "" AND r = 1 THEN lf = lf - 1: GOTO pro vez = 0 COLOR colors(3, ColorPref), colors(9, ColorPref) LOCATE 4, 11: PRINT nom$ LOCATE 6, 14: PRINT Cal$ LOCATE 6, 62: PRINT num$ LOCATE 8, 14: PRINT Pis$ LOCATE 8, 59: PRINT lettt$ LOCATE 10, 14: PRINT tel$ LOCATE 10, 58: PRINT locc$ LOCATE 15, 21: PRINT cpu$ LOCATE 17, 13: PRINT ram$ LOCATE 19, 21: PRINT tg$ LOCATE 21, 14: PRINT hd$ LOCATE 21, 59: PRINT tel4$ COLOR colors(7, ColorPref), colors(4, ColorPref) nom$ = nom$: Cal$ = Cal$: num$ = num$: Pis$ = Pis$: lettt$ = lettt$: locc$ = locc$ tel$ = tel$: cpu$ = cpu$: ram$ = ram$: tg$ = tg$: hd$ = hd$: tel4$ = tel4$ CurrString$(1) = nom$ CurrString$(2) = Cal$ CurrString$(3) = num$ CurrString$(4) = Pis$ CurrString$(5) = lettt$ CurrString$(6) = tel$ CurrString$(7) = locc$ CurrString$(8) = cpu$ CurrString$(9) = ram$ CurrString$(10) = tg$ CurrString$(11) = hd$ CurrString$(12) = tel$ tipo = 0 T: w$ = INKEY$: IF w$ = "" THEN GOTO T IF w$ = "+" THEN lf = lf + 1: r = 0 IF w$ = "-" THEN lf = lf - 1: r = 1 IF w$ = CHR$(27) THEN CLOSE : EXIT SUB IF w$ = CHR$(13) AND valor = 3 THEN CLOSE #1, #2, #3: RETURN IF w$ = CHR$(13) AND valor = 2 THEN CLOSE #1, #2, #3: RETURN IF lf > LOF(1) / 56 THEN lf = lf - 1: GOTO T IF lf = 0 OR lf = -1 THEN lf = 1: GOTO T IF tipo = 1 THEN GOTO pro LOOP CLOSE #1, #2, #3 END pw: IF vez = 1 AND r = 0 THEN lf = lf + 1: g = 1 IF vez = 1 AND r = 1 THEN lf = lf - 1: g = 1 IF g = 0 AND r = 0 THEN lf = lf + 1 IF g = 0 AND r = 1 THEN lf = lf - 1 IF lf > LOF(1) / 56 AND vez = 1 THEN GOTO filenotfound IF lf > LOF(1) / 56 THEN lf = lf - 1: GOTO T IF lf = 0 OR lf = -1 THEN lf = 1: GOTO T tipo = 1 g = 1 RETURN END mp: valor = 0 GOSUB menu2 valor = 3 LOCATE 23, 1: PRINT STRING$(80, "±"); center 23, "Use + o - y <ÄÙ para editar ficha" GOSUB mirp GOSUB empi EXIT SUB r: i$ = INKEY$: IF i$ = "" THEN GOTO r IF i$ = "S" OR i$ = "s" THEN GOTO mp ELSE CLOSE : EXIT SUB bp: valor = 0 GOSUB menu2 valor = 3 LOCATE 23, 1: PRINT STRING$(80, "±"); center 23, "Use + o - y <ÄÙ para borrar ficha" GOSUB mirp FOR wq = 1 TO 12 CurrString$(wq) = "" NEXT wq LOCATE 23, 1: PRINT STRING$(80, "±"); center 23, "Pulse 'S' si desea eliminarla" r3: i$ = INKEY$: IF i$ = "" THEN GOTO r3 IF i$ = "S" OR i$ = "s" THEN GOTO po ELSE CLOSE : EXIT SUB po: GOSUB cont LOCATE 23, 1: PRINT STRING$(80, "±"); center 23, "¨Desea eliminar otra ficha?" r2: i$ = INKEY$: IF i$ = "" THEN GOTO r2 IF i$ = "S" OR i$ = "s" THEN GOTO bp ELSE CLOSE : EXIT SUB finentrada: END impr: REM FICHERO PARA IMPRIMIR COLOR colors(7, ColorPref), colors(4, ColorPref) box 13, 33, 19, 72 LOCATE 14, 34: PRINT "Esta usd. en la secci¢n de impresion." LOCATE 15, 34: PRINT "Cerciorese de que la impresora este" LOCATE 16, 34: PRINT "encendida y de que tenga papel." LOCATE 18, 34: PRINT " Pulse una tecla..." n: q$ = INKEY$: IF q$ = "" THEN GOTO n IF q$ = CHR$(27) THEN EXIT SUB box 13, 33, 19, 72 LOCATE 15, 34: PRINT "Elija modo de impresion:" LOCATE 17, 39: PRINT "(a) Lista simple" LOCATE 18, 39: PRINT "(b) Lista completa" COLOR colors(8, ColorPref), colors(9, ColorPref) hn: q$ = INKEY$: IF q$ = "" THEN GOTO hn IF q$ = CHR$(27) THEN EXIT SUB IF q$ = "A" OR q$ = "a" THEN GOTO ls IF q$ = "B" OR q$ = "b" THEN GOTO lc GOTO hn ls: kop = 0 printerr = false ON ERROR GOTO ErrorTrap LPRINT kdb$ = INKEY$ WHILE kdb$ = "": kdb$ = INKEY$: WEND IF kdb$ = CHR$(27) THEN EXIT SUB IF printerr = true THEN GOTO ls OPEN "proo1.dat" FOR RANDOM AS #1 LEN = 56 FOR x = 1 TO LOF(1) / 56 FIELD #1, 40 AS nom$, 16 AS tel$ GET #1, x IF RTRIM$(LTRIM$(nom$)) = "" THEN GOTO continua IF kop = 0 THEN LPRINT " Nombre de la entidad proveedora Tel‚fono ": LPRINT kop = 1 END IF LPRINT nom$ + " " + tel$ b = b + 1: IF b = 50 THEN GOSUB finlista continua: NEXT x CLOSE #1 CLOSE : EXIT SUB finlista: box 13, 33, 19, 72 LOCATE 15, 34: PRINT "Cuando deje de imprimir ponga papel" LOCATE 16, 34: PRINT " Pulse entonces una tecla para " LOCATE 17, 34: PRINT " continuar listando. " M: IF INKEY$ = "" THEN GOTO M box 13, 33, 19, 72 LOCATE 16, 34: PRINT " IMPRIMIENDO " b = 0: RETURN lc: valor = 2 GOSUB menu2 center 23, "Seleccione ficha a imprimir..." GOSUB mirp lf: printerr = false ON ERROR GOTO ErrorTrap LPRINT kdb$ = INKEY$ WHILE kdb$ = "": kdb$ = INKEY$: WEND IF kdb$ = CHR$(27) THEN EXIT SUB IF printerr = true THEN GOTO lf LPRINT " Tratamiento de Proveedores ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; LPRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ N§ de Ficha: ³±"; LPRINT "³ ³±"; LPRINT "³ Nombre: " + nom$ + " ³±"; LPRINT "³ ³±"; LPRINT "³ Direcci¢n: " + Cal$ + " Cod. Postal: " + num$ + " ³±"; LPRINT "³ ³±"; LPRINT "³ Localidad: " + Pis$ + " Provincia: " + lettt$ + " ³±"; LPRINT "³ ³±"; LPRINT "³ Tel‚fono: " + tel$ + " C.I.F.: " + locc$ + " ³±"; LPRINT "³ ³±"; LPRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´±"; LPRINT "³±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; LPRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³±"; LPRINT "³ Entidad Bancaria: " + cpu$ + " ³±"; LPRINT "³ ³±"; LPRINT "³ Material: " + ram$ + " ³±"; LPRINT "³ ³±"; LPRINT "³ Jefe de Ventas: " + tg$ + " ³±"; LPRINT "³ ³±"; LPRINT "³ Direcci¢n: " + hd$ + " Tel‚fono: " + tel$ + " ³±"; LPRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±"; LPRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; LPRINT "Base de Datos y Programa TPV, por Jos‚ David Guill‚n, para Guill‚n Dominguez s.l."; FancyCls colors(2, ColorPref), colors(1, ColorPref) box 10, 15, 14, 65 center 12, "Cuando deje de imprimir, pulse una tecla" SLEEP CLOSE : EXIT SUB sp: valor = 0: pieza = 3 GOSUB menu2 LOCATE 13, 2: PRINT "Introduzca parte a buscar..." lili: Row(1) = 4: Col(1) = 11: vis(1) = 40: max(1) = 40 Row(2) = 8: Col(2) = 14: vis(2) = 32: max(2) = 32 Row(3) = 8: Col(3) = 59: vis(3) = 19: max(3) = 19 Row(4) = 17: Col(4) = 13: vis(4) = 58: max(4) = 58 help$(1) = "Nombre de la entidad Proveedora " help$(2) = "Localidad " help$(3) = "Provincia " help$(4) = "Material que Provee " GOSUB empi FOR qwq = 1 TO 4 IF LTRIM$(RTRIM$(CurrString$(qwq))) <> "" THEN she$(qwq) = CurrString$(qwq): K = qwq NEXT qwq IF pieza = 0 THEN pieza = 3: GOTO lili PrintHelpLine "Pulse (Esc) para salir y + -" GOTO mirp EXIT SUB filenotfound: LOCATE 13, 2: PRINT "Ficha no encontrada" SLEEP COLOR colors(7, ColorPref), colors(4, ColorPref) GOTO sp END menu2: LOCATE 1, 1 PRINT " Tratamiento de Proveedores ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"; PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ N§ de Ficha: ³±"; PRINT "³ ³±"; PRINT "³ Nombre: ³±"; PRINT "³ ³±"; PRINT "³ Direcci¢n: Cod. Postal: ³±"; PRINT "³ ³±"; PRINT "³ Localidad: Provincia: ³±"; PRINT "³ ³±"; PRINT "³ Tel‚fono: C.I.F.: ³±"; PRINT "³ ³±"; PRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´±"; PRINT "³±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; PRINT "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³±"; PRINT "³ Entidad Bancaria: ³±"; PRINT "³ ³±"; PRINT "³ Material: ³±"; PRINT "³ ³±"; PRINT "³ Jefe de Ventas: ³±"; PRINT "³ ³±"; PRINT "³ Direcci¢n: Tel‚fono: ³±"; PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±"; PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"; RETURN showline: IF ed = 1 THEN COLOR colors(7, ColorPref), colors(4, ColorPref) ELSE COLOR colors(8, ColorPref), colors(9, ColorPref) END IF LOCATE Row(a), Col(a) IF RTRIM$(LTRIM$(CurrString$(a))) <> "" THEN PRINT CurrString$(a) ELSE PRINT SPACE$(vis(a)) END IF RETURN lg: CLOSE : EXIT SUB END SUB SUB Referencias (op%) 'Stores info about each column REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6), lin$(130), ref1000#(1000) 'Array to keep the current balance at all the transactions 'Open random access file file$ = "Ref#." + Cvit$(op%) OPEN file$ FOR RANDOM AS #1 LEN = 54 FIELD #1, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ 'Initialize variables CurrString$(1) = "" CurrFig#(2) = 0 CurrFig#(3) = 0 CurrFig#(4) = 0 CurrFig#(5) = 0 GET #1, 1 IF valid$ <> "SI" THEN LSET IoRef$ = STR$(0) LSET IoDesc$ = "" LSET IoCC$ = STR$(0) LSET IoPvp$ = STR$(0) LSET IoPc$ = STR$(0) PUT #1, 2 LSET valid$ = "SI" LSET IoMaxRecord$ = "1" PUT #1, 1 END IF MaxRecord = VAL(IoMaxRecord$) ref1000#(0) = 0 a = 1 WHILE a <= MaxRecord GET #1, a + 1 ref1000#(a) = VAL(IoRef$) a = a + 1 WEND help$(1) = "Referencia del Producto " help$(2) = "Nombre del Producto " help$(3) = "Unidades parciales, ( o por caja ) " help$(4) = "P.V.P. del Producto, ( por unidad )" help$(5) = "Precio de Costo, ( la unidad ) " Col(1) = 4: vis(1) = 10: max(1) = 6 Col(2) = 16: vis(2) = 22: max(2) = 22 Col(3) = 40: vis(3) = 9: max(3) = 3 Col(4) = 50: vis(4) = 12: max(4) = 8 Col(5) = 63: vis(5) = 13: max(5) = 8 'Draw Screen COLOR colors(7, ColorPref), colors(4, ColorPref) box 2, 3, 24, 76 COLOR colors(5, ColorPref), colors(4, ColorPref) LOCATE 1, 1: PRINT SPACE$(80); LOCATE 1, 4: PRINT "Referencias de la Empresa: " + Trim$(account(op%).Title); COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 3, 4: PRINT " Ref# ³ Concepto ³ Und/C ³ P.V.P. ³ P.C. " LOCATE 4, 4: PRINT "ÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ" u1$ = " ³ ³ ³ ³ " u1x$ = "ßßßßßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßß³ßßßßßßßßßßßß³ßßßßßßßßßßßßß" u2$ = "##,###,###" u5$ = "###" u6$ = "######" CurrTopline = 1 GOSUB EditTransPrintWholeScreen2 CurrRow = 1 CurrCol = 1 PrintHelpLine help$(CurrCol) + "| " GOSUB EditTransGetLine2 finished = false 'Loop until is pressed DO GOSUB EditTransShowCursor2 'Show Cursor, Wait for key DO: kbd$ = INKEY$: LOOP UNTIL kbd$ <> "" ed = 1: GOSUB EditTransShowCursor2: ed = 0: 'Oculta el cursor para obtener datos ED=1 IF kbd$ >= " " AND kbd$ < "~" OR kbd$ = CHR$(8) THEN 'If legal key, edit item GOSUB EditTransEditItem2 END IF SELECT CASE kbd$ 'Handle Special keys CASE CHR$(0) + "H" 'up arrow GOSUB EditTransMoveUp2 CASE CHR$(0) + "P" 'Down arrow GOSUB EditTransMoveDown2 CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab CurrCol = (CurrCol + 3) MOD 5 + 1 PrintHelpLine help$(CurrCol) + "| " 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 = 5 CASE CHR$(0) + "I" 'Page Up CurrRow = 1 CurrTopline = CurrTopline - 19 IF CurrTopline < 1 THEN CurrTopline = 1 END IF GOSUB EditTransPrintWholeScreen2 GOSUB EditTransGetLine2 CASE CHR$(0) + "Q" 'Page Down CurrRow = 1 CurrTopline = CurrTopline + 19 IF CurrTopline > MaxRecord THEN CurrTopline = MaxRecord END IF GOSUB EditTransPrintWholeScreen2 GOSUB EditTransGetLine2 CASE CHR$(0) + "<" 'F2 finished = true CASE CHR$(0) + "C" 'F9 GOSUB EditTransAddRecord2 CASE CHR$(0) + "D" 'F10 GOSUB EditTransDeleteRecord2 CASE CHR$(13) 'Enter CASE ELSE BEEP END SELECT LOOP UNTIL finished CLOSE EXIT SUB EditTransShowCursor2: IF ed = 1 THEN COLOR colors(7, ColorPref), colors(4, ColorPref) ELSE COLOR colors(8, ColorPref), colors(9, ColorPref) END IF LOCATE CurrRow + 4, Col(CurrCol) SELECT CASE CurrCol CASE 1 IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING u6$; CurrFig#(2); ELSE PRINT " "; CASE 2 IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT CurrString$(1); ELSE PRINT " "; CASE 3 IF CurrFig#(3) <> 0 THEN PRINT " "; : PRINT USING u5$; CurrFig#(3); : PRINT " "; ELSE PRINT " "; CASE 4 IF CurrFig#(4) <> 0 THEN PRINT " "; : PRINT USING u5$; CurrFig#(4); : PRINT " "; ELSE PRINT " "; CASE 5 IF CurrFig#(5) <> 0 THEN PRINT " "; : PRINT USING u2$; CurrFig#(5); ELSE PRINT " "; END SELECT RETURN EditTransEditItem2: CurrRecord = CurrTopline + CurrRow - 1 EditTransEditItem3: COLOR colors(8, ColorPref), colors(9, ColorPref) SELECT CASE CurrCol CASE 1 start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(1), start$, new$, vis(1), max(1)) new1# = VAL(new$) start$ = "" LOOP WHILE new1# >= 100001# OR new1# < 0 CurrFig#(2) = new1# reg = 0: b = 1 DO WHILE ref1000#(b) <> 0 OR b = 999 IF ref1000#(b) = CurrFig#(2) THEN df = 0 FOR Ol = 17 TO 19 FOR Oc = 24 TO 49 df = df + 1 lin$(df) = CHR$(SCREEN(Ol, Oc)) NEXT Oc, Ol box 17, 24, 19, 49 LOCATE 18, 25: PRINT "Esa Referencia ya existe" SLEEP COLOR colors(7, ColorPref), colors(4, ColorPref) df = 0 FOR Ol = 17 TO 19 FOR Oc = 24 TO 49 df = df + 1 LOCATE Ol, Oc: PRINT lin$(df) NEXT Oc, Ol reg = 1 EXIT DO END IF b = b + 1 LOOP IF reg = 1 THEN GOTO EditTransEditItem3 GOSUB EditTransPutLine2 GOSUB EditTransGetLine2 CASE 2 kbd$ = GetString$(CurrRow + 4, Col(CurrCol), kbd$, new$, vis(CurrCol), max(CurrCol)) CurrString$(1) = new$ GOSUB EditTransPutLine2 GOSUB EditTransGetLine2 CASE 3 start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(3), start$, new$, vis(3), max(3)) new3# = VAL(new$) start$ = "" LOOP WHILE new3# > 601# OR new3# < 0 CurrFig#(3) = new3# IF CurrFig#(3) = 0 THEN CurrFig#(3) = 1 GOSUB EditTransPutLine2 GOSUB EditTransGetLine2 CASE 4 start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(4), start$, new$, vis(4), max(4)) new4# = VAL(new$) start$ = "" LOOP WHILE new4# >= 75001# OR new4# < 0 CurrFig#(4) = new4# IF CurrFig#(4) = 0 THEN df = 0 FOR Ol = 17 TO 19 FOR Oc = 18 TO 59 df = df + 1 lin$(df) = CHR$(SCREEN(Ol, Oc)) NEXT Oc, Ol box 17, 18, 19, 59 LOCATE 18, 20: PRINT "El P.V.P. No puede ser 0 ni menor de 0" SLEEP COLOR colors(7, ColorPref), colors(4, ColorPref) df = 0 FOR Ol = 17 TO 19 FOR Oc = 18 TO 59 df = df + 1 LOCATE Ol, Oc: PRINT lin$(df) NEXT Oc, Ol END IF GOSUB EditTransPutLine2 GOSUB EditTransGetLine2 CASE 5 start$ = kbd$ DO kbd$ = GetString$(CurrRow + 4, Col(5), start$, new$, vis(5), max(5)) new5# = VAL(new$) start$ = "" LOOP WHILE new5# >= 75001# OR new5 < 0 CurrFig#(5) = new5# IF CurrFig#(5) = 0 THEN df = 0 FOR Ol = 17 TO 19 FOR Oc = 18 TO 59 df = df + 1 lin$(df) = CHR$(SCREEN(Ol, Oc)) NEXT Oc, Ol box 17, 18, 19, 59 LOCATE 18, 20: PRINT " El P.C. No puede ser 0 ni menor de 0" SLEEP df = 0 COLOR colors(7, ColorPref), colors(4, ColorPref) FOR Ol = 17 TO 19 FOR Oc = 18 TO 59 df = df + 1 LOCATE Ol, Oc: PRINT lin$(df) NEXT Oc, Ol END IF GOSUB EditTransPutLine2 GOSUB EditTransGetLine2 CASE ELSE END SELECT GOSUB EditTransPrintLine2 RETURN EditTransMoveUp2: IF CurrRow = 1 THEN IF CurrTopline = 1 THEN BEEP ELSE ScrollDown CurrTopline = CurrTopline - 1 GOSUB EditTransGetLine2 GOSUB EditTransPrintLine2 END IF ELSE CurrRow = CurrRow - 1 GOSUB EditTransGetLine2 END IF RETURN EditTransMoveDown2: IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN BEEP ELSE IF CurrRow = 19 THEN ScrollUp CurrTopline = CurrTopline + 1 GOSUB EditTransGetLine2 GOSUB EditTransPrintLine2 ELSE CurrRow = CurrRow + 1 GOSUB EditTransGetLine2 END IF END IF p = 0 IF CurrFig#(4) = 0 THEN p = 1 ELSE IF CurrFig#(5) = 0 THEN p = 2 IF p <> 0 THEN df = 0 FOR Ol = 17 TO 19 FOR Oc = 18 TO 59 df = df + 1 lin$(df) = CHR$(SCREEN(Ol, Oc)) NEXT Oc, Ol box 17, 18, 19, 59 LOCATE 18, 20: IF p = 1 THEN PRINT "El P.V.P. No puede ser 0 ni menor de 0" ELSE PRINT " El P.C. No puede ser 0 ni menor de 0" SLEEP COLOR colors(7, ColorPref), colors(4, ColorPref) df = 0 FOR Ol = 17 TO 19 FOR Oc = 18 TO 59 df = df + 1 LOCATE Ol, Oc: PRINT lin$(df) NEXT Oc, Ol END IF RETURN EditTransPrintLine2: COLOR colors(7, ColorPref), colors(4, ColorPref) CurrRecord = CurrTopline + CurrRow - 1 LOCATE CurrRow + 4, 4 IF CurrRecord = MaxRecord + 1 THEN PRINT u1x$; ELSEIF CurrRecord > MaxRecord THEN PRINT u1$; ELSE IF CurrFig#(2) <> 0 THEN PRINT " "; : PRINT USING u6$; CurrFig#(2); ELSE PRINT " "; IF RTRIM$(LTRIM$(CurrString$(1))) <> "" THEN PRINT "³ " + 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 "³ "; END IF RETURN EditTransDeleteRecord2: IF MaxRecord = 1 THEN BEEP ELSE CurrRecord = CurrTopline + CurrRow - 1 MaxRecord = MaxRecord - 1 a = CurrRecord WHILE a <= MaxRecord GET #1, a + 2 PUT #1, a + 1 ref1000#(a) = ref1000#(a + 1) a = a + 1 WEND LSET valid$ = "SI" LSET IoMaxRecord$ = Cvit$(MaxRecord) PUT #1, 1 GOSUB EditTransPrintWholeScreen2 CurrRecord = CurrTopline + CurrRow - 1 IF CurrRecord > MaxRecord THEN GOSUB EditTransMoveUp2 END IF GOSUB EditTransGetLine2 END IF RETURN EditTransAddRecord2: CurrRecord = CurrTopline + CurrRow - 1 a = MaxRecord WHILE a > CurrRecord GET #1, a + 1 PUT #1, a + 2 ref1000#(a + 1) = ref1000#(a) a = a - 1 WEND MaxRecord = MaxRecord + 1 LSET IoRef$ = STR$(0) LSET IoDesc$ = "" LSET IoCC$ = STR$(0) LSET IoPvp$ = STR$(0) LSET IoPc$ = STR$(0) PUT #1, CurrRecord + 2 LSET valid$ = "SI" LSET IoMaxRecord$ = Cvit$(MaxRecord) PUT #1, 1 GOSUB EditTransPrintWholeScreen2 GOSUB EditTransGetLine2 RETURN EditTransPrintWholeScreen2: temp = CurrRow FOR CurrRow = 1 TO 19 CurrRecord = CurrTopline + CurrRow - 1 IF CurrRecord <= MaxRecord THEN GOSUB EditTransGetLine2 END IF GOSUB EditTransPrintLine2 NEXT CurrRow CurrRow = temp RETURN EditTransPutLine2: CurrRecord = CurrTopline + CurrRow - 1 LSET IoRef$ = LTRIM$(RTRIM$(STR$(CurrFig#(2)))) LSET IoDesc$ = CurrString$(1) LSET IoCC$ = LTRIM$(RTRIM$(STR$(CurrFig#(3)))) LSET IoPvp$ = LTRIM$(RTRIM$(STR$(CurrFig#(4)))) LSET IoPc$ = LTRIM$(RTRIM$(STR$(CurrFig#(5)))) PUT #1, CurrRecord + 1 RETURN EditTransGetLine2: CurrRecord = CurrTopline + CurrRow - 1 GET #1, CurrRecord + 1 CurrFig#(2) = VAL(IoRef$) CurrString$(1) = IoDesc$ CurrFig#(3) = VAL(IoCC$) CurrFig#(4) = VAL(IoPvp$) CurrFig#(5) = VAL(IoPc$) RETURN END SUB 'SaveState: ' Save color preference and account information to "Personal.cfg" data file. SUB SaveState OPEN "Personal.cfg" FOR OUTPUT AS #2 PRINT #2, ColorPref FOR a = 1 TO 19 PRINT #2, account(a).Title NEXT a CLOSE #2 END SUB 'ScrollDown: ' Call the assembly program to scroll the screen down SUB ScrollDown DEF SEG = VARSEG(ScrollDownAsm(1)) CALL Absolute(VARPTR(ScrollDownAsm(1))) DEF SEG END SUB 'ScrollUp: ' Calls the assembly program to scroll the screen up SUB ScrollUp DEF SEG = VARSEG(ScrollUpAsm(1)) CALL Absolute(VARPTR(ScrollUpAsm(1))) DEF SEG END SUB SUB Staul END SUB SUB Stock (EEE%) END SUB SUB Ticket (e%) 'Stores info about each column REDIM help$(6), Col(6), vis(6), max(6), CurrString$(1), CurrFig#(6) 'Array to keep the current balance at all the transactions REDIM Balance#(1000), Ca#(1000), Cb$(1000), Cc#(1000), Cd#(1000), Ce#(1000), lin$(155) gf = 0 box 17, 5, 21, 75 center 18, "Por Favor Introduzca Fecha" center 19, "con la que guardar ticket del d¡a." PrintHelpLine "Fecha: mm - dd - aaaa" DO emp$ = GetString$(20, 7, DATE$, end$, 10, 10) Fecha$ = end$ M = VAL(MID$(Fecha$, 1, 2)) D = VAL(MID$(Fecha$, 4, 2)) IF M <= 12 AND D <= 31 THEN gf = 1 IF LEN(Fecha$) < 10 THEN gf = 0 LOOP WHILE gf = 0 gf = 0 mes$ = MID$(Fecha$, 1, 2) dia$ = MID$(Fecha$, 4, 2) an$ = MID$(Fecha$, 7, 4) CurrDia$ = dia$ compufech$ = mes$ + dia$ + an$ help$(1) = "Vendedor 1 a 9 " help$(2) = "Referencia " help$(3) = "Producto " help$(4) = "Unidades " help$(5) = "P.V.P. (Unidad) " Col(1) = 2: vis(1) = 3: max(1) = 1 Col(2) = 9: vis(2) = 6: max(2) = 6 Col(3) = 19: vis(3) = 22: max(3) = 22 Col(4) = 43: vis(4) = 5: max(4) = 3 Col(5) = 51: vis(5) = 10: max(5) = 8 'Open random access file file$ = "T-" + dia$ + mes$ + "." + Cvit$(e) OPEN file$ FOR RANDOM AS #1 LEN = 59 FIELD #1, 2 AS IoDia$, 6 AS IoRef$, 22 AS IoDesc$, 3 AS IoUnd$, 3 AS IoCC$, 8 AS IoPvp$, 8 AS IoPc$ FIELD #1, 2 AS valid$, 5 AS IoMaxRecord$ 'Initialize variables CurrString$(1) = "" CurrFig#(2) = 0 CurrFig#(3) = 0 CurrFig#(4) = 0 CurrFig#(5) = 0 CurrFig#(6) = 0 GET #1, 1 IF valid$ <> "SI" THEN LSET IoDia$ = "" LSET IoRef$ = STR$(0) LSET IoDesc$ = "" LSET IoUnd$ = STR$(0) LSET IoCC$ = STR$(0) LSET IoPvp$ = STR$(0) LSET IoPc$ = STR$(0) PUT #1, 2 LSET valid$ = "SI" LSET IoMaxRecord$ = "1" PUT #1, 1 END IF MaxRecord = VAL(IoMaxRecord$) Balance#(0) = 0 a = 1 WHILE a <= MaxRecord GET #1, a + 1 p# = VAL(IoPvp$) p1# = VAL(IoUnd$) p2# = VAL(IoCC$) p3# = VAL(IoPc$) Balance#(a) = p# * p1# * p2# - p1# * p2# * p3# BalTotal# = BalTotal# + Balance#(a) a = a + 1 WEND GOSUB CargaReferencias 'Draw Screen COLOR colors(7, ColorPref), colors(4, ColorPref) box 2, 1, 21, 80 box 22, 1, 24, 80 COLOR colors(5, ColorPref), colors(4, ColorPref) LOCATE 1, 1: PRINT SPACE$(80); LOCATE 1, 4: PRINT "Empresa: " + Trim$(account(e%).Title); 'LOCATE 1, 63: PRINT "Fecha: "; 'LOCATE 1, 63: PRINT "Fecha: " + Fecha$; COLOR colors(7, ColorPref), colors(4, ColorPref) LOCATE 3, 2: PRINT " No. ³ 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