Статьи

  Резюме
  [+] IT
    [+] Asterisk
    [+] Ubuntu Desktop
    [+] Ubuntu Server
    [+] Windows Server
  [-] Программирование
    [+] 1C
    ASP.NET & VB.NET
    bash & sh
    [+] HTML + CSS
    [+] Java
    PHP
    [-] QB - Quick Basic 4-4.5
      [+] Nbase 2 (1994)
      [-] Nbase 33
        Листинг
    [+] T-SQL
    [+] VB - Visual Basic 1-6
    VBScript & JScript
  [+] Творчество
    Кофейная тема
    Наброски
    Размышления
Листинг
DECLARE SUB File.man ()
DECLARE SUB DATA.LOADER ()
DECLARE SUB SCREEN.saver ()
DECLARE SUB linery (x!, y!, a$, DL!, madonna!)
DECLARE FUNCTION Nput4$ (x!, y!, fg!, BG!, max!, st$)
DECLARE SUB Director ()
DECLARE SUB NBshell ()
DECLARE FUNCTION Inpt.WINDOW$ (title$, is2$, max!, fg!, BG!, curFG!, curBG!, turner!, n!)
DECLARE SUB Bases ()
DECLARE SUB picture (x!, y!, s!)
DECLARE FUNCTION Orange.main.menu! (m$(), n!, n!(), title$)
DECLARE FUNCTION Operat$ (B$, Dname$, Dpeace$, n!)
DECLARE SUB Options3 ()
DECLARE FUNCTION trans! (C!)
DECLARE SUB layout.changer (n!)
DECLARE FUNCTION balance$ (s$)
DECLARE SUB Options2 ()
DECLARE FUNCTION Nput$ (x!, y!, fg!, BG!, max!, IS$)
DECLARE SUB ON.OFF (x1!, y1!, onoff!)
DECLARE SUB file (n!)
DECLARE SUB button (x!, y!, st$, inactive!)
DECLARE SUB pauses ()
DECLARE FUNCTION Nput3$ (x!, y!, fg!, BG!, max!, st$)
DECLARE SUB sorting2 ()
DECLARE FUNCTION INPUT.WINDOW! (title$, is2$, max!, fg!, BG!, curFG!, curBG!)
DECLARE SUB Scroll ()
DECLARE FUNCTION Nput2$ (x!, y!, fg!, BG!, max!, st$)
DECLARE SUB Onalazing (B$)
DECLARE SUB Options ()
DECLARE FUNCTION Operation$ (B$)
DECLARE SUB sorting ()
DECLARE SUB mouses ()
DECLARE SUB init ()
DECLARE FUNCTION j$ (B$)
DECLARE SUB Save.New (f$, C$, p$)
DECLARE SUB pro (x!, y!, sp$, BG!)
DECLARE FUNCTION Autodir.Orange.menu! (x1!, y1!, m$(), n!, nn!, fg!, BG!, barFG!, barBG!, LFG!, LbarFG!)
DECLARE FUNCTION ClearSlash$ (IS$)
DECLARE FUNCTION Ren.menu! (m$(), n!, fg!, BG!, barFG!, barBG!, LFG!, LbarFG!)
DECLARE FUNCTION Orange.menu! (x1!, y1!, m$(), n!, fg!, BG!, barFG!, barBG!, LFG!, LbarFG!, i!)
DECLARE FUNCTION Neo.menu! (x1!, y1!, m$(), n!, fg!, BG!, barFG!, barBG!, LFG!, LbarFG!)
DECLARE SUB Lsc ()
DECLARE SUB win (x1!, y1!, x2!, y2!, fg!, BG!)
DECLARE SUB printer (x1!, y1!, s$, fg!, BG!)
DECLARE SUB winssc (x1!, y1!, x2!, y2!)
DECLARE SUB winlsc (x1!, y1!)
DECLARE SUB Lwin (x1!, y1!, x2!, y2!)
DECLARE SUB Seven.up ()
DECLARE SUB DEF.usr2 (n!)
DECLARE FUNCTION Autodir$ ()
DECLARE FUNCTION Pref$ (B$)
DECLARE SUB initilize ()
DECLARE SUB wc (x1!, y1!, st$)
DECLARE SUB printn (x1!, y1!, st$)
DECLARE SUB Pause ()
DECLARE FUNCTION Trans.Price$ (Dol$)
DECLARE FUNCTION qn$ (B$)
DECLARE FUNCTION Pricce$ (B$)


DIM writa!(3600)
nbasex = 5: nbasey = 5: nbasex2 = 5: nbasey2 = 5
DIM winss(10000), Fil$(300), Dir$(300)
DIM mouse1(40), mouse2(40), mouse3(40), mouse4(40), mouse5(40), mouse6(40), mouse7(40), buton(230)

DIM ch$(20, 8), nbwinss(11000), Amount(8), y(8), NAME$(8), pathes$(4)


PEN ON: DEF SEG = &H40
fg = 1: layout = 1
fgg = 1
savetext = 1
'ON ERROR GOTO 20
all = 1
SCREEN 12
LINE (0, 0)-(640, 480), 9, BF
CALL initilize
ON ERROR GOTO 20
DEF fnm$ (w$) = pathes$(2) + Erre$ + RIGHT$(STR$(ASC(MID$(w$, 3, 1))), LEN(STR$(ASC(w$))) - 1) + ".txt"
DIM a$(9)
CALL init
PathSpec$ = pathes$(1) + ""
KEY 2, "Options" + CHR$(13)
KEY 3, "Load" + CHR$(13)
KEY 4, "Save" + CHR$(13)
KEY 6, "Next" + CHR$(13)
KEY 10, "Quit" + CHR$(13)


Erre$ = "/BASE_94/"
GET (4 * 8 - 3, 4 * 16)-(75 * 8 + 5, 13 * 16 + 3), nbwinss
CALL win(5, 5, 75, 13, 15, 8)
LINE ((5 - 1) * 8, 6 * 16)-(75 * 8, 6 * 16), 15
LINE (35, 71)-(597, 93), 15, BF
LINE ((5 - 1) * 8, 10 * 16 + 2)-(75 * 8, 10 * 16 + 2), 15
LINE ((5 - 1) * 8 + 2, 10 * 16 + 5)-(75 * 8 - 2, 13 * 16 - 3), 15, BF
CALL printn(5, 78, "ART NAME OF GOODS PCS Q-TY PRICE AMOUNT")
CALL printn(5, 176, "CURRENT ROW WINDOW #1 TOTAL AMOUNT")
CALL printer(nbasex + 58, nbasey + 7, "*", 0, 15)
CALL printer(nbasex + 16, nbasey + 7, "*", 0, 15)

PUT (6 * 8, 4 * 16), mouse2, PSET

PUT (70 * 8, 4 * 16), mouse4, PSET
PUT (71 * 8 + 4, 4 * 16), mouse6, PSET
PUT (74 * 8 + 4, 6 * 16), mouse4, PSET
PUT (74 * 8 + 4, 9 * 16), mouse6, PSET
LINE (74 * 8 + 6, 6 * 16 + 10)-(76 * 8 - 5, 9 * 16 - 1), 7, BF
LINE (74 * 8 + 5, 6 * 16 + 10)-(76 * 8 - 4, 9 * 16 - 1), 8, B
CALL button(3, 28, "Help - F1", 0)
CALL button(16, 28, "Options - F2", 1)
CALL button(31, 28, "Load - F3", 1)
CALL button(43, 28, "Save - F4", 1)
CALL button(55, 28, "Next - F6", 1)
CALL button(68, 28, "Quit - F10", 1)
IF all = 1 THEN CALL DATA.LOADER

IF all = 0 THEN Active = 1: y(Active) = 1: FOR t = 1 TO 8: y(t) = 1: NAME$(t) = " Noname.nb" + LTRIM$(STR$(t)) + " ": NEXT
IF all = 0 THEN Erre$ = "/BASE_94/"
i = 56
IF all = 1 THEN GOSUB Spaces: all = 0
10 B$ = ""
11 B$ = Nput$(6, 10, 15, 8, 17, B$)
IF B$ = "ESC" THEN GOTO 10
CALL Onalazing(B$):
IF ans = 2 THEN ans = 0: CALL pro(nbasex + 1, nbasey + 5, SPACE$(68), 8): GOTO Spaces
IF ans = 1 THEN ans = 0: CALL pro(nbasex + 1, nbasey + 5, SPACE$(68), 8): GOTO 10
IF B$ = "" THEN CALL file(0): CALL pro(nbasex + 1, nbasey + 5, SPACE$(68), 8): GOTO 10
IF LEN(B$) < 5 THEN B$ = B$ + SPACE$(5 - LEN(B$))

IF LEFT$(B$, 1) = "B" THEN firstletter = 1: B$ = "1" + RIGHT$(B$, 4)

g$ = Operation$(B$)
IF g$ = "ESC" THEN CALL pro(nbasex + 7, nbasey + 5, SPACE$(24), 8): GOTO 11
IF firstletter = 1 THEN B$ = "B" + RIGHT$(B$, 4): firstletter = 0
IF peace$ <> "Already" THEN CALL printer(7 + nbasex, 5 + nbasey, g$, 15, 8): CALL printer(33 + nbasex, 5 + nbasey, peace$, 15, 8)
Dol$ = ""
3 IF fgg = 2 THEN Dol$ = Pricce$(B$): Dol$ = Trans.Price$(Dol$): IF VAL(Dol$) = 0 THEN Dol$ = Nput$(44, 10, 15, 8, 10, "") ELSE CALL printer(39 + nbasex, 5 + nbasey, Dol$, 15, 8)
IF fgg = 1 THEN Dol$ = Nput$(44, 10, 15, 8, 10, Dol$)
IF Dol$ = "ESC" THEN CALL pro(nbasex + 1, nbasey + 5, SPACE$(68), 8): CALL printer(nbasex + 1, nbasey + 5, B$, 15, 8): GOTO 11
IF bal = 1 AND dd = 0 OR bal = 4 AND dd = 0 THEN Dol$ = balance$(Dol$): dd = 1: CALL printer(39 + nbasex, 5 + nbasey, Dol$, 15, 8)
Kol$ = Nput$(53, 10, 15, 8, 10, "")
IF Kol$ = "ESC" THEN CALL pro(53, 10, SPACE$(LEN(Kol$)), 8): GOTO 3
Summa$ = LEFT$(STR$(VAL(Dol$) * VAL(Kol$)), 8)
IF bal = 2 OR bal = 5 THEN Kol$ = balance$(Kol$): CALL printer(48 + nbasex, 5 + nbasey, Kol$, 15, 8)
IF bal = 4 OR bal = 5 THEN Summa$ = balance$(Summa$)
CALL printer(56 + nbasex, 5 + nbasey, Summa$, 15, 8): dd = 0
y(Active) = y(Active) + 1
ch$(y(Active), Active) = B$ + SPACE$(5 - LEN(B$)) + " " + g$ + " " + peace$ + " " + Dol$ + SPACE$(9 - LEN(Dol$)) + Kol$ + SPACE$(8 - LEN(Kol$)) + Summa$
Amount(Active) = Amount(Active) + VAL(Summa$)

Spaces:
CALL printer(nbasex + 57, nbasey + 7, STR$(Amount(Active)) + " ", 0, 15)
CALL printer(nbasex + 31, nbasey + 7, LTRIM$(STR$(Active)), 0, 15)
CALL printer(nbasex + 15, nbasey + 7, STR$(y(Active) - 1) + " ", 0, 15)
IF y(Active) >= 2 THEN
IF (y(Active) - 1) <> 1 THEN CALL printer(nbasex + 1, nbasey + 3, ch$(y(Active) - 1, Active) + SPACE$(68 - LEN(ch$(y(Active) - 1, Active))), 15, 8)
CALL printer(nbasex + 1, nbasey + 4, ch$(y(Active), Active) + SPACE$(68 - LEN(ch$(y(Active), Active))), 15, 8)
CALL pro(nbasex + 1, nbasey + 5, SPACE$(68), 8)
END IF
IF y(Active) = 1 THEN CALL pro(nbasex + 1, nbasey + 3, SPACE$(68), 8): CALL pro(nbasex + 1, nbasey + 4, SPACE$(68), 8)

GOTO 10

20 CLOSE
SELECT CASE ERR
CASE 53: B$ = Inpt.WINDOW$(" ERROR #53", "File not found..", 20, 15, 8, 15, 8, 2, 5)
CASE 70: B$ = Inpt.WINDOW$(" ERROR #70", "Disk write-protect..", 25, 15, 8, 15, 8, 2, 5)
CASE 71: B$ = Inpt.WINDOW$(" ERROR #71", "Disk not ready..", 20, 15, 8, 15, 8, 2, 5)
CASE 76: B$ = Inpt.WINDOW$(" ERROR #76", "Path not found..", 20, 15, 8, 15, 8, 2, 5)
CASE 64: B$ = Inpt.WINDOW$(" ERROR #64", "Bad file name..", 20, 15, 8, 15, 8, 2, 5)
CASE ELSE: B$ = Inpt.WINDOW$(" ERROR #" + STR$(ERR), "Unknowed error..", 20, 15, 8, 15, 8, 2, 5)

END SELECT
GOTO 10

RESUME

22 LOCATE 1, 1: SCREEN 0: WIDTH 80: COLOR 14: PRINT "Somthing wrong with nbase.set file or with other files. Can't run program !"
PRINT "Please run SETUP.EXE. This is intialization program. It will set with your help right paths for Nbase 3.3 ."
SYSTEM

FUNCTION Autodir$
SHARED Dir$(), Fil$(), PathSpec$, Drive$, Dir, Fil, NMerc$, pathes$(), winss()

GET ((4 - 1) * 8 - 2, (3 - 1) * 16 + 1)-(35 * 8 + 2, 20 * 16 + 2), winss
OPEN pathes$(1) + "nbase.grf" FOR BINARY AS #4
FOR t = 0 TO 10000
PUT #4, , winss(t)
NEXT
CLOSE #4
GET ((36 - 1) * 8 - 2, (3 - 1) * 16 + 1)-(65 * 8 + 2, 20 * 16 + 2), winss

CALL DEF.usr2(1)
Drive$ = ""
s2: path$ = Drive$ + PathSpec$ + "*.*"
SHELL "Dir " + path$ + " > " + pathes$(1) + "Nick1.twh"
OPEN pathes$(1) + "Nick1.twh" FOR INPUT AS #9
FOR tgg = 1 TO 5: INPUT #9, a$: NEXT
a$ = SPACE$(39) + ":"
WHILE MID$(a$, 40, 1) = ":"
LINE INPUT #9, a$
IF MID$(a$, 40, 1) = ":" THEN
IF MID$(a$, 14, 5) = "
"
AND MID$(a$, 1, 8) = ". " THEN GOTO yuall
IF MID$(a$, 14, 5) = "
"
THEN Dir = Dir + 1: Dir$(Dir) = MID$(a$, 1, 8) + SPACE$(4) ELSE Fil = Fil + 1: Fil$(Fil) = MID$(a$, 1, 13)
yuall:
END IF
WEND
CLOSE #9

CALL Seven.up
IF NMerc$ = "" THEN NMerc$ = "": GOTO Restfor2
IF NMerc$ <> "" THEN GOTO Restfor
Dir = 0: Fil = 0: t = 1
GOTO s2
Restfor:
Autodir$ = NMerc$
NMerc$ = ""
Restfor2: Dir = 0: Fil = 0: t = 1

PUT ((36 - 1) * 8 - 2, (3 - 1) * 16 + 1), winss, PSET
OPEN pathes$(1) + "nbase.grf" FOR BINARY AS #4
FOR t = 0 TO 10000
GET #4, , winss(t)
NEXT
CLOSE #4

CALL winlsc(4, 3)
END FUNCTION

FUNCTION Autodir.Orange.menu (x1!, y1!, m$(), n!, nn!, fg!, BG!, barFG!, barBG!, LFG!, LbarFG!)
SHARED mmm$
mmm$ = ""
s! = LEN(m$(1))
dd! = x1! + 2
'IF nn >= n THEN
'FOR t! = 1 TO n!
'CALL printer(x1! + 1, y1! + 1 + t!, m$(t!), FG!, BG!)
'CALL printer(x1! + 1, y1! + 1 + t!, MID$(m$(t!), 1, 1), LFG!, BG!)
'NEXT
'END IF

'IF nn = nm THEN
'FOR t! = 1 TO nn!
'CALL printer(x1! + 1, y1! + 1 + t!, m$(t!), FG!, BG!)
'CALL printer(x1! + 1, y1! + 1 + t!, MID$(m$(t!), 1, 1), LFG!, BG!)
'NEXT
'END IF

g! = 1
GOSUB A1
Auto1: a$ = INKEY$
IF a$ = CHR$(0) + CHR$(80) OR a$ = " " THEN GOSUB A2: g! = g! + 1: GOSUB A1
IF a$ = CHR$(0) + CHR$(72) THEN GOSUB A2: g! = g! - 1: GOSUB A1
IF a$ = CHR$(13) THEN GOTO Aok2
IF a$ = CHR$(27) THEN mmm$ = "ESC": GOTO Aok3
IF a$ = CHR$(9) THEN GOSUB A2: mmm$ = "TAB": GOTO Aok3



GOTO Auto1
A1:
GOSUB AERR
CALL printer(x1! + 1, y1! + 1 + g!, m$(g! + gg!), barFG!, barBG!)
CALL printer(x1! + 1, y1! + 1 + g!, MID$(m$(g! + gg!), 1, 1), LbarFG!, barBG!)
RETURN

A2:
GOSUB AERR
CALL printer(x1! + 1, y1! + 1 + g!, m$(g! + gg!), fg!, BG!)
CALL printer(x1! + 1, y1! + 1 + g!, MID$(m$(g! + gg!), 1, 1), LFG!, BG!)

RETURN
A3:
IF n <= nn THEN
FOR t! = 1 TO n!
CALL printer(x1! + 1, y1! + 1 + t!, m$(t! + gg!), fg!, BG!)
CALL printer(x1! + 1, y1! + 1 + t!, MID$(m$(t! + gg!), 1, 1), LFG!, BG!)
NEXT
END IF

IF n > nn THEN
FOR t! = 1 TO nn!
CALL printer(x1! + 1, y1! + 1 + t!, m$(t! + gg!), fg!, BG!)
CALL printer(x1! + 1, y1! + 1 + t!, MID$(m$(t! + gg!), 1, 1), LFG!, BG!)
NEXT
END IF

RETURN

AERR:
IF g < 1 THEN
IF gg = 0 THEN g = 1
IF gg > 0 THEN g = 1: gg = gg - 1: GOSUB A3
END IF
IF g > n OR g > nn THEN
IF gg = 0 AND g > nn THEN g = nn: GOTO AOKJ
IF g > n THEN gg = gg + 1: g = n: IF gg + g > nn THEN gg = gg - 1: GOSUB A3 ELSE GOSUB A3
END IF
AOKJ:
RETURN


Aok2:
GOSUB A2
Autodir.Orange.menu = g! + gg!
Aok3:

END FUNCTION

FUNCTION balance$ (s$)

s$ = LTRIM$(s$)
f$ = MID$(STR$(INT(VAL(s$))), 2, LEN(s$))

d = LEN(s$) - LEN(f$)
IF d = 0 THEN g$ = s$ + ".00"
IF d = 2 THEN g$ = s$ + "0"
IF d = 3 THEN g$ = s$: GOTO endbalance
IF d - 1 > 3 THEN g$ = MID$(s$, 1, LEN(f$) + 3)
endbalance: balance$ = g$

END FUNCTION

SUB Bases
SHARED peace$

DIM m$(6): REDIM n(6), winssc2(15000)
GET (12 * 8 - 2, 1)-(65 * 8 + 2, 3.5 * 16 + 2), winssc2
CALL win(13, 1, 65, 3.5, 0, 15)
m$(1) = "See ": n(1) = 8
m$(2) = "New ": n(2) = 10
m$(3) = "#@": n(3) = 2
m$(4) = "Delete ": n(4) = 9
4 i = Orange.main.menu(m$(), 4, n(), "BASE MENU")
CALL win(13, 1, 65, 3.5, 0, 15)
IF i = 0 THEN 5

IF i = 1 THEN
CALL printer(14, 2, "Article is", 0, 15)
i$ = Nput$(25, 2, 0, 15, 5, "")
B$ = Operat$(i$, "", "", 0)
IF B$ <> "File not found." THEN B$ = B$ + " " + peace$
CALL printer(14, 3, B$, 1, 15)
GOTO 4
END IF

IF i = 2 THEN
CALL printer(14, 2, "Article is", 0, 15)
i$ = Nput$(25, 2, 0, 15, 5, "")
CALL printer(14, 2, "Input Name of good", 0, 15)
in$ = Nput$(14, 3, 0, 15, 24, "")
CALL printer(14, 2, "Input Peaces of good", 0, 15)
ip$ = Nput$(40, 3, 0, 15, 5, "")
B$ = Operat$(i$, in$, ip$, 2)
CALL win(13, 1, 65, 3.5, 0, 15)
CALL printer(14, 3, B$, 1, 15)
GOTO 4
END IF

IF i = 4 THEN
CALL printer(14, 2, "Article is", 0, 15)
i$ = Nput$(25, 2, 0, 15, 5, "")
B$ = Operat$(i$, "", "", 1)
IF B$ <> "File not found." THEN B$ = B$ + " " + peace$
CALL printer(14, 3, B$, 1, 15)
GOTO 4
END IF


5 PUT (12 * 8 - 2, 1), winssc2, PSET
END SUB

SUB button (x, y, st$, inactive)
IF inactive = 1 THEN CALL printer(x, y, st$, 0, 7) ELSE CALL printer(x, y, st$, 22, 7)
IF inactive = 1 THEN CALL printer(x, y, MID$(st$, 1, 1), 15, 7)
LINE ((x - 1) * 8 - 1, (y - 1) * 16 - 1)-((x + LEN(st$) - 1) * 8 + 1, y * 16), 8, B
LINE ((x - 1) * 8 + 1, y * 16 + 1)-((x + LEN(st$) - 1) * 8 + 2, y * 16 + 1), 0
LINE ((x + LEN(st$) - 1) * 8 + 2, (y - 1) * 16 + 1)-((x + LEN(st$) - 1) * 8 + 2, y * 16), 0
END SUB

FUNCTION ClearSlash$ (IS$)
IS$ = MID$(IS$, 1, LEN(IS$) - 1)

FOR t = 30 TO 1 STEP -1
a$ = MID$(IS$, t, 1): tt = t
IF a$ = "" THEN d$ = LEFT$(IS$, tt - 1): GOTO Stopping4
NEXT
Stopping4:
IF d$ <> "" THEN ClearSlash$ = d$ + "" ELSE ClearSlash$ = d$

END FUNCTION

SUB DATA.LOADER
SHARED pathes$(), y(), ch$(), fg, fgg, Active, Amount(), bal, layout, NAME$(), Erre$
OPEN pathes$(1) + "nbase2.set" FOR INPUT AS #8
INPUT #8, Active
FOR i = 1 TO 8
INPUT #8, y(i)
INPUT #8, Amount(i)
FOR t = 1 TO y(i)
INPUT #8, ch$(t, i)
NEXT
NEXT

INPUT #8, fg
INPUT #8, fgg
INPUT #8, bal
INPUT #8, layout
FOR t = 1 TO 8
INPUT #8, NAME$(t)
NEXT
INPUT #8, Erre$
CLOSE #8

END SUB

SUB DEF.usr2 (n)
IF n = 1 OR n = 11 THEN
CALL win(4, 3, 65, 20, 15, 8)
CALL printer(5, 4, "Directories List of file names", 14, 8)
LINE (4 * 8 - 8, 4 * 16)-(65 * 8, 4 * 16), 15
LINE (4 * 8 - 8, 17 * 16)-(65 * 8, 17 * 16), 15
LINE (17 * 8 + 2, 3 * 16 - 4)-(17 * 8 + 2, 17 * 16), 15

IF n <> 11 THEN CALL printer(14, 19, " Load ", 1, 15): CALL printer(39, 19, " Cancel ", 1, 15) ELSE CALL printer(5, 19, " Save Cancel", 1, 15)
END IF
IF n = 2 THEN
CALL printer(14, 19, " Load ", 15, 8)
SOUND 100, .1
SLEEP (1)
END IF

IF n = 3 THEN
CALL printer(39, 19, " Cancel ", 15, 8)
SOUND 100, .1
SLEEP (1)
END IF

END SUB

SUB Director
SHARED pathes$(), que$
x2 = 67: y2 = 14
CALL winssc(13, 6, x2, y2)
CALL win(13, 6, x2, y2, 0, 15)':CALL win(13, 6, 37, 20, 0, 15):

LINE (12 * 8 + 3, 7 * 16 + 5)-(x2 * 8 - 3, y2 * 16 - 3), 8, BF

CALL printn(17, 93, "DIRECTORIES")
LINE (12 * 8, 7 * 16)-(x2 * 8, 7 * 16), 0
LINE (12 * 8, 7 * 16 + 2)-(x2 * 8, 7 * 16 + 2), 0
CALL printer(18, 10, "Nbase files", 15, 8): CALL ON.OFF(14, 10, 3)
CALL printer(18, 11, "Main base dir", 15, 8): CALL ON.OFF(14, 11, 4)
CALL printer(18, 12, "LFZ base dir", 15, 8): CALL ON.OFF(14, 12, 4)
CALL printer(33, 10, pathes$(1), 14, 8)
CALL printer(33, 11, pathes$(2), 15, 8)
CALL printer(33, 12, pathes$(3), 15, 8)
yy = 1


IF pathes$(3) = "Not installed." THEN CALL ON.OFF(14, 12, 2)
WHILE que$ <> "ESC"
IF yy = 1 THEN CALL ON.OFF(14, 10, 3) ELSE CALL ON.OFF(14, 10, 4)
IF yy = 2 THEN CALL ON.OFF(14, 11, 3) ELSE CALL ON.OFF(14, 11, 4)
IF yy <> 3 THEN CALL ON.OFF(14, 12, 4) ELSE CALL ON.OFF(14, 12, 3)
IF pathes$(3) = "Not installed." THEN CALL ON.OFF(14, 12, 2)

pathes$(yy) = Nput4$(33, 9 + yy, 14, 8, 30, pathes$(yy))
CALL printer(33, 9 + yy, pathes$(yy), 15, 8)

IF que$ = "UP" THEN yy = yy - 1
IF que$ = "DOWN" THEN yy = yy + 1
IF yy < 1 THEN yy = 3
IF yy > 3 THEN yy = 1
IF pathes$(3) = "Not installed." THEN IF que$ = "UP" THEN yy = 1 ELSE yy = 2
WEND
que$ = ""
CALL winlsc(13, 6)
END SUB

SUB file (n)
SHARED y(), Amount(), ch$(), Active, savetext, NAME$(), que$, pathes$()

IF n = 0 THEN
DIM m$(6): REDIM n(6)
m$(1) = "Help ": n(1) = 3
m$(2) = "Save ": n(2) = 1
m$(3) = "Load ": n(3) = 2
m$(4) = "Base ": n(4) = 10
m$(5) = "#@": n(5) = 0
m$(6) = "Exit ": n(6) = 9
i = Orange.main.menu(m$(), 6, n(), "MAIN MENU")
IF i = 3 THEN n = 1
IF i = 2 THEN n = 2
IF i = 6 THEN n = 3
IF i = 4 THEN CALL Bases
END IF

IF n = 1 THEN
IF LTRIM$(que$) = "" THEN path$ = Autodir$ ELSE path$ = LTRIM$(que$)
IF path$ = "" OR path$ = "" THEN GOTO Endfileop
ON ERROR GOTO 20
OPEN path$ FOR INPUT AS #2
INPUT #2, yy
IF yy = 0 THEN B$ = Inpt.WINDOW$(" ERROR", "Bad file mode ..", 20, 15, 8, 15, 8, 2, 5): GOTO Endfileop
INPUT #2, AAmount
y(Active) = 1: Amount(Active) = AAmount
CALL linery(15, 15, " Loading.. ", yy, 0)
FOR t = 2 TO yy
CALL linery(15, 15, " Loading.. ", yy, 1)
y(Active) = y(Active) + 1
INPUT #2, ch$(y(Active), Active)
NEXT
NAME$(Active) = ".." + RIGHT$(path$, 12)
CALL linery(15, 15, " Loading.. ", yy, 2)
CLOSE #2
END IF

IF n = 2 AND savetext = 1 THEN
path$ = Inpt.WINDOW$("NBASE SAVING MODE", pathes$(1) + "", 25, 15, 8, 15, 8, 1, 4)
IF path$ = "" OR path$ = "" THEN BEEP: GOTO Endfileop
ON ERROR GOTO 20

OPEN path$ FOR OUTPUT AS #2
PRINT #2, y(Active)
CALL linery(15, 15, " Saving .. ", y(Active), 0)
PRINT #2, Amount(Active)
FOR t = 2 TO y(Active)
CALL linery(15, 15, " Saving .. ", y(Active), 1)
PRINT #2, ch$(t, Active)
NEXT
NAME$(Active) = ".." + RIGHT$(path$, 12)
CLOSE #2
CALL linery(15, 15, " Saving .. ", y(Active), 2)
END IF

IF n = 3 THEN
DIM s$(2)
s$(1) = " Yes "
s$(2) = " No "
CALL winssc(10, 10, 40, 18)
CALL win(10, 10, 40, 18, 15, 8)
LINE (9 * 8 + 3, 9 * 16 + 8)-(40 * 8 - 3, 10 * 16 + 17), 15, BF
LINE (9 * 8, 11 * 16 + 4)-(40 * 8, 11 * 16 + 4), 15
CALL printn(10, 160, "DO YOU WANT TO QUIT ?")
CALL picture(12, 15, 7)
CALL picture(12, 16, 6)
i = Orange.menu(17, 13, s$(), 2, 0, 7, 7, 0, 15, 15, 1)
IF i = 1 THEN
OPEN "nbase.set" FOR OUTPUT AS #8
FOR t = 1 TO 4: PRINT #8, pathes$(t): NEXT
CLOSE #8
SCREEN 0: WIDTH 80: PRINT "Thanks for using Nbase 3.5": SYSTEM
END IF
CALL winlsc(10, 10)
END IF

IF n = 2 AND savetext = 2 THEN

path$ = Inpt.WINDOW$("TEXT SAVING MODE", "C:QB", 25, 15, 8, 15, 8, 1, 4)
IF path$ = "" OR path$ = "" THEN BEEP: GOTO Endfileop
ON ERROR GOTO 20
OPEN path$ FOR OUTPUT AS #2

PRINT #2, " Specification "
PRINT #2, " "
PRINT #2, "N_ Name of the goods Pcs. Q-ty Price Amount"
PRINT #2, "--------------------------------------------------------------"
FOR t = 2 TO y(Active)
PRINT #2, ch$(t, Active)
NEXT
PRINT #2, " ---------"
PRINT #2, " Total amount " + STR$(Amount(Active))
NAME$(Active) = ".." + RIGHT$(path$, 12)
CLOSE #2

END IF
Endfileop:
END SUB

SUB File.man
SHARED Fil$(), pathes$()

SHELL "Dir " + pathes$(1) + "ICO*.ico > " + pathes$(1) + "Nick1.twh"
OPEN pathes$(1) + "Nick1.twh" FOR INPUT AS #9
FOR tgg = 1 TO 5: INPUT #9, a$: NEXT
a$ = SPACE$(39) + ":"
WHILE MID$(a$, 40, 1) = ":"
LINE INPUT #9, a$
IF MID$(a$, 40, 1) = ":" THEN
IF MID$(a$, 14, 5) = "
"
AND MID$(a$, 1, 8) = ". " THEN GOTO yuall2
IF MID$(a$, 14, 5) <> "
"
THEN Fil = Fil + 1: Fil$(Fil) = MID$(a$, 1, 13)
yuall2:
END IF
WEND
CLOSE #9
x = 2: y = 2
REDIM scr(63)
CALL winssc(2, 1, 79, 7)
CALL win(2, 1, 79, 7, 0, 15)


FOR t = 1 TO Fil

LINE (x * 8 - 2, y * 16 - 2)-((x + 2) * 8 + 7, (y + 1) * 16 + 7), 7, B
LINE (x * 8 - 1, y * 16 - 1)-((x + 2) * 8 + 7, (y + 1) * 16 + 7), 0, BF
LINE (x * 8 - 1, y * 16 - 1)-((x + 2) * 8 + 7, (y + 1) * 16 + 7), 8, B
OPEN pathes$(1) + "ico" + RTRIM$(LEFT$(Fil$(t), 8)) + "." + RTRIM$(RIGHT$(Fil$(t), 4)) FOR BINARY AS #3

FOR i = 0 TO 63
GET #3, , scr(i)
NEXT
PUT (x * 8, y * 16), scr, PSET
CLOSE #3
CALL printer(x + 1, y + 3, RTRIM$(LEFT$(Fil$(t), 8)), 0, 15)
x = x + 8
NEXT
xx = 0
GOSUB Filman20
Filman10: a$ = INKEY$
IF a$ = CHR$(0) + CHR$(77) THEN GOSUB Filman30: xx = xx + 1: GOSUB Filman20
IF a$ = CHR$(0) + CHR$(75) THEN GOSUB Filman30: xx = xx - 1: GOSUB Filman20
IF a$ = CHR$(27) THEN GOTO Filman40
IF a$ = CHR$(13) THEN GOTO Filman50

GOTO Filman10
Filman20:
IF xx < 0 THEN xx = 0
IF xx > Fil - 1 THEN xx = Fil - 1
CALL printer(xx * 8 + 3, y + 3, RTRIM$(LEFT$(Fil$(xx + 1), 8)), 0, 7)
CALL printer(xx * 8 + 3, y + 3, RTRIM$(LEFT$(Fil$(xx + 1), 1)), 15, 7)

LINE ((xx * 8 + 2) * 8, (y + 2) * 16)-((xx * 8 + 3 + LEN(RTRIM$(LEFT$(Fil$(xx + 1), 8))) - 1) * 8, (y + 3) * 16 - 1), 8, B
LINE ((xx * 8 + 2) * 8 + 2, (y + 3) * 16)-((xx * 8 + 3 + LEN(RTRIM$(LEFT$(Fil$(xx + 1), 8))) - 1) * 8 + 1, (y + 3) * 16 + 1), 0, BF
LINE ((xx * 8 + 3 + LEN(RTRIM$(LEFT$(Fil$(xx + 1), 8))) - 1) * 8 + 1, (y + 2) * 16 + 2)-((xx * 8 + 3 + LEN(RTRIM$(LEFT$(Fil$(xx + 1), 8))) - 1) * 8 + 1, (y + 3) * 16 + 1), 0, BF
RETURN
Filman30:
CALL printer(xx * 8 + 3, y + 3, RTRIM$(LEFT$(Fil$(xx + 1), 8)), 0, 15)
LINE ((xx * 8 + 2) * 8 + 2, (y + 3) * 16)-((xx * 8 + 3 + LEN(RTRIM$(LEFT$(Fil$(xx + 1), 8))) - 1) * 8 + 1, (y + 3) * 16 + 1), 15, BF
LINE ((xx * 8 + 3 + LEN(RTRIM$(LEFT$(Fil$(xx + 1), 8))) - 1) * 8 + 1, (y + 2) * 16 + 2)-((xx * 8 + 3 + LEN(RTRIM$(LEFT$(Fil$(xx + 1), 8))) - 1) * 8 + 1, (y + 3) * 16 + 1), 15, BF

RETURN
Filman50:
SHARED y(), ch$(), fg, fgg, Active, Amount(), bal, layout, NAME$(), Erre$
OPEN "nbase.set" FOR OUTPUT AS #8
FOR t = 1 TO 3: PRINT #8, pathes$(t): NEXT
PRINT #8, " 1"
CLOSE #8
CLOSE
OPEN pathes$(1) + "nbase2.set" FOR OUTPUT AS #8

PRINT #8, Active

FOR i = 1 TO 8
PRINT #8, y(i)
PRINT #8, Amount(i)
FOR t = 1 TO y(i)
PRINT #8, ch$(t, i)
NEXT
NEXT

PRINT #8, fg
PRINT #8, fgg
PRINT #8, bal
PRINT #8, layout
FOR t = 1 TO 8
PRINT #8, NAME$(t)
NEXT
PRINT #8, Erre$
CLOSE #8
OPEN pathes$(1) + "nbase3.set" FOR OUTPUT AS #3
PRINT #3, RTRIM$(LEFT$(Fil$(xx + 1), 8))
CLOSE #3
CHAIN pathes$(1) + "ICOSaver.bas"

Filman40:
CALL winlsc(2, 1)
END SUB

SUB init
SHARED mouse1(), mouse2(), mouse3(), mouse4(), mouse5(), mouse6(), mouse7(), buton(), winss(), pathes$(), all


OPEN pathes$(1) + "mouse3.bin" FOR BINARY AS #1
IF all = 0 THEN CALL linery(7, 8, " Loading Binary Data ", 290, 0)
FOR t = 1 TO 7
FOR i = 0 TO 40
IF all = 0 THEN CALL linery(7, 8, " Loading Binary Data ", 290, 1)
IF t = 1 THEN GET #1, , mouse1(i)
IF t = 2 THEN GET #1, , mouse2(i)
IF t = 3 THEN GET #1, , mouse3(i)
IF t = 4 THEN GET #1, , mouse4(i)
IF t = 5 THEN GET #1, , mouse5(i)
IF t = 6 THEN GET #1, , mouse6(i)
IF t = 7 THEN GET #1, , mouse7(i)
NEXT
NEXT
IF all = 0 THEN CALL linery(7, 8, " Loading Binary Data ", 290, 3)
CLOSE #1

OPEN pathes$(1) + "nbase5.bin" FOR BINARY AS #1
h = 0
IF all = 0 THEN CALL linery(11, 11, " Loading Binary Pictures ", 230, 0)
FOR i = 1 TO 10:
FOR t = 0 TO 22
IF all = 0 THEN CALL linery(11, 11, " Loading Binary Pictures ", 230, 1)
h = h + 1: GET #1, , buton(h)
NEXT: NEXT
IF all = 0 THEN CALL linery(11, 11, " Loading Binary Pictures ", 230, 3)
CLOSE #1

END SUB

SUB initilize
SHARED writa(), pathes$(), all
ON ERROR GOTO 22
OPEN "nbase.set" FOR INPUT AS #1
FOR t = 1 TO 3
INPUT #1, pathes$(t)
NEXT
INPUT #1, all
CLOSE #1
OPEN pathes$(1) + "chars3.bin" FOR BINARY AS #1
IF all = 0 THEN CALL linery(15, 15, " Loading Big letters ", 58, 0)
FOR t = 32 TO 90
IF all = 0 THEN CALL linery(15, 15, " Loading Big letters ", 58, 1)
FOR i = 0 TO 60
l = l + 1
GET #1, , writa(l)
NEXT
NEXT
IF all = 0 THEN CALL linery(15, 15, " Loading Big letters ", 58, 3)
CLOSE #1

END SUB

FUNCTION Inpt.WINDOW$ (title$, is2$, max, fg, BG, curFG, curBG, turner, n)
SHARED inx, iny, maxin, winss()
inx = 13: iny = 6: maxin = max + 1
'CALL win(inx, iny, inx + max, iny + 3, FG, BG)
'CALL winssc(inx, iny, inx + max, iny + 3)
GET ((inx - 1) * 8 - 3, (iny - 1) * 16)-((inx + maxin) * 8 + 5, (iny + 3) * 16 + 3), winss
CALL win(inx, iny, inx + maxin, iny + 3, fg, BG)

LINE (12 * 8 + 3, 5 * 16 + 7)-((13 + maxin - 3) * 8 - 3, 7 * 16 - 3), 15, BF
CALL picture(13 + maxin - 2, 6.5, n)
CALL printn(11, 93, title$)
LINE (12 * 8, 7 * 16 - 1)-((13 + maxin) * 8, 7 * 16 - 1), 15

IF turner = 1 THEN Inpt.WINDOW$ = Nput3$(14, 8, curFG, curBG, max, is2$)
IF turner = 2 THEN CALL printer(14, 8, is2$, curFG, curBG): CALL pauses
PUT ((inx - 1) * 8 - 3, (iny - 1) * 16), winss, PSET
END FUNCTION

FUNCTION j$ (B$)
SHARED pathes$()
'k$ = "C:/qb/base/B2"
k$ = pathes$(3)

IF LEN(B$) = 5 THEN path$ = k$ + "/n5/h" + MID$(B$, 3, 1) + "/" + MID$(B$, 5, 1) + ".nic": GOTO yll
IF LEN(B$) = 4 THEN path$ = k$ + "/n4/h" + MID$(B$, 3, 1) + "/" + MID$(B$, 4, 1) + ".nic": GOTO yll
IF LEN(B$) = 3 THEN path$ = k$ + "/n3/h" + MID$(B$, 3, 1) + "/"
IF LEN(B$) = 2 THEN path$ = k$ + "/n2/h" + MID$(B$, 2, 1) + "/"
IF LEN(B$) = 1 THEN path$ = k$ + "/n1/"

l$ = LEFT$(B$, 1)
path$ = path$ + l$ + ".nic"
yll:
j$ = path$



END FUNCTION

SUB layout.changer (n)
SHARED layout
IF layout = 1 THEN layout = 2 ELSE layout = 1
IF n <> 0 THEN layout = n
CALL winssc(15, 1, 60, 3.4)
CALL win(15, 1, 60, 3.4, 15, 8)
LINE (14 * 8 + 3, 8)-(60 * 8 - 3, 2 * 16 - 9), 15, BF
LINE (14 * 8, 2 * 16 - 6)-(60 * 8, 2 * 16 - 6), 15
CALL printn(23, 8, "LAYOUT CHANGER")
LINE (19 * 8 + 3, 2 * 16 - 2)-(55 * 8 - 3, 3.4 * 16 - 4), 7, BF
CALL printer(23, 3, "Russian English", 0, 7)
IF layout = 2 THEN CALL ON.OFF(16, 3, 3) ELSE CALL ON.OFF(16, 3, 4)
IF layout = 1 THEN CALL ON.OFF(57, 3, 3) ELSE CALL ON.OFF(57, 3, 4)
SLEEP (1)
CALL winlsc(15, 1)
END SUB

SUB linery (x, y, a$, DL, madonna)
SHARED GL, v, procent, pr
IF madonna = 0 THEN
CALL winssc(x, y, x + 34, y + 4)
CALL win(x, y, x + 34, y + 4, 15, 8)
row = 32
GL = DL / ((DL / row) * DL)
procent = DL / ((DL / 100) * DL)
CALL printer(x + 1, y + 1, a$ + SPACE$(33 - LEN(a$)), 15, 8)
LINE ((x + 28) * 8, y * 16)-((x + 33) * 8, (y + 1) * 16), 0, BF
LINE ((x + 28) * 8 - 1, y * 16 - 1)-((x + 33) * 8 + 1, (y + 1) * 16 + 1), 15, B
COLOR 15
END IF
IF madonna = 1 THEN
v = v + GL
lx = x + v + 1
pr = pr + procent
LOCATE y + 1, x + 30: PRINT LTRIM$(STR$(INT(pr)) + "%")
LINE ((x + 1) * 8, (y + 2) * 16)-(lx * 8, (y + 3) * 16), 7, BF
LINE ((x + 1) * 8 + 1, (y + 3) * 16 + 1)-(lx * 8 + 1, (y + 3) * 16 + 1), 0
LINE ((x + 1) * 8 + 1, (y + 3) * 16 + 2)-(lx * 8 + 1, (y + 3) * 16 + 2), 0
LINE ((x + 1) * 8, (y + 2) * 16 - 1)-(lx * 8 - 1, (y + 2) * 16 - 1), 15
LINE ((x + 1) * 8 - 1, (y + 2) * 16 - 2)-(lx * 8 - 1, (y + 2) * 16 - 2), 15
LINE ((x + 1) * 8 - 1, (y + 2) * 16 - 1)-((x + 1) * 8 - 1, (y + 3) * 16 - 1), 15
LINE ((x + 1) * 8, (y + 2) * 16 - 1)-((x + 1) * 8, (y + 3) * 16 - 1), 15
LINE (lx * 8 + 1, (y + 2) * 16 + 1)-(lx * 8 + 1, (y + 3) * 16 + 1), 0
LINE (lx * 8 + 2, (y + 2) * 16 + 1)-(lx * 8 + 2, (y + 3) * 16 + 2), 0
'
END IF

IF madonna = 2 OR madonna = 3 THEN
LOCATE y + 1, x + 30: PRINT "100%": a$ = " Completed .. ": CALL printer(x + 1, y + 1, a$ + SPACE$(27 - LEN(a$)), 15, 8): IF madonna = 2 THEN SLEEP (3)
CALL winlsc(x, y): GL = 0: v = 0: procent = 0: pr = 0
END IF
END SUB

SUB Load.WINDOW
'SHARED page1(), page2(), page3()
OPEN "monop.bin" FOR BINARY AS #1
FOR t = 0 TO 14000
'GET #1, , page1(t)
'GET #1, , page2(t)
'GET #1, , page3(t)
NEXT
CLOSE #1
CALL Lsc
END SUB

SUB Lsc
'PUT (0, 0), page1, PSET
'PUT (215, 0), page2, PSET
'PUT (433, 0), page3, PSET

END SUB

SUB mouses
SHARED mousex, mousey, mouse1()
lx = 1: ly = 1
PUT (lx * 8, ly * 16), mouse1

WHILE PEN(3) = -1
y = PEN(8) - 1
x = PEN(4) 8
IF ly <> y OR lx <> x THEN
PUT (lx * 8, ly * 16), mouse1
GOSUB Ermouse

lx = x: ly = y
PUT (x * 8, y * 16), mouse1
END IF
WEND
GOTO endmouse

Ermouse:
IF x < 1 THEN x = 1
IF y < 1 THEN y = 1
IF x > 77 THEN x = 77
IF y > 29 THEN y = 29
RETURN
endmouse:
PUT (x * 8, y * 16), mouse1
mousex = x: mousey = y

END SUB

SUB NBshell

SHARED mouse2(), mouse4(), mouse6(), nbwinss(), nbasex, nbasey

DIM s$(2)
s$(1) = " Yes "
s$(2) = " No "
CALL winssc(10, 10, 40, 18)
CALL win(10, 10, 40, 18, 15, 8)
LINE (9 * 8 + 3, 9 * 16 + 8)-(40 * 8 - 3, 10 * 16 + 17), 15, BF
LINE (9 * 8, 11 * 16 + 4)-(40 * 8, 11 * 16 + 4), 15
CALL printn(10, 160, "DO YOU WANT NB SHELL?")
CALL picture(12, 15, 7)
CALL picture(12, 16, 6)
i = Orange.menu(17, 13, s$(), 2, 0, 7, 7, 0, 15, 15, 1)
CALL winlsc(10, 10)
IF i = 1 THEN
SCREEN 0: WIDTH 80
LOCATE 1, 1: COLOR 14, 0: PRINT "Please type ~EXIT~ to return to Nbase 3.3"
SHELL: SCREEN 12: nbasex = 5: nbasey = 5
LINE (0, 0)-(640, 480), 9, BF
GET (4 * 8 - 3, 4 * 16)-(75 * 8 + 5, 13 * 16 + 3), nbwinss
CALL win(5, 5, 75, 13, 15, 8)
LINE ((5 - 1) * 8, 6 * 16)-(75 * 8, 6 * 16), 15
LINE (35, 71)-(597, 93), 15, BF
LINE ((5 - 1) * 8, 10 * 16 + 2)-(75 * 8, 10 * 16 + 2), 15
LINE ((5 - 1) * 8 + 2, 10 * 16 + 5)-(75 * 8 - 2, 13 * 16 - 3), 15, BF
CALL printn(5, 78, "ART NAME OF GOODS PCS Q-TY PRICE AMOUNT")
CALL printn(5, 176, "CURRENT ROW WINDOW #1 TOTAL AMOUNT")
CALL printer(nbasex + 58, nbasey + 7, "*", 0, 15)
CALL printer(nbasex + 16, nbasey + 7, "*", 0, 15)
PUT (6 * 8, 4 * 16), mouse2, PSET
PUT (70 * 8, 4 * 16), mouse4, PSET
PUT (71 * 8 + 4, 4 * 16), mouse6, PSET
PUT (74 * 8 + 4, 6 * 16), mouse4, PSET
PUT (74 * 8 + 4, 9 * 16), mouse6, PSET
LINE (74 * 8 + 6, 6 * 16 + 10)-(76 * 8 - 5, 9 * 16 - 1), 7, BF
LINE (74 * 8 + 5, 6 * 16 + 10)-(76 * 8 - 4, 9 * 16 - 1), 8, B
CALL button(3, 28, "Help - F1", 0)
CALL button(16, 28, "Options - F2", 1)
CALL button(31, 28, "Load - F3", 1)
CALL button(43, 28, "Save - F4", 1)
CALL button(55, 28, "Next - F6", 1)
CALL button(68, 28, "Quit - F10", 1)
END IF
END SUB

FUNCTION Neo.menu (x1!, y1!, m$(), n, fg!, BG!, barFG!, barBG!, LFG!, LbarFG!)
s = LEN(m$(1))
ss = 2 + x1! + s * n + n * 3
la = LEN(m$(1)) - LEN(LTRIM$(m$(1))) + 1
'CALL winssc(x1!, y1!, ss, y1! + 3)
CALL win(x1!, y1!, ss, y1! + 3, fg!, BG!)
dd = x1! + 2

FOR t = 1 TO n
CALL printer(dd, y1! + 2, m$(t), fg!, BG!)
CALL printer(dd + la - 1, y1! + 2, MID$(m$(t), la, 1), LFG!, BG!)
dd = dd + s + 3
NEXT
g = 1
GOSUB Q1
Main: a$ = INKEY$
IF a$ = CHR$(0) + CHR$(77) OR a$ = " " THEN GOSUB Q2: g! = g! + 1: GOSUB Q1
IF a$ = CHR$(0) + CHR$(75) THEN GOSUB Q2: g! = g! - 1: GOSUB Q1
IF a$ = CHR$(27) THEN GOSUB Q2: g = n: GOSUB Q1
IF a$ = CHR$(13) THEN GOTO ok

GOTO Main
Q1:
GOSUB ERRORS
CALL printer(x1! + s * (g - 1) + 2 + 3 * (g - 1), y1! + 2, m$(g), barFG!, barBG!)
CALL printer(x1! + s * (g - 1) + 2 + 3 * (g - 1) + la - 1, y1! + 2, MID$(m$(g), la, 1), LbarFG!, barBG!)

RETURN

Q2:
GOSUB ERRORS
CALL printer(x1! + s * (g - 1) + 2 + 3 * (g - 1), y1! + 2, m$(g), fg!, BG!)
CALL printer(x1! + s * (g - 1) + 2 + 3 * (g - 1) + la - 1, y1! + 2, MID$(m$(g), la, 1), LFG!, BG!)

RETURN


ERRORS:
IF g! < 0 OR g! = 0 THEN g! = n
IF g! > n THEN g! = 1
RETURN
ok:
Neo.menu = g!
'CALL winLsc(x1!, y1!)
END FUNCTION

FUNCTION Nput$ (x!, y!, fg!, BG!, max!, IS$)
SHARED nbasex, nbasey, layout, Between$
lx = x!: ly = y!

v$ = IS$: leghnt = LEN(v$)
f! = INT(TIMER)
x! = nbasex - 5 + lx + leghnt!: y! = nbasey - 5 + ly
CALL printer(x!, y!, CHR$(2), fg!, BG!)
Nput1: a$ = INKEY$
IF PEN(3) = -1 THEN CALL mouses: CALL sorting: x! = nbasex - 5 + lx + leghnt!: y! = nbasey - 5 + ly: IF Between$ <> "" THEN CALL pro(lx, y, SPACE$(LEN(v$) + 1), BG): Nput$ = Between$: Between$ = "": GOTO Nput3

IF a$ = CHR$(0) + CHR$(77) THEN a$ = " "

IF a$ <> "" THEN

IF leghnt! < max! THEN
ab = ASC(a$)
IF ab >= 32 AND ab <= 125 THEN
IF layout = 2 THEN a$ = CHR$(trans(ASC(a$)))
f! = INT(TIMER)
CALL printer(x!, y!, a$, fg!, BG!)
CALL printer(x! + 1, y!, CHR$(2), fg!, BG!)
x! = x! + 1: leghnt! = leghnt! + 1
v$ = v$ + a$
END IF
END IF
IF a$ = CHR$(0) + CHR$(75) OR a$ = CHR$(8) THEN
f! = INT(TIMER)
IF LEN(v$) < 1 THEN SOUND 300, .1: GOTO Nput4
x! = x! - 1: leghnt! = leghnt! - 1
CALL printer(x!, y!, CHR$(2), fg!, BG!)
CALL printer(x! + 1, y!, CHR$(1), fg!, BG!)
v$ = LEFT$(v$, LEN(v$) - 1)
Nput4:
END IF
IF a$ = CHR$(13) THEN CALL printer(x!, y!, CHR$(1), fg!, BG!): Nput$ = v$: GOTO Nput3
IF a$ = CHR$(27) THEN CALL pro(lx - 5 + nbasex, y, SPACE$(LEN(v$) + 1), BG): Nput$ = "ESC": GOTO Nput3
IF a$ = CHR$(0) + CHR$(85) AND PEEK(&H17) = 1 THEN CALL pro(lx, y, SPACE$(LEN(v$) + 1), BG): Nput$ = "Balance": GOTO Nput3
IF a$ = CHR$(0) + CHR$(85) AND PEEK(&H17) = 2 THEN CALL pro(lx, y, SPACE$(LEN(v$) + 1), BG): Nput$ = "Directories": GOTO Nput3
IF a$ = CHR$(0) + CHR$(105) THEN CALL pro(lx, y, SPACE$(LEN(v$) + 1), BG): Nput$ = "Window": GOTO Nput3
IF a$ = CHR$(0) + CHR$(95) THEN CALL layout.changer(0)
IF a$ = CHR$(0) + CHR$(18) THEN CALL layout.changer(1)
IF a$ = CHR$(0) + CHR$(19) THEN CALL layout.changer(2)
END IF


GOTO Nput1
Nput3:

END FUNCTION

FUNCTION Nput2$ (x!, y!, fg!, BG!, max!, st$)
SHARED layout
lx = x!: ly = y!
v$ = st$
leghnt = LEN(st$)
f! = INT(TIMER)
x! = lx + leghnt!: y! = ly
CALL printer(x!, y!, CHR$(2), fg!, BG!)
Nput12: a$ = INKEY$
IF a$ = CHR$(0) + CHR$(77) THEN a$ = " "

IF a$ <> "" THEN

IF leghnt! < max! THEN
ab = ASC(a$)
IF ab >= 32 AND ab <= 125 THEN
IF layout = 2 THEN a$ = CHR$(trans(ASC(a$)))
f! = INT(TIMER)
CALL printer(x!, y!, a$, fg!, BG!)
CALL printer(x! + 1, y!, CHR$(2), fg!, BG!)
x! = x! + 1: leghnt! = leghnt! + 1
v$ = v$ + a$
END IF
END IF
IF a$ = CHR$(0) + CHR$(75) OR a$ = CHR$(8) THEN
f! = INT(TIMER)
IF LEN(v$) < 1 THEN SOUND 300, .1: GOTO Nput42
x! = x! - 1: leghnt! = leghnt! - 1
CALL printer(x!, y!, CHR$(2), fg!, BG!)
CALL printer(x! + 1, y!, CHR$(1), fg!, BG!)
v$ = LEFT$(v$, LEN(v$) - 1)
Nput42:
END IF
IF a$ = CHR$(13) THEN CALL printer(x!, y!, CHR$(1), fg!, BG!): Nput2$ = v$: GOTO Nput32
IF a$ = CHR$(0) + CHR$(95) THEN CALL layout.changer(0)
IF a$ = CHR$(0) + CHR$(18) THEN CALL layout.changer(1)
IF a$ = CHR$(0) + CHR$(19) THEN CALL layout.changer(2)
END IF


GOTO Nput12
Nput32:


END FUNCTION

FUNCTION Nput3$ (x!, y!, fg!, BG!, max!, st$)
SHARED inx, iny
lx = x!: ly = y!
v$ = st$: leghnt! = LEN(v$)
CALL printer(x, y, st$, fg, BG)
f! = INT(TIMER)
x! = inx - 13 + lx + leghnt!: y! = iny - 6 + ly
CALL printer(x!, y!, CHR$(2), fg!, BG!)
Nput13: a$ = INKEY$
IF PEN(3) = -1 THEN CALL mouses: CALL sorting2: x! = inx - 13 + lx + leghnt!: y! = iny - 6 + ly
IF a$ = CHR$(0) + CHR$(77) THEN a$ = " "

IF a$ <> "" THEN
IF a$ = CHR$(13) THEN CALL printer(x!, y!, CHR$(1), fg!, BG!): Nput3$ = v$: GOTO Nput33
IF leghnt! < max! THEN
ab = ASC(a$)
IF ab >= 32 AND ab <= 125 THEN
f! = INT(TIMER)
CALL printer(x!, y!, a$, fg!, BG!)
CALL printer(x! + 1, y!, CHR$(2), fg!, BG!)
x! = x! + 1: leghnt! = leghnt! + 1
v$ = v$ + a$
END IF
END IF
IF a$ = CHR$(0) + CHR$(75) OR a$ = CHR$(8) THEN
f! = INT(TIMER)
IF LEN(v$) < 1 THEN SOUND 300, .1: GOTO Nput43
x! = x! - 1: leghnt! = leghnt! - 1
CALL printer(x!, y!, CHR$(2), fg!, BG!)
CALL printer(x! + 1, y!, CHR$(1), fg!, BG!)
v$ = LEFT$(v$, LEN(v$) - 1)
Nput43:
END IF

IF a$ = CHR$(27) THEN CALL printer(x!, y!, CHR$(1), fg!, BG!): Nput3$ = "": GOTO Nput33


END IF


GOTO Nput13
Nput33:

END FUNCTION

FUNCTION Nput4$ (x!, y!, fg!, BG!, max!, st$)
SHARED que$
lx = x!: ly = y!
v$ = st$: leghnt! = LEN(v$)
CALL printer(x, y, st$ + SPACE$(max - LEN(st$)), fg, BG)
f! = INT(TIMER)
x! = lx + leghnt!: y! = ly
CALL printer(x!, y!, CHR$(2), fg!, BG!)
Nput14: a$ = INKEY$
' IF PEN(3) = -1 THEN CALL mouses: CALL sorting2: x! = inx - 13 + lx + leghnt!: y! = iny - 6 + ly
IF a$ = CHR$(0) + CHR$(77) THEN a$ = " "

IF a$ <> "" THEN
IF a$ = CHR$(0) + CHR$(72) THEN que$ = "UP"
IF a$ = CHR$(0) + CHR$(80) OR a$ = CHR$(13) THEN que$ = "DOWN"
IF a$ = CHR$(27) THEN que$ = "ESC"

IF a$ = CHR$(27) OR a$ = CHR$(13) OR a$ = CHR$(0) + CHR$(72) OR a$ = CHR$(0) + CHR$(80) THEN CALL printer(x!, y!, CHR$(1), fg!, BG!): Nput4$ = v$: GOTO Nput34
IF leghnt! < max! THEN
ab = ASC(a$)
IF ab >= 32 AND ab <= 125 THEN
f! = INT(TIMER)
CALL printer(x!, y!, a$, fg!, BG!)
CALL printer(x! + 1, y!, CHR$(2), fg!, BG!)
x! = x! + 1: leghnt! = leghnt! + 1
v$ = v$ + a$
END IF
END IF
IF a$ = CHR$(0) + CHR$(75) OR a$ = CHR$(8) THEN
f! = INT(TIMER)
IF LEN(v$) < 1 THEN SOUND 300, .1: GOTO Nput54
x! = x! - 1: leghnt! = leghnt! - 1
CALL printer(x!, y!, CHR$(2), fg!, BG!)
CALL printer(x! + 1, y!, CHR$(1), fg!, BG!)
v$ = LEFT$(v$, LEN(v$) - 1)
Nput54:
END IF

'IF a$ = CHR$(27) THEN CALL printer(x!, y!, CHR$(1), FG!, BG!): Nput3$ = "": GOTO Nput34


END IF


GOTO Nput14
Nput34:


END FUNCTION

SUB ON.OFF (x1, y1, onoff)
IF onoff = 1 THEN C = 10: c1 = 2
IF onoff = 2 THEN C = 12: c1 = 4

LINE ((x1 - 1) * 8 + 1, (y1 - 1) * 16 + 1)-((x1 + 1) * 8 - 1, y1 * 16 - 1), 0, BF
LINE ((x1 - 1) * 8 + 2, (y1 - 1) * 16 + 2)-((x1 + 1) * 8 - 2, y1 * 16 - 2), 7, B
LINE ((x1 - 1) * 8 + 1, (y1 - 1) * 16 + 1)-((x1 + 1) * 8 - 1, y1 * 16 - 1), 8, B
LINE ((x1 + 1) * 8, (y1 - 1) * 16 + 2)-((x1 + 1) * 8, y1 * 16), 0
LINE ((x1 - 1) * 8 + 3, y1 * 16)-((x1 + 1) * 8, y1 * 16), 0
IF onoff = 3 THEN
LINE ((x1 * 8 - 4), (y1 - 1) * 16 + 4)-((x1 * 8 + 4), y1 * 16 - 4), 2, BF
LINE ((x1 * 8 - 2), (y1 - 1) * 16 + 6)-((x1 * 8 + 2), y1 * 16 - 6), 10, BF
END IF
IF onoff = 2 OR onoff = 1 THEN
LINE ((x1 * 8 - 1), (y1 - 1) * 16 + 3)-((x1 * 8 + 1), y1 * 16 - 3), C, BF
LINE ((x1 * 8 - 2), (y1 - 1) * 16 + 3)-((x1 * 8 - 4), y1 * 16 - 3), c1, BF
LINE ((x1 * 8 + 2), (y1 - 1) * 16 + 3)-((x1 * 8 + 4), y1 * 16 - 3), c1, BF
END IF
END SUB

SUB Onalazing (B$)
SHARED ans, ch$(), y(), Active, Amount(), que$
IF B$ = "Options" THEN ans = 1: CALL Options
IF B$ = "Scroll" THEN ans = 1: CALL Scroll
IF B$ = "Shell" THEN ans = 2: CALL NBshell
IF B$ = "Save" THEN ans = 1: CALL file(2)
IF B$ = "Exit" OR B$ = "Quit" THEN ans = 1: CALL file(3)
IF B$ = "Balance" THEN ans = 1: CALL Options2
IF B$ = "Jug" THEN BEEP: FOR t = 1 TO y(Active): PRINT "* "; ch$(t, Active); " *": NEXT
IF B$ = "Window" THEN ans = 2: CALL Options3
IF B$ = "Directories" THEN ans = 1: CALL Director
IF B$ = "OFF" THEN CALL SCREEN.saver
IF B$ = "Manager" THEN ans = 1: CALL File.man

IF LEFT$(B$, 4) = "Load" THEN
IF LEN(B$) > 5 THEN que$ = MID$(B$, 5, LEN(B$) - 4) ELSE que$ = ""
ans = 2: CALL file(1)
END IF

IF B$ = "Next" THEN
Active = Active + 1: IF Active = 9 THEN Active = 1
ans = 2
END IF

IF B$ = "Next DOWN" THEN
Active = Active - 1: IF Active = 0 THEN Active = 8
ans = 2
END IF

IF B$ = "Delete" THEN
Amo = VAL(MID$(ch$(y(Active), Active), 57, 8))
ch$(y(Active), Active) = "": y(Active) = y(Active) - 1: ans = 2
Amount(Active) = Amount(Active) - Amo
END IF
END SUB

FUNCTION Operat$ (B$, Dname$, Dpe$, n)

SHARED peace$

IF n = 0 THEN

d$ = fnm$(B$)
CLOSE : z = 1
OPEN "R", 1, d$
WHILE RTRIM$(LTRIM$(f$)) <> RTRIM$(LTRIM$(B$))
IF z = LOF(1) / 128 + 1 THEN g$ = "File not found.": GOTO 3081 ' IF NOT FOUND
FIELD #1, 3 AS e$, 5 AS f$, 25 AS g$, 5 AS peace$
GET #1, z
z = z + 1
WEND

3081
END IF

IF n = 1 THEN
d$ = fnm$(B$)
CLOSE : z = 1
OPEN "R", 1, d$
WHILE RTRIM$(LTRIM$(f$)) <> RTRIM$(LTRIM$(B$))
IF z = LOF(1) / 128 + 1 THEN g$ = "File not found.": GOTO 2081 ' IF NOT FOUND
FIELD #1, 3 AS e$, 5 AS f$, 25 AS g$, 5 AS peace$
GET #1, z
z = z + 1
WEND
LSET e$ = "": LSET f$ = "": LSET g$ = "": LSET peace$ = "": PUT #1, z - 1
g$ = "File succesfuly deleted"
2081
END IF

IF n = 2 THEN
d$ = fnm$(B$)
CLOSE : z = 1
OPEN "R", 1, d$
e$ = "999"
WHILE e$ = "999"
FIELD #1, 3 AS e$, 5 AS f$, 25 AS g$, 5 AS peace$
GET #1, z
IF e$ <> "999" THEN z = z + 1
z = z + 1
WEND
LSET e$ = "999"
LSET f$ = B$
LSET g$ = Dname$
LSET peace$ = Dpe$
PUT #1, z - 1
CLOSE #1
END IF


Operat$ = g$


END FUNCTION

FUNCTION Operation$ (B$)
SHARED peace$, fg, peaa$

d$ = fnm$(B$)
CLOSE : z = 1

ON ERROR GOTO 20
OPEN "R", 1, d$

1010 IF z <> LOF(1) / 128 + 1 THEN 1020
IF fg = 1 THEN
iferror:
FOR t = 1 TO 7: a$ = INKEY$: SOUND 900, .3: SOUND 700, .4: NEXT
g$ = ""
2 g$ = Nput$(12, 10, 14, 8, 25, g$)
IF g$ = "ESC" THEN Operation$ = "ESC": GOTO 1081
peace$ = Nput$(38, 10, 14, 8, 5, "")
IF peace$ = "ESC" THEN GOTO 2
g$ = g$ + SPACE$(25 - LEN(g$))
peace$ = peace$ + SPACE$(5 - LEN(peace$))
f$ = B$
CALL Save.New(f$, g$, peace$)
CLOSE : GOTO 1080 ': peace$ = "Already"
END IF

IF fg = 2 THEN
g$ = Pref$(B$)
IF g$ = "" THEN GOTO iferror
peace$ = peaa$
peace$ = peace$ + SPACE$(5 - LEN(peace$))
f$ = B$ + SPACE$(5 - LEN(B$))
CLOSE : GOTO 1080
END IF


1020 FIELD #1, 3 AS e$, 5 AS f$, 25 AS g$, 5 AS peace$
GET #1, z
IF e$ <> "999" THEN z = z + 1: GOTO 1010
IF LEFT$(f$, LEN(B$)) = B$ THEN 1080
z = z + 1
GOTO 1010
1080

' CALL printer(12, 10, g$, 15, 8): CALL printer(38, 10, peace$, 15, 8)

Operation$ = g$
1081

END FUNCTION

SUB Options
SHARED fg, savetext, fgg, Erre$, pathes$()
CALL winssc(13, 6, 37, 20)
CALL win(13, 6, 37, 20, 0, 15)':CALL win(13, 6, 37, 20, 0, 15):
IF pathes$(3) = "Not installed." THEN fg = 1: fgg = 1
LINE (12 * 8 + 3, 7 * 16 + 5)-(37 * 8 - 3, 20 * 16 - 3), 8, BF

'CALL printer(20, 7, "* Options *", 9, 15)
CALL printn(17, 93, "OPTIONS")
LINE (12 * 8, 7 * 16)-(37 * 8, 7 * 16), 0
LINE (12 * 8, 7 * 16 + 2)-(37 * 8, 7 * 16 + 2), 0
DIM d$(8)

d$(1) = "LFZ base "
d$(2) = "LFZ price "
d$(3) = "Save in Text"
d$(4) = "#@"
d$(5) = "England "
d$(6) = "Russian "
d$(7) = "Sculpture "
d$(8) = "Figure "
i = 1
WHILE i <> 0
IF fg = 1 THEN c1 = 2 ELSE c1 = 1
IF fgg = 1 THEN c2 = 2 ELSE c2 = 1
IF savetext = 1 THEN c3 = 2 ELSE c3 = 1
IF Erre$ = "/BASE_94/" THEN c5 = 3 ELSE c5 = 4
IF Erre$ = "/RUSSIAN/" THEN c6 = 3 ELSE c6 = 4
IF Erre$ = "/BASE_94/SK/" THEN c7 = 3 ELSE c7 = 4
IF Erre$ = "/RUSSIAN/SK/" THEN c8 = 3 ELSE c8 = 4
d$(4) = "#@"
CALL ON.OFF(15, 11, c1)
CALL ON.OFF(15, 12, c2)
CALL ON.OFF(15, 13, c3)

CALL ON.OFF(15, 15, c5)
CALL ON.OFF(15, 16, c6)
CALL ON.OFF(15, 17, c7)
CALL ON.OFF(15, 18, c8)



i = Orange.menu(19, 9, d$(), 8, 0, 7, 7, 0, 15, 15, i)


IF i = 1 THEN IF fg = 2 THEN fg = 1 ELSE fg = 2
IF i = 2 THEN IF fgg = 2 THEN fgg = 1 ELSE fgg = 2
IF i = 3 THEN IF savetext = 2 THEN savetext = 1 ELSE savetext = 2
IF pathes$(3) = "Not installed." THEN fg = 1: fgg = 1

IF i = 5 THEN Erre$ = "/BASE_94/"
IF i = 6 THEN Erre$ = "/RUSSIAN/"
IF i = 7 THEN Erre$ = "/BASE_94/SK/"
IF i = 8 THEN Erre$ = "/RUSSIAN/SK/"
WEND
CALL winlsc(13, 6)
END SUB

SUB Options2
SHARED bal
CALL winssc(13, 6, 37, 20)
CALL win(13, 6, 37, 20, 0, 15)':CALL win(13, 6, 37, 20, 0, 15):

LINE (12 * 8 + 3, 7 * 16 + 5)-(37 * 8 - 3, 20 * 16 - 3), 8, BF

CALL printn(17, 93, "BALANCE")
LINE (12 * 8, 7 * 16)-(37 * 8, 7 * 16), 0
LINE (12 * 8, 7 * 16 + 2)-(37 * 8, 7 * 16 + 2), 0
DIM d$(8)
d$(1) = "Balance "
d$(2) = "#@"
d$(3) = "Only A "
d$(4) = "Only B "
d$(5) = "Only C "
d$(6) = "#@"
d$(7) = "A and C "
d$(8) = "B and C "

IF bal <> 0 THEN c1 = 1 ELSE c1 = 2
IF bal = 1 THEN c2 = 3 ELSE c2 = 4
IF bal = 2 THEN c3 = 3 ELSE c3 = 4
IF bal = 3 THEN c4 = 3 ELSE c4 = 4
IF bal = 4 THEN c5 = 3 ELSE c5 = 4
IF bal = 5 THEN c6 = 3 ELSE c6 = 4

CALL ON.OFF(15, 11, c1)
CALL ON.OFF(15, 13, c2)
CALL ON.OFF(15, 14, c3)
CALL ON.OFF(15, 15, c4)
CALL ON.OFF(15, 17, c5)
CALL ON.OFF(15, 18, c6)


i = Orange.menu(19, 9, d$(), 8, 0, 7, 7, 0, 15, 15, 1)
IF i = 1 THEN IF bal <> 0 THEN bal = 0 ELSE bal = 1
IF i = 3 THEN bal = 1
IF i = 4 THEN bal = 2
IF i = 5 THEN bal = 3
IF i = 7 THEN bal = 4
IF i = 8 THEN bal = 5

CALL winlsc(13, 6)

END SUB

SUB Options3
SHARED Active, NAME$()
CALL winssc(13, 6, 37, 20)
CALL win(13, 6, 37, 20, 0, 15)':CALL win(13, 6, 37, 20, 0, 15):

LINE (12 * 8 + 3, 7 * 16 + 5)-(37 * 8 - 3, 20 * 16 - 3), 8, BF

CALL printn(17, 93, "WINDOW")
LINE (12 * 8, 7 * 16)-(37 * 8, 7 * 16), 0
LINE (12 * 8, 7 * 16 + 2)-(37 * 8, 7 * 16 + 2), 0
DIM d$(8)
FOR t = 1 TO 8
d$(t) = LTRIM$(STR$(t)) + " " + NAME$(t) + SPACE$(14 - LEN(NAME$(t)))
NEXT
IF Active = 1 THEN c1 = 3 ELSE c1 = 4
IF Active = 2 THEN c2 = 3 ELSE c2 = 4
IF Active = 3 THEN c3 = 3 ELSE c3 = 4
IF Active = 4 THEN c4 = 3 ELSE c4 = 4
IF Active = 5 THEN c5 = 3 ELSE c5 = 4
IF Active = 6 THEN c6 = 3 ELSE c6 = 4
IF Active = 7 THEN c7 = 3 ELSE c7 = 4
IF Active = 8 THEN c8 = 3 ELSE c8 = 4

CALL ON.OFF(15, 11, c1)
CALL ON.OFF(15, 12, c2)
CALL ON.OFF(15, 13, c3)
CALL ON.OFF(15, 14, c4)
CALL ON.OFF(15, 15, c5)
CALL ON.OFF(15, 16, c6)
CALL ON.OFF(15, 17, c7)
CALL ON.OFF(15, 18, c8)

i = Orange.menu(19, 9, d$(), 8, 0, 7, 7, 0, 15, 15, 1)
IF i = 0 THEN i = Active
Active = i
CALL winlsc(13, 6)


END SUB

FUNCTION Orange.main.menu (m$(), n!, n(), title$)
SHARED midlesubg
x1 = 19: y1 = 9: fg = 0: BG = 7: barFG = 7: barBG = 0: LFG = 15: LbarFG = 15
s! = LEN(m$(1))
CALL winssc(13, 6, 23 + s!, 9 + n + 3)
CALL win(13, 6, 23 + s!, 9 + n + 3, 0, 15)
IF midlesubg = 0 THEN midlesubg = 1
g = midlesubg
LINE (12 * 8, 7 * 16)-((23 + s!) * 8, 7 * 16), 0
LINE (12 * 8, 7 * 16 + 2)-((23 + s!) * 8, 7 * 16 + 2), 0

LINE (12 * 8 + 3, 7 * 16 + 5)-((23 + s!) * 8 - 3, (12 + n) * 16 - 3), 8, BF
CALL printn(14, 93, title$)

FOR t = 1 TO n
IF m$(t) <> "#@" THEN CALL ON.OFF(15, 10 + t, 4)
NEXT

CALL win(x1!, y1!, x1! + s! + 1, y1! + n! + 2, fg!, BG!)
dd! = x1! + 2

FOR t! = 1 TO n!
IF m$(t!) = "#@" THEN CALL printer(x1! + 2, y1! + 1 + t!, STRING$(s! - 2, CHR$(196)), fg!, BG!) ELSE CALL printer(x1! + 1, y1! + 1 + t!, m$(t!), fg!, BG!): CALL printer(x1! + 1, y1! + 1 + t!, MID$(m$(t!), 1, 1), LFG!, BG!)
NEXT
'g! = 1
GOSUB Q14
Main4: a$ = INKEY$
IF PEN(3) = -1 THEN GOTO pens4
IF a$ = CHR$(0) + CHR$(80) OR a$ = " " THEN GOSUB Q24: g! = g! + 1: GOSUB Q14
IF a$ = CHR$(0) + CHR$(72) THEN GOSUB Q24: g! = g! - 1: GOSUB Q14
IF a$ = CHR$(27) THEN g = 0: GOTO ok4
IF a$ = CHR$(13) THEN GOTO ok4

GOTO Main4
Q14:
GOSUB ERRors4
CALL printer(x1! + 1, y1! + 1 + g!, m$(g!), barFG!, barBG!)
CALL printer(x1! + 1, y1! + 1 + g!, MID$(m$(g!), 1, 1), LbarFG!, barBG!)
CALL picture(15, 10 + g, n(g))
RETURN

Q24:
GOSUB ERRors4
CALL printer(x1! + 1, y1! + 1 + g!, m$(g!), fg!, BG!)
CALL printer(x1! + 1, y1! + 1 + g!, MID$(m$(g!), 1, 1), LFG!, BG!)

CALL ON.OFF(15, 10 + g, 4)
RETURN


ERRors4:
IF g! < 0 OR g! = 0 THEN g! = n!
IF g! > n! THEN g! = 1
IF m$(g!) = "#@" THEN
IF a$ = CHR$(0) + CHR$(80) THEN g! = g! + 1
IF a$ = CHR$(0) + CHR$(72) THEN g! = g! - 1
END IF

RETURN
pens4: WHILE PEN(3) = -1
kk! = k!
k! = INT(PEN(8) / 2)
IF k! <> kk! THEN
GOSUB ERRors4
GOSUB Q24
IF kk! < k! THEN a$ = CHR$(0) + CHR$(80): g! = g! + 1
IF kk! > k! THEN a$ = CHR$(0) + CHR$(72): g! = g! - 1
GOSUB ERRors4: GOSUB Q14
END IF
WEND


ok4:
CALL winlsc(13, 6)
Orange.main.menu = g!
midlesubg = g
END FUNCTION

FUNCTION Orange.menu (x1!, y1!, m$(), n!, fg!, BG!, barFG!, barBG!, LFG!, LbarFG!, i!)
g! = i!
s! = LEN(m$(1))
'CALL WinSsc(x1!, y1!, x1! + s! + 1, y1! + n! + 2)
CALL win(x1!, y1!, x1! + s! + 1, y1! + n! + 2, fg!, BG!)
dd! = x1! + 2

FOR t! = 1 TO n!
IF m$(t!) = "#@" THEN CALL printer(x1! + 2, y1! + 1 + t!, STRING$(s! - 2, CHR$(196)), fg!, BG!) ELSE CALL printer(x1! + 1, y1! + 1 + t!, m$(t!), fg!, BG!): CALL printer(x1! + 1, y1! + 1 + t!, MID$(m$(t!), 1, 1), LFG!, BG!)
NEXT
'g! = 1
GOSUB Q12
Main2: a$ = INKEY$
IF PEN(3) = -1 THEN GOTO pens
IF a$ = CHR$(0) + CHR$(80) OR a$ = " " THEN GOSUB Q22: g! = g! + 1: GOSUB Q12
IF a$ = CHR$(0) + CHR$(72) THEN GOSUB Q22: g! = g! - 1: GOSUB Q12
IF a$ = CHR$(27) THEN g = 0: GOTO ok2
IF a$ = CHR$(13) THEN GOTO ok2

GOTO Main2
Q12:
GOSUB ERRors2
CALL printer(x1! + 1, y1! + 1 + g!, m$(g!), barFG!, barBG!)
CALL printer(x1! + 1, y1! + 1 + g!, MID$(m$(g!), 1, 1), LbarFG!, barBG!)
RETURN

Q22:
GOSUB ERRors2
CALL printer(x1! + 1, y1! + 1 + g!, m$(g!), fg!, BG!)
CALL printer(x1! + 1, y1! + 1 + g!, MID$(m$(g!), 1, 1), LFG!, BG!)

RETURN


ERRors2:
IF g! < 0 OR g! = 0 THEN g! = n!
IF g! > n! THEN g! = 1
IF m$(g!) = "#@" THEN
IF a$ = CHR$(0) + CHR$(80) THEN g! = g! + 1
IF a$ = CHR$(0) + CHR$(72) THEN g! = g! - 1
END IF

RETURN
pens: WHILE PEN(3) = -1
kk! = k!
k! = INT(PEN(8) / 2)
IF k! <> kk! THEN
GOSUB ERRors2
GOSUB Q22
IF kk! < k! THEN a$ = CHR$(0) + CHR$(80): g! = g! + 1
IF kk! > k! THEN a$ = CHR$(0) + CHR$(72): g! = g! - 1
GOSUB ERRors2: GOSUB Q12
END IF
WEND


ok2:
Orange.menu = g!
'CALL WinLsc(x1!, y1!)
END FUNCTION

SUB pauses
SHARED inx, iny
'FOR t = 1000 TO 2100 STEP 10: SOUND t, .1: NEXT
'FOR t = 2100 TO 1000 STEP -10: SOUND t, .1: NEXT

'FOR t = 1 TO 7: a$ = INKEY$: SOUND 900, .3: SOUND 700, .4: NEXT
WHILE INKEY$ = ""
IF PEN(3) = -1 THEN CALL mouses: CALL sorting2
WEND
END SUB

SUB picture (x, y, s)
SHARED buton()
DIM f(23)
f = (s - 1) * 22 + s
f2 = f + 22
FOR t = f TO f2
f(h) = buton(t)
h = h + 1
NEXT
CALL ON.OFF(x, y, 4)
PUT ((x - 1) * 8 + 2, (y - 1) * 16 + 2), f

END SUB

FUNCTION Pref$ (B$)
SHARED peaa$
d$ = j$(B$)
CLOSE : z = 1
ON ERROR GOTO 20
OPEN "R", 1, d$
10110 IF z <> LOF(1) / 128 + 1 THEN 10210
'LOCATE 12, 7: PRINT "Press any key..": CALL pauses
CLOSE : GOTO Newks

10210 FIELD #1, 2 AS e$, 5 AS k$, 25 AS g$, 4 AS Pea$

GET #1, z
IF e$ <> "##" THEN z = z + 1: GOTO 10110


IF MID$(k$, 1, LEN(B$)) = MID$(B$, 1, LEN(B$)) THEN 10810

z = z + 1
GOTO 10110
10810

GOTO Newks
xxx = 0

1 'CALL pauses
z = z + 1: m = m + 1
IF m > 1 AND sqw = 1 THEN COLOR 7: COLOR 23: LOCATE 12, 7: PRINT "N_ have one more name .": COLOR 7: ' CALL Pause:
IF m > 1 AND sqw = 2 THEN LOCATE 12, 7: PRINT "N_ have one more name !": 'CALL Pause:
GOTO 10110
Newks:
Pref$ = g$
peaa$ = Pea$
END FUNCTION

FUNCTION Pricce$ (B$)
d$ = qn$(B$)
CLOSE #2: z = 1
OPEN "R", 2, d$
10107 IF z <> LOF(2) / 128 + 1 THEN 10207
CLOSE #2: GOTO Nek
10207 FIELD #2, 2 AS e$, 5 AS k$, 9 AS g$
GET #2, z
IF e$ <> "##" THEN z = z + 1: GOTO 10107

IF MID$(k$, 1, LEN(k$)) = MID$(B$, 1, LEN(k$)) THEN 10807

z = z + 1
GOTO 10107
10807
'LOCATE 5, 7: PRINT "Page #"; z, "Art - "; k$
'PRINT
GOTO Nek 'g$
xxx = 0
z = z + 1: m = m + 1
'IF m > 1 AND sqw = 1 THEN COLOR 7: COLOR 23: LOCATE 12, 7: PRINT "N_ have one more name .": COLOR 7: CALL Pause: ' CLS
'IF m > 1 AND sqw = 2 THEN LOCATE 12, 7: PRINT "N_ have one more name !": CALL Pause: ' CLS
GOTO 10107
Nek:

Pricce$ = g$
END FUNCTION

SUB printer (x1!, y1!, s$, fg!, BG!)
DIM a!(1900)
IF s$ = CHR$(1) OR s$ = CHR$(32) THEN LINE ((x1! - 1) * 8, (y1! - 1) * 16)-(x1! * 8, y1! * 16 - 1), BG!, BF: GOTO Printers
IF s$ = CHR$(2) THEN LINE ((x1! - 1) * 8, (y1! - 1) * 16)-(x1! * 8, y1! * 16 - 1), BG!, BF: LINE ((x1! - 1) * 8, y1! * 16 - 4)-(x1! * 8 - 1, y1! * 16 - 2), fg!, B: GOTO Printers
fgg! = ABS(fg! - BG!)
COLOR fgg!: LOCATE y1!, x1!: PRINT s$
GET ((x1! - 1) * 8, (y1! - 1) * 16)-((x1! + LEN(s$) - 1) * 8, y1! * 16 - 1), a!
PUT ((x1! - 1) * 8, (y1! - 1) * 16), a!
LINE ((x1! - 1) * 8, (y1! - 1) * 16)-((x1! + LEN(s$) - 1) * 8, y1! * 16 - 1), BG!, BF
PUT ((x1! - 1) * 8, (y1! - 1) * 16), a!
LINE ((x1! + LEN(s$) - 1) * 8, (y1! - 1) * 16)-((x1! + LEN(s$) - 1) * 8, y1! * 16 - 1), BG!
Printers:

END SUB

SUB printn (x1, y1, st$)
xl = (x1 - 1) * 10
xr = 10
FOR t = 0 TO LEN(st$) - 1
xl = xl + xr
CALL wc((x1 - 1) * 10 + t * 10 - 1, y1, MID$(st$, t + 1, 1))
NEXT
END SUB

SUB pro (x, y, sp$, BG)
LINE ((x - 1) * 8, (y - 1) * 16)-((x + LEN(sp$)) * 8, y * 16), BG, BF

END SUB

FUNCTION qn$ (B$)
SHARED pathes$()
'k$ = "C:/qb/base/B2"
k$ = pathes$(3)
IF LEN(B$) = 5 THEN path$ = k$ + "/n5/h" + MID$(B$, 3, 1) + "/" + MID$(B$, 5, 1) + ".vol": GOTO yl
IF LEN(B$) = 4 THEN path$ = k$ + "/n4/h" + MID$(B$, 3, 1) + "/" + MID$(B$, 4, 1) + ".vol": GOTO yl
IF LEN(B$) = 3 THEN path$ = k$ + "/n3/h" + MID$(B$, 3, 1) + "/"
IF LEN(B$) = 2 THEN path$ = k$ + "/n2/h" + MID$(B$, 2, 1) + "/"
IF LEN(B$) = 1 THEN path$ = k$ + "/n1/"

l$ = LEFT$(B$, 1)
path$ = path$ + l$ + ".vol"
yl:
qn$ = path$



END FUNCTION

FUNCTION Ren.menu (m$(), n, fg!, BG!, barFG!, barBG!, LFG!, LbarFG!)
s = LEN(m$(1))
ss = 2 + x1! + s * n + n * 3
DIM a!(1500)

GET (0, 0)-(79 * 8, 16), a!
LINE (0, 16)-(632, 16), barFG!
dd! = x1! + 2
CALL printer(1, 1, SPACE$(79), fg!, BG!)
FOR t = 1 TO n!
CALL printer(dd!, 1, m$(t), fg!, BG!)
CALL printer(dd!, 1, MID$(m$(t), 1, 1), LFG!, BG!)
dd! = dd! + s! + 3
NEXT
g! = 1
GOSUB Q13
Main3: a$ = INKEY$
IF a$ = CHR$(0) + CHR$(77) OR a$ = " " THEN GOSUB Q23: g! = g! + 1: GOSUB Q13
IF a$ = CHR$(0) + CHR$(75) THEN GOSUB Q23: g! = g! - 1: GOSUB Q13
IF a$ = CHR$(13) THEN GOTO ok3

GOTO Main3
Q13:
GOSUB ERRORS3
CALL printer(x1! + s! * (g! - 1) + 2 + 3 * (g! - 1), 1, m$(g), barFG!, barBG!)
CALL printer(x1! + s! * (g! - 1) + 2 + 3 * (g! - 1), 1, MID$(m$(g), 1, 1), LbarFG!, barBG!)
RETURN

Q23:
GOSUB ERRORS3
CALL printer(x1! + s! * (g! - 1) + 2 + 3 * (g! - 1), 1, m$(g), fg!, BG!)
CALL printer(x1! + s! * (g! - 1) + 2 + 3 * (g! - 1), 1, MID$(m$(g), 1, 1), LFG!, BG!)

RETURN


ERRORS3:
IF g < 0 OR g = 0 THEN g = n
IF g > n THEN g = 1
RETURN
ok3:
Ren.menu = g
PUT (0, 0), a!, PSET
END FUNCTION

SUB Save.New (f$, C$, p$)
d$ = fnm$(f$)
CLOSE
OPEN "R", 1, d$: z = 1
FIELD #1, 3 AS e$, 5 AS k$, 25 AS g$, 5 AS peace$
3800 GET #1, z
IF e$ = "999" THEN z = z + 1: IF z = LOF(1) / 128 + 1 THEN GOTO A4 ELSE 3800
A4:
LSET k$ = f$
LSET g$ = C$
LSET e$ = "999"
LSET peace$ = p$
PUT #1, z
CLOSE

END SUB

SUB SCREEN.saver
SHARED pathes$(), y(), ch$(), fg, fgg, Active, Amount(), bal, layout, NAME$(), Erre$
OPEN "nbase.set" FOR OUTPUT AS #8
FOR t = 1 TO 3: PRINT #8, pathes$(t): NEXT
PRINT #8, " 1"
CLOSE #8
OPEN pathes$(1) + "nbase2.set" FOR OUTPUT AS #8

PRINT #8, Active

FOR i = 1 TO 8
PRINT #8, y(i)
PRINT #8, Amount(i)
FOR t = 1 TO y(i)
PRINT #8, ch$(t, i)
NEXT
NEXT

PRINT #8, fg
PRINT #8, fgg
PRINT #8, bal
PRINT #8, layout
FOR t = 1 TO 8
PRINT #8, NAME$(t)
NEXT
PRINT #8, Erre$
CLOSE #8


CHAIN "c:qbprogplanet2.bas"

END SUB

SUB Scroll
SHARED ch$(), y(), Amount(), nbasex, nbasey, Active
Current = y(Active)
DIM r(6)
r(1) = 1: r(2) = 7: r(3) = 33: r(4) = 39: r(5) = 48: r(6) = 57
g = 1
y = Current + 1: GOSUB Scrolli
GOSUB Scr2
Retto: a$ = INKEY$
IF a$ = CHR$(0) + CHR$(80) THEN GOSUB Scr1: y! = y! + 1: GOSUB Screrr2: GOSUB Scrolli: GOSUB Scr2
IF a$ = CHR$(0) + CHR$(72) THEN GOSUB Scr1: y! = y! - 1: GOSUB Screrr2: GOSUB Scrolli: GOSUB Scr2
IF a$ = CHR$(0) + CHR$(77) THEN GOSUB Scr1: g! = g! + 1: GOSUB Screrr: GOSUB Scr2
IF a$ = CHR$(0) + CHR$(75) THEN GOSUB Scr1: g! = g! - 1: GOSUB Screrr: GOSUB Scr2
IF a$ = CHR$(13) THEN GOSUB Scr1: y = Current: GOSUB Scrolli: GOTO Endscroll
IF a$ = CHR$(8) THEN
GOSUB Scr1
IF g = 1 THEN
CALL printer(nbasex + r(g), nbasey + 3, RTRIM$(MID$(ch$((y - 1), Active), r(g), 5)), 14, 8): i$ = Nput2$(nbasex + r(g), nbasey + 3, 14, 8, 5, RTRIM$(MID$(ch$((y - 1), Active), r(g), 5))): CALL printer(nbasex + r(g), nbasey + 3, i$, 15, 8)
MID$(ch$((y - 1), Active), 1) = i$ + SPACE$(5 - LEN(i$))
END IF

IF g = 2 THEN
CALL printer(nbasex + r(g), nbasey + 3, RTRIM$(MID$(ch$((y - 1), Active), r(g), 24)), 14, 8): i$ = Nput2$(nbasex + r(g), nbasey + 3, 14, 8, 24, RTRIM$(MID$(ch$((y - 1), Active), r(g), 24))): CALL printer(nbasex + r(g), nbasey + 3, i$, 15, 8)
MID$(ch$((y - 1), Active), 7) = i$ + SPACE$(24 - LEN(i$))
END IF

IF g = 3 THEN
CALL printer(nbasex + r(g), nbasey + 3, RTRIM$(MID$(ch$((y - 1), Active), r(g), 6)), 14, 8): i$ = Nput2$(nbasex + r(g), nbasey + 3, 14, 8, 6, RTRIM$(MID$(ch$((y - 1), Active), r(g), 6))): CALL printer(nbasex + r(g), nbasey + 3, i$, 15, 8)
MID$(ch$((y - 1), Active), 33) = i$ + SPACE$(6 - LEN(i$))
END IF

IF g = 4 THEN
Amold = VAL(MID$(ch$((y - 1), Active), 57, 8))
CALL printer(nbasex + r(g), nbasey + 3, RTRIM$(MID$(ch$((y - 1), Active), r(g), 8)), 14, 8): i$ = Nput2$(nbasex + r(g), nbasey + 3, 14, 8, 8, RTRIM$(MID$(ch$((y - 1), Active), r(g), 8))): CALL printer(nbasex + r(g), nbasey + 3, i$, 15, 8)
MID$(ch$((y - 1), Active), 39) = i$ + SPACE$(8 - LEN(i$))
Qty = VAL(MID$(ch$((y - 1), Active), 39, 8))
Price = VAL(MID$(ch$((y - 1), Active), 48, 8))
Am = Qty * Price
Amo$ = RIGHT$(STR$(Am), LEN(STR$(Am)) - 1)
MID$(ch$((y - 1), Active), 57) = LTRIM$(Amo$) + SPACE$(8 - LEN(Amo$))
Amount(Active) = Amount(Active) - Amold + Am
GOSUB Scrolli
END IF

IF g = 5 THEN
Amold = VAL(MID$(ch$((y - 1), Active), 57, 8))
CALL printer(nbasex + r(g), nbasey + 3, RTRIM$(MID$(ch$((y - 1), Active), r(g), 8)), 14, 8): i$ = Nput2$(nbasex + r(g), nbasey + 3, 14, 8, 8, RTRIM$(MID$(ch$((y - 1), Active), r(g), 8))): CALL printer(nbasex + r(g), nbasey + 3, i$, 15, 8)
MID$(ch$((y - 1), Active), 48) = i$ + SPACE$(8 - LEN(i$))
Qty = VAL(MID$(ch$((y - 1), Active), 39, 8))
Price = VAL(MID$(ch$((y - 1), Active), 48, 8))
Am = Qty * Price
Amo$ = RIGHT$(STR$(Am), LEN(STR$(Am)) - 1)
MID$(ch$((y - 1), Active), 57) = Amo$ + SPACE$(8 - LEN(Amo$))
Amount(Active) = Amount(Active) - Amold + Am
GOSUB Scrolli
END IF

IF g = 6 THEN
Amold = VAL(MID$(ch$((y - 1), Active), 57, 8))
CALL printer(nbasex + r(g), nbasey + 3, RTRIM$(MID$(ch$((y - 1), Active), r(g), 8)), 14, 8): i$ = Nput2$(nbasex + r(g), nbasey + 3, 14, 8, 8, RTRIM$(MID$(ch$((y - 1), Active), r(g), 8))): CALL printer(nbasex + r(g), nbasey + 3, i$, 15, 8)
MID$(ch$((y - 1), Active), 57) = i$ + SPACE$(8 - LEN(i$))
Am = VAL(i$)
Amo$ = RIGHT$(STR$(Am), LEN(STR$(Am)) - 1)
MID$(ch$((y - 1), Active), 57) = Amo$ + SPACE$(8 - LEN(Amo$))
Amount(Active) = Amount(Active) - Amold + Am
GOSUB Scrolli
END IF



GOSUB Scr2
END IF



GOTO Retto
Scr1:
CALL printer(nbasex + r(g), nbasey + 3, MID$(ch$((y - 1), Active), r(g), 1), 15, 8)
RETURN
Scr2:
CALL printer(nbasex + r(g), nbasey + 3, MID$(ch$((y - 1), Active), r(g), 1), 0, 15)
RETURN

Screrr:
IF g < 1 THEN g = 1
IF g > 6 THEN g = 6
RETURN
Screrr2:
IF y < 3 THEN y = 3
IF y > Current + 1 THEN y = Current + 1
RETURN




Scrolli:
CALL printer(nbasex + 57, nbasey + 7, STR$(Amount(Active)) + " ", 0, 15)
CALL printer(nbasex + 15, nbasey + 7, STR$(y - 2), 0, 15)
IF y >= 2 THEN
IF (y - 1) <> 1 THEN CALL printer(nbasex + 1, nbasey + 3, ch$(y - 1, Active) + SPACE$(68 - LEN(ch$(y - 1, Active))), 15, 8)
CALL printer(nbasex + 1, nbasey + 4, ch$(y, Active) + SPACE$(68 - LEN(ch$(y, Active))), 15, 8)
IF y >= Current THEN CALL pro(nbasex + 1, nbasey + 5, SPACE$(68), 8) ELSE CALL printer(nbasex + 1, nbasey + 5, ch$(y + 1, Active) + SPACE$(68 - LEN(ch$(y, Active))), 15, 8)
END IF
IF y = 1 THEN CALL pro(nbasex + 1, nbasey + 3, SPACE$(68), 9): CALL pro(nbasex + 1, nbasey + 4, SPACE$(68), 8)
RETURN

Endscroll:
END SUB

SUB Seven.up
SHARED Fil, Dir, Fil$(), Dir$(), Drive$, PathSpec$, NMerc$, mmm$
DIM ZXcur(1200)
Fil = Fil + 1
IF Fil <> 1 THEN u = 1

FOR t = 1 TO 10
LOCATE 5 + t, 6
IF t <= Dir THEN CALL printer(6, 5 + t, Dir$(t), 15, 8): CALL printer(6, 5 + t, MID$(Dir$(t), 1, 1), 14, 8) ELSE CALL printer(6, 5 + t, SPACE$(9), 15, 8)
NEXT

West46: ll = 1:
qnn = 0
FOR i = 11 TO 41 STEP 15
FOR y = 1 TO 11
IF qnn + y + nn = Fil THEN ll = 2
IF ll = 1 AND qnn + y + nn <> 0 THEN CALL printer(i + 10, y + 5, Fil$(qnn + y + nn), 15, 8) ELSE CALL printer(i + 10, y + 5, " ", 15, 8)

NEXT
qnn = qnn + 11
NEXT

GOSUB Q246
Start46: a$ = INKEY$
IF a$ <> "" AND MID$(a$, 1, 1) = CHR$(0) THEN
Merc$ = RTRIM$(MID$(Fil$(nn + u), 1, 8)) + "." + MID$(Fil$(nn + u), 10, 3)
END IF
IF a$ = CHR$(0) + CHR$(75) THEN nn = nn - 11: GOSUB ERRORS46: GOTO West46
IF a$ = CHR$(0) + CHR$(77) THEN nn = nn + 11: GOSUB ERRORS46: GOSUB er: GOTO West46
IF a$ = CHR$(0) + CHR$(72) THEN GOSUB Q146: u = u - 1: GOSUB er: GOSUB Q246: GOTO Start46
IF a$ = CHR$(0) + CHR$(80) THEN GOSUB Q146: u = u + 1: GOSUB er: GOSUB Q246: GOTO Start46
IF a$ = CHR$(27) THEN CALL DEF.usr2(3): NMerc$ = "": GOTO Stoping
IF a$ = CHR$(9) THEN
i = Autodir.Orange.menu(5, 4, Dir$(), 10, Dir, 15, 8, 1, 15, 14, 9)
i$ = Dir$(i)
IF mmm$ = "ESC" THEN CALL DEF.usr2(3): NMerc$ = "": GOTO Stoping
IF mmm$ = "TAB" THEN
FOR t = 1 TO 10
LOCATE 5 + t, 6
IF t <= Dir THEN CALL printer(6, 5 + t, Dir$(t), 15, 8): CALL printer(6, 5 + t, MID$(Dir$(t), 1, 1), 14, 8) ELSE CALL printer(6, 5 + t, SPACE$(9), 15, 8)
NEXT

GOTO Start46
END IF
IF MID$(i$, 1, 8) = ".. " THEN PathSpec$ = ClearSlash$(PathSpec$): Dir = 0: GOTO Stoping
PathSpec$ = PathSpec$ + RTRIM$(MID$(i$, 1, 8)) + ""
GOSUB Q246
GOTO Stoping
END IF
IF a$ = CHR$(13) AND u <> 0 THEN
NMerc$ = Drive$ + PathSpec$ + RTRIM$(MID$(Fil$(nn + u), 1, 8)) + "." + MID$(Fil$(nn + u), 10, 3)
CALL DEF.usr2(2)
GOTO Stoping
END IF
GOTO Start46
GOTO Stoping
'------------------------ Go to the SUBS ------------------------------
ERRORS46: IF nn < 0 THEN nn = 0
IF nn + u > Fil THEN nn = (Fil 11) * 11 - 11: BEEP
IF Fil = 1 AND a$ = CHR$(0) + CHR$(77) OR Fil < 11 AND a$ = CHR$(0) + CHR$(77) THEN nn = 0
RETURN
er: IF u < 1 THEN u = 1
IF u > 11 THEN u = 11
IF u > Fil - 1 - nn THEN u = Fil - 1 - nn

RETURN

Q146:
CALL printer(21, 5 + u, Fil$(nn + u), 15, 8)
RETURN

Q246:
CALL printer(21, 5 + u, Fil$(nn + u), 1, 15)
RETURN
Stoping:



END SUB

SUB sorting
SHARED mousex, mousey, nbasex, nbasey, nbasex2, nbasey2, y(), Active, nbwinss()
SHARED mouse1(), mouse2(), mouse3(), mouse4(), mouse5(), mouse6(), mouse7(), ch$(), Between$
x = mousex: y = mousey
IF x >= nbasex AND x <= nbasex + 69 AND y = nbasey THEN GOSUB Sort1
IF x >= 15 AND x <= 26 AND y = 27 THEN CALL Options
IF x >= 30 AND x <= 39 AND y = 27 THEN CALL file(1)
IF x >= 42 AND x <= 51 AND y = 27 THEN CALL file(2)
IF x >= 67 AND x <= 77 AND y = 27 THEN CALL file(3)
IF x >= 54 AND x <= 63 AND y = 27 THEN Between$ = "Next"
IF x = 1 + nbasex AND y = nbasey - 1 THEN PUT ((nbasex + 1) * 8, (nbasey - 1) * 16), mouse3, PSET: FOR t = 1 TO 50: SOUND 100, .1: NEXT: PUT ((nbasex + 1) * 8, (nbasey - 1) * 16), mouse2, PSET: CALL file(3)
IF x = 65 + nbasex AND y = nbasey - 1 THEN PUT ((nbasex + 65) * 8, (nbasey - 1) * 16), mouse5, PSET: FOR t = 1 TO 50: SOUND 100, .1: NEXT: Between$ = "Next": PUT ((nbasex + 65) * 8, (nbasey - 1) * 16), mouse4, PSET
IF x = 67 + nbasex AND y = nbasey - 1 THEN PUT ((nbasex + 66) * 8 + 4, (nbasey - 1) * 16), mouse7, PSET: FOR t = 1 TO 50: SOUND 100, .1: NEXT: Between$ = "Next DOWN": PUT ((nbasex + 66) * 8 + 4, (nbasey - 1) * 16), mouse6, PSET



GOTO Sortend
Sort1:
WHILE PEN(3) <> -1
WEND
DIM ds(15000)
WHILE PEN(3) = -1
nbasey = PEN(8) - 1
nbasex = PEN(4) 8
IF nbasex < 2 THEN nbasex = 2
IF nbasey < 1 THEN nbasey = 1
IF nbasex > 9 THEN nbasex = 9
IF nbasey > 21 THEN nbasey = 21


IF nbasex2 <> nbasex OR nbasey <> nbasey2 THEN
GET ((nbasex2 - 1) * 8 - 3, (nbasey2 - 1) * 16)-((nbasex2 + 70) * 8 + 5, (nbasey2 + 8) * 16 + 3), ds
PUT ((nbasex2 - 1) * 8 - 3, (nbasey2 - 1) * 16), nbwinss, PSET
'LINE ((nbasex2 - 1) * 8 - 3, (nbasey2 - 1) * 16)-((nbasex2 + 70) * 8 + 5, (nbasey2 + 8) * 16 + 3), 9, BF
GET ((nbasex - 1) * 8 - 3, (nbasey - 1) * 16)-((nbasex + 70) * 8 + 5, (nbasey + 8) * 16 + 3), nbwinss
PUT ((nbasex - 1) * 8 - 3, (nbasey - 1) * 16), ds, PSET
nbasex2 = nbasex: nbasey2 = nbasey
END IF
WEND
RETURN


Sortend:
END SUB

SUB sorting2
SHARED mousex, mousey, inx, iny, inx2, iny2, y(), Active, maxin, winss()
SHARED mouse1(), mouse2(), mouse3(), mouse4(), mouse5(), mouse6(), ch$()
x = mousex: y = mousey
IF x >= inx AND x <= inx + maxin AND y = iny THEN GOSUB Sort12
GOTO Sortend2
Sort12:
inx2 = inx: iny2 = iny
WHILE PEN(3) <> -1
WEND
DIM ds(3400)
WHILE PEN(3) = -1
iny = PEN(8) - 1
inx = PEN(4) 8
IF inx < 2 THEN inx = 2
IF iny < 1 THEN iny = 1
IF inx > 79 - maxin THEN inx = 79 - maxin
IF iny > 26 THEN iny = 26


IF inx2 <> inx OR iny <> iny2 THEN
GET ((inx2 - 1) * 8 - 2, (iny2 - 1) * 16 + 2)-((inx2 + maxin) * 8 + 2, (iny2 + 3) * 16 + 2), ds
PUT ((inx2 - 1) * 8 - 3, (iny2 - 1) * 16), winss, PSET
GET ((inx - 1) * 8 - 3, (iny - 1) * 16)-((inx + maxin) * 8 + 5, (iny + 3) * 16 + 3), winss
PUT ((inx - 1) * 8 - 2, (iny - 1) * 16 + 2), ds, PSET
inx2 = inx: iny2 = iny
END IF
WEND
RETURN
Sortend2:

END SUB

FUNCTION trans (C)
IF C = 60 THEN p = 129 '<
IF C = 62 THEN p = 158 '>
IF C = 123 THEN p = 149 '{
IF C = 125 THEN p = 154 '}
IF C = 58 THEN p = 134 ':
IF C = 59 THEN p = 157 '"

IF C = 65 THEN p = 148 'A
IF C = 66 THEN p = 136 'B
IF C = 67 THEN p = 145 'C
IF C = 68 THEN p = 130 'D
IF C = 69 THEN p = 147 'E
IF C = 70 THEN p = 128 'F
IF C = 71 THEN p = 143 'G
IF C = 72 THEN p = 144 'H
IF C = 73 THEN p = 152 'I
IF C = 74 THEN p = 142 'J
IF C = 75 THEN p = 139 'K
IF C = 76 THEN p = 132 'L
IF C = 77 THEN p = 156 'M
IF C = 78 THEN p = 146 'N TT
IF C = 79 THEN p = 153 'O
IF C = 80 THEN p = 135 'P
IF C = 81 THEN p = 137 'Q
IF C = 82 THEN p = 138 'R
IF C = 83 THEN p = 155 'S
IF C = 84 THEN p = 133 'T
IF C = 85 THEN p = 131 'U
IF C = 86 THEN p = 140 'V
IF C = 87 THEN p = 150 'W
IF C = 88 THEN p = 151 'X
IF C = 89 THEN p = 141 'Y
IF C = 90 THEN p = 159 'Z

IF C = 97 THEN p = 228 'a
IF C = 98 THEN p = 168 'b
IF C = 99 THEN p = 225 'c
IF C = 100 THEN p = 162 'd
IF C = 101 THEN p = 227 'e
IF C = 102 THEN p = 160 'f
IF C = 103 THEN p = 175 'g
IF C = 104 THEN p = 224 'h
IF C = 105 THEN p = 232 'i
IF C = 106 THEN p = 174 'j
IF C = 107 THEN p = 171 'k
IF C = 108 THEN p = 164 'l
IF C = 109 THEN p = 236 'm
IF C = 110 THEN p = 226 'n
IF C = 111 THEN p = 233 'o
IF C = 112 THEN p = 167 'p
IF C = 113 THEN p = 169 'q
IF C = 114 THEN p = 170 'r
IF C = 115 THEN p = 235 's
IF C = 116 THEN p = 165 't
IF C = 117 THEN p = 163 'u
IF C = 118 THEN p = 172 'v
IF C = 119 THEN p = 230 'w
IF C = 120 THEN p = 231 'x
IF C = 121 THEN p = 173 'y
IF C = 122 THEN p = 239 'z

IF C = 44 THEN p = 161 ',
IF C = 46 THEN p = 238 '.
IF C = 91 THEN p = 229 '[
IF C = 93 THEN p = 234 ']
IF C = 59 THEN p = 166 ';
IF C = 39 THEN p = 237 ''

IF p = 0 THEN p = C
trans = p

END FUNCTION

FUNCTION Trans.Price$ (Dol$)
Dol = VAL(Dol$)
Dol = Dol * 1.5 / 1560
d$ = STR$(Dol)
d$ = MID$(d$, 2, LEN(d$))


l$ = MID$(STR$(INT(Dol)), 2, LEN(STR$(INT(Dol))))
d = LEN(d$) - LEN(l$): IF d = 0 THEN GOTO EndS
f$ = MID$(d$, LEN(l$) + 1, d)

IF d > 3 THEN f$ = LEFT$(f$, 3)

EndS:
Trans.Price$ = l$ + f$

END FUNCTION

SUB wc (x1, y1, st$)
SHARED writa()
IF st$ <> "" THEN
s = ASC(st$)
IF s >= 32 AND s <= 90 THEN
DIM f(60)
s = s - 31
f = (s - 1) * 60 + s
f2 = f + 60

FOR t = f TO f2
f(h) = writa(t)
h = h + 1
NEXT

PUT (x1, y1), f, PRESET
END IF
END IF

END SUB

SUB win (x1!, y1!, x2!, y2!, fg!, BG!)
SHARED Shodow$
LINE ((x1! - 1) * 8 - 2, (y1! - 1) * 16 + 2)-(x2! * 8 + 2, y2! * 16 + 2), BG!, BF

LINE ((x1! - 1) * 8, (y1! - 1) * 16 + 4)-(x2! * 8, y2! * 16), fg!, B
LINE ((x1! - 1) * 8 - 2, (y1! - 1) * 16 + 2)-(x2! * 8 + 2, y2! * 16 + 2), fg!, B

END SUB

SUB winlsc (x1!, y1!)
SHARED winss()
PUT ((x1! - 1) * 8 - 2, (y1! - 1) * 16 + 1), winss, PSET
END SUB

SUB winssc (x1!, y1!, x2, y2)
SHARED winss()
GET ((x1! - 1) * 8 - 2, (y1! - 1) * 16 + 1)-(x2 * 8 + 2, y2 * 16 + 2), winss
END SUB


X
ПнВтСрЧтПтСбВс