Статьи

  Резюме
  [+] 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 Change.Desc.Top ()
DECLARE SUB First.Utility (n!)
DECLARE SUB Text.Editor ()
DECLARE SUB file (i!)
DECLARE SUB Printer ()
DECLARE FUNCTION Helpmenu! (x1!, y1!, Mag$, n!, nn!)
DECLARE SUB MErcan (x!, y!, n$)
DECLARE FUNCTION Dir.LIST$ ()
DECLARE FUNCTION LINE.INPUT$ ()
DECLARE SUB Gov (x!, y!, IS$)
DECLARE SUB Dialog.WINDOW ()
DECLARE SUB Balance ()
DECLARE SUB CodeLoop ()
DECLARE FUNCTION Trans.Price$ (Dol$)
DECLARE SUB Prices ()
DECLARE FUNCTION qn$ (B$)
DECLARE FUNCTION Pricce$ (B$)
DECLARE SUB Bases ()
DECLARE FUNCTION j$ (B$)
DECLARE FUNCTION Pref$ (B$)
DECLARE FUNCTION Poref! (B$)
DECLARE FUNCTION Intement$ (s$)
DECLARE SUB Dos.FUNCTION (B$)
DECLARE SUB Save.New (f$, c$, p$)
DECLARE SUB Pmw ()
DECLARE FUNCTION Pic.menu! ()
DECLARE SUB Spec.Small ()
DECLARE SUB Help.ON.Help ()
DECLARE SUB Help.Content ()
DECLARE SUB OFF.the.SYSTEM ()
DECLARE SUB Scu (y!, x!)
DECLARE SUB E.R ()
DECLARE SUB Magazine ()
DECLARE SUB Speed ()
DECLARE SUB New.WINDOW (x1!, y1!, x2!, y2!, n!)
DECLARE SUB Edit.ON.file ()
DECLARE SUB Scrolling (n!, x!, x2!, y!, y2!, Trot!)
DECLARE SUB Loading ()
DECLARE SUB Help.Index ()
DECLARE SUB Scur (y!, x!)
DECLARE SUB Scroll.READ ()
DECLARE FUNCTION Cletters$ (x!, y!)
DECLARE FUNCTION Set.LOC! (MP!, i!)
DECLARE FUNCTION Cletter! (x!, y!)
DECLARE FUNCTION Menu.Magazin! ()
DECLARE FUNCTION L.menu! (xl!, yl!, Mag$, m$(), n!)
DECLARE SUB NIT ()
DECLARE SUB Newk ()
DECLARE SUB Ssc2 ()
DECLARE SUB Lsc2 ()
DECLARE SUB Lwin (x1!, y1!, x2!, y2!)
DECLARE SUB Pause ()
DECLARE SUB file2 (n!)
DECLARE FUNCTION Ren.menu! (n$(), n!)
DECLARE FUNCTION Neo.menu! (x1!, y1!, Mag$, m$(), n!)
DECLARE FUNCTION makemenu! (xl!, yl!, m$(), n!)
DECLARE FUNCTION Smenu! (x1!, y1!, d$(), n!)
DECLARE FUNCTION nmakemenu! (xl!, yl!, m$(), n!)
DECLARE FUNCTION MNeo.menu! (x1!, y1!, Mag$, m$(), n!)
DECLARE FUNCTION ERen.menu! (n$(), n!)
DECLARE FUNCTION SSmenu! (x1!, y1!, d$(), n!)
DECLARE SUB Ssc ()
DECLARE SUB Lsc ()
DECLARE SUB wind (x1!, y1!, x2!, y2!)
DECLARE FUNCTION Nput$ (x!, y!)
DECLARE SUB Dialog.WINDOW ()
DECLARE SUB DEF.usr (n!)
DECLARE FUNCTION Orangemenu$ (x1!, y1!, Mag$, n!, nn!)
DECLARE FUNCTION ClearSlash$ (IS$)
DECLARE SUB Seven.up ()
DECLARE FUNCTION ClearSpace$ (IS$)
DECLARE SUB DEF.usr2 (n!)
DECLARE FUNCTION Autodir$ ()
DECLARE SUB Deystvie (x!, y!, q!, x1!)
DECLARE SUB Calculator ()
COMMON SHARED Active AS INTEGER
erre$ = "RUSSIAN"
DEF fnm$ (w$) = "C:qbBases" + erre$ + RIGHT$(STR$(ASC(MID$(w$, 3, 1))), LEN(STR$(ASC(w$))) - 1) + ".txt"
sqw = 2: fg = 2
SCREEN 2
DIM oper(168), vindov(700), vindov2(700), qa(14), qb(38), qc(24), qd(36), Calv$(60), Calv2$(60), Calv3(30)
Shodow$ = CHR$(85) + CHR$(170) + CHR$(85) + CHR$(170) + CHR$(85) + CHR$(170) + CHR$(85) + CHR$(170)
'CALL NIT
DIM ch$(500, 10), y(10), Amount(10), y$(6), gh(250), q$(5), bv$(5), adb$(6), c$(200), c2$(200), v(10), Edit$(200)
DIM ok(100), ZX(20), ZXerra$(20), ZXinf(5), OKZX(230), CANCELZX(230)
DIM Dir$(180), Fil$(180), Help$(30)
a$ = CHR$(239) + CHR$(223) + CHR$(191) + CHR$(127) + CHR$(127) + CHR$(143) + CHR$(243) + CHR$(125)
a1$ = CHR$(142) + CHR$(230) + CHR$(38) + CHR$(198) + CHR$(229) + CHR$(173) + CHR$(187) + CHR$(199)
PAINT (1, 1), a$ + a1$, 1
y(1) = 1: y(2) = 1: y(3) = 1: y(4) = 1: y(5) = 1: y(6) = 1: y(7) = 1: y(8) = 1: y(9) = 1: y(10) = 1
Active = 1

Beginer:

CALL First.Utility(0)
CALL Lwin(5, 5, 75, 11)
CALL wind(5, 5, 75, 6)
CALL Lwin(35, 18, 65, 20)
LOCATE 19, 36: PRINT "Итог "; Am
LOCATE 6, 6: PRINT "Арт. Название изделия Качество Цена Кол-во Сумма "
'CALL Ssc
'CALL Lwin(20, 8, 50, 15)
'LOCATE 9, 21: PRINT " Nwindows Nbase programs "
'LOCATE 11, 21: PRINT "Co by Nick Prevukhin 1994 "
'LOCATE 12, 21: PRINT " All Rights Reserved "
'LOCATE 14, 31: PRINT "OK"
' GET (29 * 8, 13 * 8)-(33 * 8, 14 * 8), ok
' PUT (29 * 8, 13 * 8), ok, PRESET
'SLEEP (2)
' PUT (29 * 8, 13 * 8), ok, PSET
' SOUND 100, .1
'CALL Lsc


KEY 3, "E-R " + CHR$(13): KEY 4, "Dialog " + CHR$(13)
KEY 1, "Help " + CHR$(13): KEY 5, "Load " + CHR$(13): KEY 8, "Sread " + CHR$(13)
KEY 2, "Edit " + CHR$(13): KEY 6, "Jump " + CHR$(13): KEY 9, "Quit " + CHR$(13)
KEY 10, "menu " + CHR$(13): KEY 7, "Save M " + CHR$(13)
GOSUB Spaces

FOR t = 1 TO 10
ch$(1, t) = "N_ Name of the goods Pcs. Price Q-ty Amount"
NEXT

10 LOCATE 10, 6: INPUT "", B$

IF B$ = "menu" OR B$ = "" OR B$ = "Menu" OR B$ = "MENU" OR B$ = "mENU" OR B$ = "0" THEN CALL file(0): GOTO 10
IF B$ = "Save M" THEN CALL file(1): GOTO 10
IF B$ = "Save T" THEN CALL file(2): GOTO 10
IF B$ = "Merge" THEN CALL file(3): GOTO Spaces
IF B$ = "Exit" OR B$ = "Quit" THEN CALL file(6): GOTO 10
IF B$ = "Help" THEN CALL Help.ON.Help: GOTO 10
IF B$ = "Mag" THEN B = Menu.Magazin: IF B$ = "" THEN GOTO 10
IF B$ = "Smag" THEN CALL Magazine: GOTO 10
IF B$ = "Speed" THEN CALL Speed: GOTO 10
IF B$ = "Newk" THEN CALL Newk: GOTO 10
IF B$ = "Space" THEN y(Active) = y(Active) + 1: LOCATE 10, 6: PRINT " ": ch$(y(Active), Active) = " ": GOTO Spaces
IF B$ = "Shell" THEN CALL Ssc: CLS : SCREEN 0: WIDTH 80: PRINT "Type EXIT to return to the N Base .. ": SHELL: SCREEN 2: CALL Lsc: LOCATE 10, 6: PRINT " ": GOTO 10
IF B$ = "Sread" THEN LOCATE 10, 6: PRINT " ": CALL Ssc: CALL Scroll.READ: CALL Lsc: GOTO Spaces
IF B$ = "View" THEN LOCATE 10, 6: PRINT " ": CALL Edit.ON.file: GOTO 10
IF B$ = "Edit" THEN LOCATE 10, 6: PRINT " ": CALL Text.Editor: GOTO 10
IF B$ = "Nc" THEN CALL Ssc: SCREEN 0: WIDTH 80: CLS : SHELL "C:NCNc": SCREEN 2: CALL Lsc: GOTO 10
IF B$ = "E-R" THEN CALL E.R: GOTO 10
IF B$ = "Change" THEN CALL Change.Desc.Top: IF yu56 = 56 THEN GOTO 10 ELSE GOTO Beginer
IF B$ = "Turn OFF" THEN CALL OFF.the.SYSTEM
IF B$ = "Context" THEN CALL Help.Content
IF B$ = "TO" THEN CALL Spec.Small
IF B$ = "Main" THEN CHAIN "C:qbnwindowswind.bas"
IF B$ = "Bases" THEN CALL Bases: LOCATE 10, 6: PRINT " ": GOTO 10
IF B$ = "Prices" THEN CALL Prices: LOCATE 10, 6: PRINT " ": GOTO 10
IF B$ = "Balance" THEN CALL Balance: LOCATE 10, 6: PRINT " ": GOTO 10
IF B$ = "Dialog" THEN CALL Ssc: CALL Dialog.WINDOW: CALL Lsc: LOCATE 10, 6: PRINT " ": GOTO 10
IF B$ = "Print" THEN CALL Printer
IF B$ = "Jump" THEN LOCATE 10, 6: PRINT " ": CALL First.Utility(1): GOTO Spaces
IF LEFT$(B$, 4) = "Dos " THEN CALL Dos.FUNCTION(B$): SCREEN 2: CALL Lsc: GOTO 10
IF LEFT$(B$, 1) = "B" THEN B$ = "1" + RIGHT$(B$, 4): xd = 78
IF MID$(B$, 3, 1) = " " OR MID$(B$, 3, 1) = "" THEN LOCATE 10, 6: PRINT " ": GOTO 10
IF LEFT$(B$, 4) = "Load" THEN
Subpath$ = ClearSpace$(MID$(B$, 6, 40))
CALL file(2): Subpath$ = "": GOTO Spaces
END IF

d$ = fnm$(B$)
'ON ERROR GOTO 920
CLOSE : z = 1
OPEN "R", 1, d$
IF LOF(1) = 0 THEN CALL Pmw: LOCATE 10, 6: PRINT " ": GOTO 2
1010 IF z <> LOF(1) / 128 + 1 THEN 1020

IF fg = 1 THEN
LOCATE 10, 12: INPUT "", g$: LOCATE 10, 38: INPUT "", peace$
g$ = g$ + SPACE$(25 - LEN(g$))
peace$ = peace$ + SPACE$(5 - LEN(peace$))
f$ = B$
CALL Save.New(f$, g$, peace$)
CLOSE : GOTO 1081
END IF

IF fg = 2 THEN
g$ = Pref$(B$)
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

LOCATE 10, 12: PRINT g$: LOCATE 10, 38: PRINT peace$

1081
IF LEN(g$) < 25 THEN g$ = g$ + SPACE$(25 - LEN(g$))
IF gff = 1 THEN Dol$ = Pricce$(B$): Dol$ = Trans.Price$(Dol$): IF Dol$ = "" THEN Dol$ = SPACE$(25) ELSE LOCATE 10, 44: PRINT Dol$: GOTO 1082

10815
LOCATE 10, 44: INPUT "", Dol$: LOCATE 10, 44: PRINT Dol$
IF balanc = 1 OR balanc = 4 OR balanc = 5 THEN Dol$ = Intement$(Dol$): LOCATE 10, 44: PRINT Dol$
1082
LOCATE 10, 53: INPUT "", Kol$
IF balanc = 2 OR balanc = 4 OR balanc = 6 THEN Kol$ = Intement$(Kol$): LOCATE 10, 53: PRINT Kol$

Dol3 = VAL(Dol$)
Vo = VAL(Kol$)
Summa$ = STR$(Vo * Dol3)
IF balanc = 3 OR balanc = 5 OR balanc = 6 THEN Summa$ = " " + Intement$(MID$(Summa$, 2, LEN(Summa$) - 1))
LOCATE 10, 61: PRINT Summa$
Amount(Active) = Amount(Active) + (Vo * Dol3)
'LOCATE 19, 36: PRINT Amount(Active); " "
y(Active) = y(Active) + 1
IF xd = 78 THEN f$ = "B" + RIGHT$(f$, 4): xd = 0
ch$(y(Active), Active) = f$ + SPACE$(5 - LEN(f$)) + " " + g$ + " " + peace$ + " " + Dol$ + SPACE$(9 - LEN(Dol$)) + Kol$ + SPACE$(8 - LEN(Kol$)) + Summa$

Spaces:
LOCATE 19, 36: PRINT "Итог "; Amount(Active); " "
IF y(Active) >= 2 THEN
IF (y(Active) - 1) <> 1 THEN LOCATE 8, 6: PRINT ch$(y(Active) - 1, Active) + SPACE$(68 - LEN(ch$(y(Active) - 1, Active)))
LOCATE 9, 6: PRINT ch$(y(Active), Active) + SPACE$(68 - LEN(ch$(y(Active), Active)))
LOCATE 10, 6: PRINT SPACE$(68)
END IF
IF y(Active) = 1 THEN LOCATE 8, 6: PRINT SPACE$(68): LOCATE 9, 6: PRINT SPACE$(68)
2
GOTO 10
12
920
SELECT CASE ERR
CASE 76: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " Path not found !"): SLEEP (4): CALL Lsc: RESUME 10
CASE 70: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " Disk write protect !"): SLEEP (4): CALL Lsc: RESUME 10
CASE 71: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " Disk not ready !"): SLEEP (4): CALL Lsc: RESUME 10
CASE 64: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " Bad filename !"): SLEEP (4): CALL Lsc: RESUME 10
CASE 57: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " Device I/O error "): SLEEP (4): CALL Lsc: RESUME 10
CASE 61: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " Disk full "): SLEEP (4): CALL Lsc: RESUME 10
CASE 53: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " File not found "): SLEEP (4): CALL Lsc: RESUME 10
CASE 27: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " Out of paper "): SLEEP (4): CALL Lsc: RESUME 10
CASE 25: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " Device fault "): SLEEP (4): CALL Lsc: RESUME 10
CASE ELSE: CALL Lwin(14, 13, 40, 15): CALL Gov(15, 14, " ERROR #" + STR$(ERR)): SLEEP (4): CALL Lsc: RESUME 10
END SELECT

FUNCTION Autodir$
SHARED Dir$(), Fil$(), PathSpec$, Drive$, Dir, Fil, NMerc$
CALL DEF.usr2(1)
Drive$ = "C:"

s2: path$ = Drive$ + PathSpec$ + "*.*"
SHELL "Dir " + path$ + " > c:qbTextNick1.twh"
OPEN "c:qbtextNick1.twh" FOR INPUT AS #9
FOR tgg = 1 TO 4: INPUT #9, a$: NEXT
a$ = " :"
WHILE MID$(a$, 36, 1) = ":"
INPUT #9, a$
IF MID$(a$, 36, 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
END FUNCTION

SUB Balance
SHARED balanc
REDIM gf$(7)
gf$(1) = " Отключить зту функцию "
gf$(2) = " Выравнивать - A"
gf$(3) = " Выравнивать - B"
gf$(4) = " Выравнивать - C"
gf$(5) = " Выравнивать - A & B"
gf$(6) = " Выравнивать - A & C"
gf$(7) = " Выравнивать - B & C"
balanc = makemenu(18, 7, gf$(), 7) - 1

END SUB

SUB Bases
SHARED fg
DIM gf$(3)
gf$(1) = " Nicks BASE "
gf$(2) = " LFZ BASE "
fg = Neo.menu(35, 9, " Базы ", gf$(), 2)
END SUB

SUB Calculator
SHARED Calv$(), Calv2$(), Calv3()
x = 32: y = 10: q = 1: x1 = x: y1 = y
Cal10:
Calv$(q) = INPUT$(1)
IF Calv$(q) = CHR$(27) THEN GOTO calesc
x = x + 1
s$ = s$ + Calv$(q)
IF x > x1 + 15 THEN x = x - 1: n = n + 1: LOCATE y, x1: PRINT MID$(s$, n, 15)
LOCATE y, x: PRINT Calv$(q)
IF Calv$(q) = CHR$(8) THEN x = x - LEN(Calv2$(q)): LOCATE y, x: PRINT " ": x = x - 1: Calv2$(q) = "": Calv$(q) = "": GOTO Cal10
IF Calv$(q) = CHR$(43) OR Calv$(q) = CHR$(45) OR Calv$(q) = CHR$(42) OR Calv$(q) = "/" THEN
IF Calv$(q) = "+" OR Calv$(q) = "-" THEN Calv3(q) = VAL(Calv2$(q)) ELSE Calv3(q) = &HB800
q = q + 1
GOTO Cal10
END IF

Calv2$(q) = Calv2$(q) + Calv$(q)
IF Calv$(q) = CHR$(13) THEN CALL Deystvie(x, y, q, x1): GOSUB Clearing: GOTO Cal10

GOTO Cal10

Clearing:
FOR t = 1 TO q + 2
Calv$(t) = "": Calv2$(t) = "": Calv3(t) = 0
NEXT
q = 1
x = x1: y = y1: s$ = ""
LOCATE y, x: PRINT " "
RETURN
calesc:
END SUB

SUB Change.Desc.Top
SHARED yu56
DIM Delfine$(11), Del2$(12)

Delfine$(1) = CHR$(155) + CHR$(155) + CHR$(155) + CHR$(199) + CHR$(255) + CHR$(131) + CHR$(159) + CHR$(131) + CHR$(251) + CHR$(131) + CHR$(255) + CHR$(131) + CHR$(155) + CHR$(131) + CHR$(155) + CHR$(255)
Delfine$(2) = CHR$(0) + CHR$(0) + CHR$(62) + CHR$(65) + CHR$(73) + CHR$(89) + CHR$(73) + CHR$(73) + CHR$(93) + CHR$(65) + CHR$(62) + CHR$(0) + CHR$(62) + CHR$(85) + CHR$(107) + CHR$(62)
Delfine$(3) = CHR$(231) + CHR$(218) + CHR$(218) + CHR$(219) + CHR$(219) + CHR$(219) + CHR$(218) + CHR$(230) + CHR$(254) + CHR$(231) + CHR$(219) + CHR$(219) + CHR$(219) + CHR$(230) + CHR$(254) + CHR$(254)
Delfine$(4) = CHR$(137) + CHR$(201) + CHR$(137) + CHR$(153) + CHR$(145) + CHR$(147) + CHR$(145) + CHR$(153) + CHR$(153) + CHR$(153) + CHR$(137) + CHR$(201) + CHR$(137) + CHR$(153) + CHR$(153) + CHR$(153)
Delfine$(5) = CHR$(239) + CHR$(223) + CHR$(191) + CHR$(127) + CHR$(127) + CHR$(143) + CHR$(243) + CHR$(125) + CHR$(142) + CHR$(230) + CHR$(38) + CHR$(198) + CHR$(229) + CHR$(173) + CHR$(187) + CHR$(199)
Delfine$(6) = CHR$(255) + CHR$(231) + CHR$(231) + CHR$(195) + CHR$(219) + CHR$(219) + CHR$(219) + CHR$(153) + CHR$(189) + CHR$(129) + CHR$(129) + CHR$(189) + CHR$(189) + CHR$(189) + CHR$(129) + CHR$(255)
Delfine$(7) = CHR$(255) + CHR$(255) + CHR$(255) + CHR$(231) + CHR$(231) + CHR$(231) + CHR$(129) + CHR$(231) + CHR$(231) + CHR$(199) + CHR$(231) + CHR$(227) + CHR$(231) + CHR$(231) + CHR$(195) + CHR$(129)
Delfine$(8) = CHR$(255) + CHR$(193) + CHR$(162) + CHR$(128) + CHR$(136) + CHR$(190) + CHR$(136) + CHR$(136) + CHR$(136) + CHR$(136) + CHR$(136) + CHR$(136) + CHR$(128) + CHR$(160) + CHR$(193) + CHR$(255)
Delfine$(9) = CHR$(255) + CHR$(255) + CHR$(255) + CHR$(231) + CHR$(195) + CHR$(153) + CHR$(153) + CHR$(153) + CHR$(129) + CHR$(195) + CHR$(231) + CHR$(227) + CHR$(231) + CHR$(225) + CHR$(225) + CHR$(231)
Delfine$(10) = CHR$(255) + CHR$(255) + CHR$(255) + CHR$(255) + CHR$(0) + CHR$(255) + CHR$(255) + CHR$(255) + CHR$(0) + CHR$(255) + CHR$(255) + CHR$(255) + CHR$(255) + CHR$(255) + CHR$(255) + CHR$(255)
Delfine$(11) = CHR$(254) + CHR$(253) + CHR$(251) + CHR$(247) + CHR$(239) + CHR$(223) + CHR$(191) + CHR$(127)
Del2$(1) = " USA ": Del2$(2) = " Shop #1 ": Del2$(3) = " Rings ": Del2$(4) = " Bear ": Del2$(5) = " Ear "
Del2$(6) = " Vodka ": Del2$(7) = " Religion #1": Del2$(8) = " Religion #2": Del2$(9) = " Keys ": Del2$(10) = " Classic #1 ": Del2$(11) = " Classic #2 ": Del2$(12) = "Exit menu "
CALL Ssc2: CLS
LOCATE 1, 1: PRINT " This function will change your Desctop. "
FOR t = 1 TO 11
LINE (t * 50, 12)-(t * 50 + 40, 52), 1, B
PAINT (t * 50 + 1, 13), Delfine$(t), 1
NEXT
LOCATE 9, 1: PRINT " USA #1 Rings Bear Ear Vodka Religion Keys Classic "
i = makemenu(30, 10, Del2$(), 12)
IF i = 0 OR i = 12 THEN yu56 = 56: CALL Lsc2: GOTO CDendsub
CLS
nx = 90: ny = 45
c = 2

LINE (110 + nx, 80 + ny)-(90 + nx, 130 + ny), c
LINE (115 + nx, 80 + ny)-(95 + nx, 130 + ny), c
LINE (160 + nx, 80 + ny)-(140 + nx, 130 + ny), c
LINE (165 + nx, 80 + ny)-(145 + nx, 130 + ny), c
LINE (115 + nx, 80 + ny)-(140 + nx, 130 + ny), c

LINE (110 + nx, 80 + ny)-(115 + nx, 80 + ny), c
LINE (160 + nx, 80 + ny)-(165 + nx, 80 + ny), c
LINE (140 + nx, 130 + ny)-(145 + nx, 130 + ny), c
LINE (90 + nx, 130 + ny)-(95 + nx, 130 + ny), c
PAINT (94 + nx, 129 + ny), 2, 2: PAINT (163 + nx, 82 + ny), 2, 2

LOCATE 20, 16: PRINT "Nick Computers Print corp"
LOCATE 15, 25: PRINT "Present ."
CIRCLE (130 + nx, 105 + ny), 110

PAINT (1, 1), Delfine$(i), 1
CDendsub:
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

FUNCTION ClearSpace$ (IS$)
FOR t = 1 TO 22
a$ = MID$(IS$, t, 1)
IF a$ <> " " THEN cl$ = cl$ + a$ ELSE GOTO Stopping3
NEXT
Stopping3:
ClearSpace$ = cl$


END FUNCTION

FUNCTION Cletters$ (x, y)
SHARED ch$(), Amount()
n$ = MID$(ch$(y, Active), 1, 6)
NAME$ = MID$(ch$(y, Active), 7, 25)
Pcs$ = MID$(ch$(y, Active), 33, 5)
Price$ = MID$(ch$(y, Active), 39, 8)
Qty$ = MID$(ch$(y, Active), 48, 8)
Amount$ = MID$(ch$(y, Active), 57, 9)
AAmount$ = Amount$

IF x = 1 THEN LOCATE 8, x + 5: INPUT "", nn$: n$ = nn$ + " "
IF x = 7 THEN LOCATE 8, x + 5: INPUT "", NName$: NAME$ = NName$ + SPACE$(25 - LEN(NName$))
IF x = 33 THEN LOCATE 8, x + 5: INPUT "", ppcs$: Pcs$ = ppcs$ + SPACE$(5 - LEN(ppcs$))
IF x = 39 THEN LOCATE 8, x + 5: INPUT "", PPric$: Price$ = PPric$ + SPACE$(8 - LEN(PPric$)): Summa = VAL(Price$) * VAL(Qty$): Amount$ = STR$(Summa) + SPACE$(9 - LEN(STR$(Summa))): Qty$ = MID$(Qty$, 1, LEN(Qty$) - 1): GOSUB y40
IF x = 48 THEN LOCATE 8, x + 5: INPUT "", QQty$: Qty$ = QQty$ + SPACE$(8 - LEN(QQty$)): Summa = VAL(Price$) * VAL(Qty$): Amount$ = STR$(Summa) + SPACE$(9 - LEN(STR$(Summa))): Qty$ = MID$(Qty$, 1, LEN(Qty$) - 1): GOSUB y40
IF x = 57 THEN LOCATE 8, x + 5: INPUT "", AAmount$: Amount$ = AAmount$ + SPACE$(9 - LEN(AAmount$))
ch$(y, Active) = n$ + NAME$ + " " + Pcs$ + " " + Price$ + " " + Qty$ + " " + Amount$

GOTO y50
y40:
Amount(Active) = Amount(Active) + (VAL(Amount$) - VAL(AAmount$))
LOCATE 19, 36: PRINT "Итог "; Amount(Active)
RETURN
y50:



END FUNCTION

SUB DEF.usr (n)
SHARED OKZX(), CANCELZX()
IF n = 1 THEN
CALL Lwin(10, 10, 35, 21)
LINE (34 * 8, 12 * 8)-(35 * 8 + 1, 16 * 8), 0, BF
LINE (34 * 8, 12 * 8)-(35 * 8 + 1, 16 * 8), 1, B


LOCATE 10, 12: PRINT "[" + CHR$(254) + "]": LOCATE 10, 32: PRINT "[" + CHR$(24) + "]"
LOCATE 19, 11: PRINT " OK Cancel"
OKx1 = 14 * 8 - 15: OKy1 = 19 * 8 - 11: OKx2 = 15 * 8 + 7: OKy2 = 19 * 8 + 2
LINE (OKx1, OKy1)-(OKx2, OKy2), 1, B
GET (OKx1 + 1, OKy1 + 1)-(OKx2 - 1, OKy2 - 1), OKZX
LINE (OKx1 + 5, OKy1 + 3)-(OKx2 + 5, OKy2 + 3), 1, B
PUT (OKx1 + 1, OKy1 + 1), OKZX, PRESET

CANx1 = 26 * 8 - 15: CANy1 = 19 * 8 - 11: CANx2 = 31 * 8 + 7: CANy2 = 19 * 8 + 2
LINE (CANx1, CANy1)-(CANx2, CANy2), 1, B
GET (CANx1 + 1, CANy1 + 1)-(CANx2 - 1, CANy2 - 1), CANCELZX
LINE (CANx1 + 5, CANy1 + 3)-(CANx2 + 5, CANy2 + 3), 1, B
PUT (CANx1 + 1, CANy1 + 1), CANCELZX, PRESET
END IF
IF n = 2 THEN
OKx1 = 14 * 8 - 15: OKy1 = 19 * 8 - 11: OKx2 = 15 * 8 + 7: OKy2 = 19 * 8 + 2
LINE (OKx1, OKy1)-(OKx2, OKy2), 0, BF
PUT (OKx1 + 6, OKy1 + 4), OKZX, PRESET
LINE (OKx1 + 5, OKy1 + 3)-(OKx2 + 5, OKy2 + 3), 1, B
SOUND 100, .1
SLEEP (1)
END IF

IF n = 3 THEN
CANx1 = 26 * 8 - 15: CANy1 = 19 * 8 - 11: CANx2 = 31 * 8 + 7: CANy2 = 19 * 8 + 2
LINE (CANx1, CANy1)-(CANx2, CANy2), 0, BF
PUT (CANx1 + 6, CANy1 + 4), CANCELZX, PRESET
LINE (CANx1 + 5, CANy1 + 3)-(CANx2 + 5, CANy2 + 3), 1, B
SOUND 100, .1
SLEEP (1)
END IF
END SUB

SUB DEF.usr2 (n)
SHARED OKZX(), CANCELZX()
IF n = 1 OR n = 11 THEN
CALL Lwin(4, 3, 65, 20)
LOCATE 4, 5: PRINT "Directories List of file names"
LINE (4 * 8 - 8, 4 * 8)-(65 * 8, 4 * 8)
LINE (4 * 8 - 8, 17 * 8)-(65 * 8, 17 * 8)
LINE (17 * 8, 3 * 8 - 4)-(17 * 8, 17 * 8)
LINE (17 * 8 + 2, 3 * 8 - 4)-(17 * 8 + 2, 17 * 8)

LOCATE 3, 6: PRINT "[" + CHR$(254) + "]": LOCATE 3, 56: PRINT "[" + CHR$(24) + "]"
IF n <> 11 THEN LOCATE 19, 5: PRINT " Load Cancel" ELSE LOCATE 19, 5: PRINT " Save Cancel"
OKx1 = 15 * 8 - 15: OKy1 = 19 * 8 - 11: OKx2 = 18 * 8 + 7: OKy2 = 19 * 8 + 2

LINE (OKx1, OKy1)-(OKx2, OKy2), 1, B
GET (OKx1 + 1, OKy1 + 1)-(OKx2 - 1, OKy2 - 1), OKZX
LINE (OKx1 + 5, OKy1 + 3)-(OKx2 + 5, OKy2 + 3), 1, B
PUT (OKx1 + 1, OKy1 + 1), OKZX, PRESET

CANx1 = 39 * 8 - 15: CANy1 = 19 * 8 - 11: CANx2 = 44 * 8 + 7: CANy2 = 19 * 8 + 2
LINE (CANx1, CANy1)-(CANx2, CANy2), 1, B
GET (CANx1 + 1, CANy1 + 1)-(CANx2 - 1, CANy2 - 1), CANCELZX
LINE (CANx1 + 5, CANy1 + 3)-(CANx2 + 5, CANy2 + 3), 1, B
PUT (CANx1 + 1, CANy1 + 1), CANCELZX, PRESET
END IF
IF n = 2 THEN
OKx1 = 15 * 8 - 15: OKy1 = 19 * 8 - 11: OKx2 = 18 * 8 + 7: OKy2 = 19 * 8 + 2
LINE (OKx1, OKy1)-(OKx2, OKy2), 0, BF
PUT (OKx1 + 6, OKy1 + 4), OKZX, PRESET
LINE (OKx1 + 5, OKy1 + 3)-(OKx2 + 5, OKy2 + 3), 1, B
SOUND 100, .1
SLEEP (1)
END IF

IF n = 3 THEN
CANx1 = 39 * 8 - 15: CANy1 = 19 * 8 - 11: CANx2 = 44 * 8 + 7: CANy2 = 19 * 8 + 2
LINE (CANx1, CANy1)-(CANx2, CANy2), 0, BF
PUT (CANx1 + 6, CANy1 + 4), CANCELZX, PRESET
LINE (CANx1 + 5, CANy1 + 3)-(CANx2 + 5, CANy2 + 3), 1, B
SOUND 100, .1
SLEEP (1)
END IF

END SUB

SUB Deystvie (x, y, q, x1)
SHARED Calv$(), Calv2$(), Calv3()
IF Calv$(q - 1) = "+" OR Calv$(q - 1) = "-" THEN Calv3(q) = VAL(Calv2$(q))
IF Calv$(q - 1) = "/" OR Calv$(q - 1) = "*" THEN Calv3(q) = &HB800
Cal5: B = B + 1: IF Calv3(B) = 0 THEN GOTO Nc
IF Calv3(B) = &HB800 THEN GOSUB NDeystv: d = d + s: GOTO Cal5 ELSE GOTO Cal6
Cal6: IF Calv$(B - 1) = "" OR Calv$(B - 1) = "+" THEN d = d + Calv3(B)
IF Calv$(B - 1) = "-" THEN d = d - Calv3(B)
GOTO Cal5




GOTO Nc
NDeystv:
IF Calv$(B) = "*" THEN s = VAL(Calv2$(B)) * VAL(Calv2$(B + 1))
IF Calv$(B) = "/" THEN s = VAL(Calv2$(B)) / VAL(Calv2$(B + 1))
IF Calv$(B - 1) = "-" THEN s = s * -1'SOUND 1000, .1
B = B + 1
RETURN

Nc: LOCATE y, x + 1: PRINT "="; d

LOCATE 11, x1: PRINT " Press any key."
r$ = INPUT$(1)
LOCATE 11, x1: PRINT " "
END SUB

SUB Dialog.WINDOW
SHARED erre$, gff, fg, Sp, ZX(), ZXerra$(), ZXinf()
REDIM ZX23(50)
CALL DEF.usr(1)


LOCATE 11, 11: PRINT " *** Dialog Window ***"
LOCATE 13, 11: PRINT "LFZ price [ ]"
LOCATE 14, 11: PRINT "LFZ base [ ]"
LOCATE 15, 11: PRINT "Speed [ ]"
LOCATE 16, 11: PRINT "BASE [ ]"
IF erre$ = "BASE_94" THEN Mag$ = "English ": ZXinf(4) = 1
IF erre$ = "RUSSIAN" THEN Mag$ = "Русский ": ZXinf(4) = 2
IF erre$ = "SK" THEN Mag$ = "Скульптура": : ZXinf(4) = 3
IF erre$ = "RSK" THEN Mag$ = "Р. Фигура ": ZXinf(4) = 4
ZXerra$(1) = "English ": ZXerra$(2) = "Русский ": ZXerra$(3) = "Скульптура": ZXerra$(4) = "Р. Фигура "
IF Sp = 0 THEN Nmag$ = "Fast": ZXinf(3) = 1
IF Sp = 10 THEN Nmag$ = "Normal": ZXinf(3) = 2
IF Sp = 40 THEN Nmag$ = "Slow": ZXinf(3) = 3
IF gff = 1 THEN LOCATE 13, 23: PRINT "X": ZXinf(1) = 1
IF fg = 2 THEN LOCATE 14, 23: PRINT "X": ZXinf(2) = 1
ZXerra$(11) = "Fast": ZXerra$(12) = "Normal": ZXerra$(13) = "Slow"
LOCATE 15, 18: PRINT Nmag$
LOCATE 16, 18: PRINT Mag$
y = 1: GOSUB ZXq1: GOSUB ZXqq1
ZX: a$ = INKEY$
IF a$ <> "" THEN GOSUB ZXqq1
IF a$ = CHR$(0) + CHR$(72) THEN GOSUB ZXq1: y = y - 1: GOSUB errorsZX: GOSUB ZXq1
IF a$ = CHR$(0) + CHR$(80) THEN GOSUB ZXq1: y = y + 1: GOSUB errorsZX: GOSUB ZXq1
IF a$ = " " THEN GOSUB obrav
IF a$ = CHR$(13) THEN GOTO ZXendAll
IF a$ = CHR$(27) THEN CALL DEF.usr(3): GOTO RESTforAwhile
IF a$ <> "" THEN GOSUB ZXqq1
GOTO ZX


errorsZX:
IF y < 1 THEN y = 4
IF y > 4 THEN y = 1
RETURN
ZXq1: GET (23 * 8 - 8, (y + 12) * 8 - 4)-(23 * 8 - 1, (y + 12) * 8 - 1), ZX
PUT (23 * 8 - 8, (y + 12) * 8 - 4), ZX, PRESET
RETURN
ZXqq1: GET (35 * 8 - 7, (y + 12) * 8 - 7)-(35 * 8 - 1, (y + 12) * 8 - 1), ZX23
PUT (35 * 8 - 7, (y + 12) * 8 - 7), ZX23, PRESET
RETURN

obrav: GOSUB ZXq1
IF y = 1 THEN
IF ZXinf(1) = 1 THEN ZXinf(1) = 0 ELSE ZXinf(1) = 1
IF ZXinf(1) = 1 THEN LOCATE 13, 23: PRINT "X" ELSE LOCATE 13, 23: PRINT " "
END IF
IF y = 2 THEN
IF ZXinf(2) = 1 THEN ZXinf(2) = 0 ELSE ZXinf(2) = 1
IF ZXinf(2) = 1 THEN LOCATE 14, 23: PRINT "X" ELSE LOCATE 14, 23: PRINT " "
END IF
IF y = 3 THEN
ZXinf(3) = ZXinf(3) + 1: IF ZXinf(3) > 3 THEN ZXinf(3) = 1
LOCATE 15, 18: PRINT ZXerra$(ZXinf(3) + 10); " "
END IF
IF y = 4 THEN
ZXinf(4) = ZXinf(4) + 1: IF ZXinf(4) > 4 THEN ZXinf(4) = 1
LOCATE 16, 18: PRINT ZXerra$(ZXinf(4)); SPACE$(13 - LEN(ZXerra$(ZXinf(4))))
END IF




GOSUB ZXq1
RETURN
ZXendAll:
IF ZXinf(1) = 1 THEN gff = 1 ELSE gff = 0
IF ZXinf(2) = 1 THEN fg = 2 ELSE fg = 1
IF ZXinf(3) = 1 THEN Sp = 0
IF ZXinf(3) = 2 THEN Sp = 10
IF ZXinf(3) = 3 THEN Sp = 40

IF ZXinf(4) = 1 THEN erre$ = "BASE_94"
IF ZXinf(4) = 2 THEN erre$ = "RUSSIAN"
IF ZXinf(4) = 3 THEN erre$ = "SK"
IF ZXinf(4) = 4 THEN erre$ = "RSK"
CALL DEF.usr(2)

RESTforAwhile:
END SUB

FUNCTION Dir.LIST$
SHARED Dir$(), Fil$(), PathSpec$, Drive$, Dir, Fil, NMerc$
CALL DEF.usr2(11)
Drive$ = "C:"

S23: path$ = Drive$ + PathSpec$ + "*.*"
SHELL "Dir " + path$ + " > c:qbTextNick1.twh"
OPEN "c:qbtextNick1.twh" FOR INPUT AS #9
FOR tgg = 1 TO 4: INPUT #9, a$: NEXT
a$ = " :"
WHILE MID$(a$, 36, 1) = ":"
INPUT #9, a$
IF MID$(a$, 36, 1) = ":" THEN
IF MID$(a$, 14, 5) = "
"
AND MID$(a$, 1, 8) = ". " THEN GOTO yuall3
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)
yuall3:
END IF
WEND
CLOSE #9

er7: LOCATE 10, 30: PRINT Drive$ + PathSpec$
i$ = Orangemenu$(4, 4, "", 10, Dir)
IF i$ = "" THEN
g$ = LINE.INPUT$
IF g$ = "" THEN LOCATE 10, 30: PRINT " ": GOTO er7
IF g$ = "" THEN CALL DEF.usr2(3): GOTO Restfor23
NMerc$ = g$: GOTO Restfor3
END IF
IF i$ = "" THEN CALL DEF.usr2(3): NMerc$ = "": GOTO Restfor23
IF MID$(i$, 1, 8) = ".. " THEN PathSpec$ = ClearSlash$(PathSpec$): Dir = 0: GOTO S23
PathSpec$ = PathSpec$ + ClearSpace$(MID$(i$, 1, 8)) + ""

IF NMerc$ = "" THEN NMerc$ = "": GOTO Restfor23
IF NMerc$ <> "" THEN GOTO Restfor3
Dir = 0: Fil = 0: t = 1
GOTO S23

Restfor3:
Dir.LIST$ = Drive$ + PathSpec$ + NMerc$
NMerc$ = ""
CALL DEF.usr2(2)
Restfor23:

END FUNCTION

SUB Dos.FUNCTION (B$)
a$ = MID$(B$, 4, 60)
CALL Ssc
ON ERROR GOTO 920
SHELL a$
END SUB

SUB E.R
SHARED erre$
DIM n$(4): n$(1) = " Английский. ": n$(2) = " Русский. ": n$(3) = " Скульптура ": n$(4) = " Р. Фигура "
IF erre$ = "BASE_94" THEN Mag$ = " English "
IF erre$ = "RUSSIAN" THEN Mag$ = " Русский "
IF erre$ = "SK" THEN Mag$ = "Скульптура"
IF erre$ = "RSK" THEN Mag$ = " Р. Фигура "

i = Neo.menu(12, 9, Mag$, n$(), 4)
IF i = 1 THEN erre$ = "BASE_94"
IF i = 2 THEN erre$ = "RUSSIAN"
IF i = 3 THEN erre$ = "SK"
IF i = 4 THEN erre$ = "RSK"
LOCATE 10, 6: PRINT " "
END SUB

SUB Edit.ON.file
SHARED Edit$(), Ety
CALL Ssc
CALL Loading
IF Ety = 54 THEN CALL Lsc: GOTO h80
x1 = 2: y1 = 2: x2 = 30: y2 = 15: x = 1: y = 1: n = 1
CALL New.WINDOW(x1, y1, x2, y2, n)
DEF SEG = &H40
21 a$ = INKEY$: ii = PEEK(&H17)
IF a$ = CHR$(0) + CHR$(16) OR a$ = CHR$(13) THEN CALL Lsc: GOTO h80
IF a$ = CHR$(54) AND ii = 2 THEN CLS : x2 = x2 + 1: CALL New.WINDOW(1 + x, 1 + y, x2, y2, n)': FOR t = y1 TO y2: LOCATE t, x2 + 1: PRINT " ": NEXT
IF a$ = CHR$(52) AND ii = 2 THEN CLS : x2 = x2 - 1: CALL New.WINDOW(1 + x, 1 + y, x2, y2, n)': FOR t = y1 TO y2: LOCATE t, x2 + 1: PRINT " ": NEXT
IF a$ = CHR$(50) AND ii = 2 THEN CLS : y2 = y2 + 1: CALL New.WINDOW(1 + x, 1 + y, x2, y2, n)': FOR t = y1 TO y2: LOCATE t, x2 + 1: PRINT " ": NEXT
IF a$ = CHR$(56) AND ii = 2 THEN CLS : y2 = y2 - 1: CALL New.WINDOW(1 + x, 1 + y, x2, y2, n)': FOR t = y1 TO y2: LOCATE t, x2 + 1: PRINT " ": NEXT

IF a$ = CHR$(54) AND ii = 1 THEN CLS : x = x + 1: x2 = x2 + 1: CALL New.WINDOW(1 + x, 1 + y, x2, y2, n)': FOR t = y1 TO y2: LOCATE t, x2 + 1: PRINT " ": NEXT
IF a$ = CHR$(52) AND ii = 1 THEN CLS : x = x - 1: x2 = x2 - 1: CALL New.WINDOW(1 + x, 1 + y, x2, y2, n)': FOR t = y1 TO y2: LOCATE t, x2 + 1: PRINT " ": NEXT
IF a$ = CHR$(50) AND ii = 1 THEN CLS : y = y + 1: y2 = y2 + 1: CALL New.WINDOW(1 + x, 1 + y, x2, y2, n)': FOR t = y1 TO y2: LOCATE t, x2 + 1: PRINT " ": NEXT
IF a$ = CHR$(56) AND ii = 1 THEN CLS : y = y - 1: y2 = y2 - 1: CALL New.WINDOW(1 + x, 1 + y, x2, y2, n)': FOR t = y1 TO y2: LOCATE t, x2 + 1: PRINT " ": NEXT

IF a$ = CHR$(0) + CHR$(72) THEN n = n - 1: CALL Scrolling(n, x, x2, y, y2, Trot)
IF a$ = CHR$(0) + CHR$(80) THEN n = n + 1: CALL Scrolling(n, x, x2, y, y2, Trot)
IF a$ = CHR$(0) + CHR$(73) THEN n = n - 10: CALL Scrolling(n, x, x2, y, y2, Trot)
IF a$ = CHR$(0) + CHR$(81) THEN n = n + 10: CALL Scrolling(n, x, x2, y, y2, Trot)
IF a$ = CHR$(0) + CHR$(75) THEN Trot = Trot - 1: CALL Scrolling(n, x, x2, y, y2, Trot)
IF a$ = CHR$(0) + CHR$(77) THEN Trot = Trot + 1: CALL Scrolling(n, x, x2, y, y2, Trot)
IF a$ = CHR$(0) + CHR$(71) THEN Trot = 0: CALL Scrolling(n, x, x2, y, y2, Trot)


GOTO 21


h80:


END SUB

SUB file (i)
SHARED y$(), s, Amount(), ch$(), path$, q$(), Sp, y(), Subpath$
CALL Ssc
IF i <> 0 THEN GOTO Start.menu.options
q$(1) = " Yes ": q$(2) = " No "
CLOSE #2

i = Pic.menu '****** M A I N M E N U ********

Start.menu.options:
IF i = 1 THEN ' *** Saving option ***
y$(2) = " Сохранить в Тексте "
y$(1) = " Сохранить в кодах "
ii = Neo.menu(8, 6, " Select ", y$(), 2)

IF ii = 1 THEN '* Mashine Code *
SaveM2: path$ = Dir.LIST$
CALL Lsc
IF path$ = "" THEN GOTO EndSub
CLOSE
ON ERROR GOTO 920
OPEN path$ FOR OUTPUT AS #2
PRINT #2, y(Active)
PRINT #2, Amount(Active)
FOR t = 2 TO y(Active)
PRINT #2, ch$(t, Active)
NEXT
CLOSE #2
GOTO EndSub
END IF

IF ii = 2 THEN ' * Save how a text file *
SaveT2: path$ = Dir.LIST$
CALL Lsc
IF path$ = "" THEN GOTO EndSub
ON ERROR GOTO 920
OPEN path$ FOR OUTPUT AS #2
PRINT #2, " Specification ."
PRINT #2, ""
PRINT #2, ch$(1, Active)
FOR t = 2 TO y(Active)
PRINT #2, ch$(t, Active)
NEXT
PRINT #2, " ----------"
PRINT #2, " "; Amount(Active)
PRINT #2, ""
PRINT #2, ""
PRINT #2, "Seller _________ Buyer _________ Date _______ "
CLOSE #2
CALL Lsc
GOTO EndSub
END IF
END IF '*** End of Saving option ***


IF i = 2 OR i = 3 THEN '*** Load or Merge ***
load2: IF Subpath$ = "" OR Subpath$ = " " THEN path$ = Autodir$ ELSE path$ = Subpath$

CALL Lsc
' ON ERROR GOTO 920
OPEN path$ FOR INPUT AS #2
INPUT #2, yy
IF yy = 0 THEN
CALL Lwin(14, 13, 40, 15)
CALL Gov(15, 14, " Bad file mode !")
SLEEP (4): CALL Lsc: GOTO EndSub
END IF
INPUT #2, AAmount
IF i = 2 THEN y(Active) = 1: Amount(Active) = AAmount ELSE Amount(Active) = Amount(Active) + AAmount

FOR t = 2 TO yy
y(Active) = y(Active) + 1
INPUT #2, ch$(y(Active), Active)
NEXT
CLOSE
LOCATE 19, 36: PRINT Amount(Active)
IF i = 2 THEN ch$(y(Active) + 1, Active) = "": ch$(y(Active) + 2, Active) = ""
GOTO EndSub
END IF

IF i = 4 THEN CALL Edit.ON.file
IF i = 6 THEN
Dos:
q$(1) = " Yes ": q$(2) = " No "
CALL Lsc: c = Neo.menu(35, 9, "Are you sure ?", q$(), 2)
IF c = 1 THEN CLS : SYSTEM ELSE GOTO EndSub
END IF

IF i = 7 THEN CALL Lsc: GOTO EndSub
EndSub:
CLOSE
END SUB

SUB First.Utility (n)
SHARED vindov(), qa(), qb(), qc(), qd(), Hklander
IF n = 0 THEN
GET (0, 0)-(630, 31), vindov
IF Hklander = 0 THEN
GET (144, 65)-(167, 82), qa
GET (51, 65)-(108, 83), qb
GET (208, 64)-(247, 82), qc
GET (267, 61)-(307, 84), qd
OPEN "nbasefw.bin" FOR BINARY AS #1
FOR w = 0 TO 14
GET #1, , qa(w)
NEXT
FOR w = 0 TO 38
GET #1, , qb(w)
NEXT
FOR w = 0 TO 24
GET #1, , qc(w)
NEXT
FOR w = 0 TO 36
GET #1, , qd(w)
NEXT

CLOSE #1
END IF
tt = 4
FOR t = 0 TO 9
'PUT ((t * 62) + 5, 1), qb, PSET
LOCATE 4, tt: PRINT t + 1
tt = tt + 7.75
NEXT
IF Active = 0 THEN Active = 1
'PUT (5 + (Active - 1) * 62, 1), qb, PRESET
Hklander = 1
END IF
IF n <> 0 THEN
PUT (((Active - 1) * 62) + 5, 1), qb, PSET
Active = Active + 1: IF Active = 11 THEN Active = 1
PUT (((Active - 1) * 62) + 5, 1), qb, PRESET

END IF

END SUB

SUB Gov (x, y, IS$)
FOR t = 1 TO LEN(IS$)
LOCATE y, x + t: PRINT MID$(IS$, t, 1)
IF MID$(IS$, t, 1) <> " " AND MID$(IS$, t, 1) <> "" THEN SOUND 37, 1: SOUND 900, .3

NEXT

END SUB

SUB Help.Content
SHARED c2$()
OPEN "c:qbnwindowsNbaseCon.hlp" FOR INPUT AS #6
Nbase: LINE INPUT #6, a$
y = y + 1
c2$(y) = a$
IF EOF(6) THEN GOTO Nbase2
GOTO Nbase:



Nbase2:
y = y - 6
CLOSE
CALL Ssc
CALL Lwin(10, 10, 68, 16)
LOCATE 10, 25: PRINT CHR$(16); " General Help "; CHR$(17)
LOCATE 17, 25: PRINT CHR$(16); " "; CHR$(24); CHR$(25); " - Scrolling "; CHR$(17)
Limit = y
t20:
LOCATE 11, 11: PRINT c2$(n) + SPACE$(50 - LEN(c2$(n)))
LOCATE 12, 11: PRINT c2$(n + 1) + SPACE$(50 - LEN(c2$(n + 1)))
LOCATE 13, 11: PRINT c2$(n + 2) + SPACE$(50 - LEN(c2$(n + 2)))
LOCATE 14, 11: PRINT c2$(n + 3) + SPACE$(50 - LEN(c2$(n + 3)))
LOCATE 15, 11: PRINT c2$(n + 4) + SPACE$(50 - LEN(c2$(n + 4)))

t30: a$ = INKEY$
IF a$ = CHR$(0) + CHR$(72) THEN n = n - 1: GOSUB tE: GOTO t20

IF a$ = CHR$(0) + CHR$(80) THEN n = n + 1: GOSUB tE: GOTO t20
IF a$ = CHR$(13) GOTO t40
GOTO t30
tE:
IF n < 1 THEN n = 1
IF n > Limit THEN n = Limit
RETURN
t40:
CALL Lsc
END SUB

SUB Help.Index
SHARED Hello$, Help$()
DIM B$(7)
CALL Ssc
Help$(1) = " Load - Загружение "
Help$(2) = " Save T - Сохранение "
Help$(3) = " Save M - Сохранение "
Help$(4) = " Sread - Редактирование "
Help$(5) = " Edit - Просмотр "
Help$(6) = " Space - Пропуск строки "
Help$(7) = " Newk - База "
Help$(8) = " Mag - Католог "
Help$(9) = " Help - Помощь "
Help$(10) = " Shell - Команды ДОС "
Help$(11) = " Nc - Вызов пр. NC "
Help$(12) = " Menu - Основное меню "
Help$(13) = " Quit - Выход в Дос "
Help$(14) = " Dos - запуск Команд Доса "
Help$(15) = " Exit - Возвращение в ДОС "
Help$(16) = " E-R - Режим Англо-Русск. "
Help$(17) = " Smag - Католог [Чтение] "
Help$(18) = " Speed - Скорость "
Help$(19) = " Turn OFF- протекция "
Help$(20) = " Content - вызов помощи "
Help$(21) = " Main - возврат в NWindows "
Help$(22) = " Bases - база ЛФЗ "
Help$(23) = " Prices - цены по курсу "
Help$(24) = " Balance - равнять "
Help$(25) = " Dialog - опции "
Help$(26) = " Print - вывод на принтер "
Help$(27) = " Авторские права N Base .. "
Help$(28) = " Возврат в меню "


i = Helpmenu(15, 2, "", 8, 29)
CALL Lsc
IF i = 999 THEN GOTO Endofall
IF i = 28 THEN Hello$ = "End of all": GOTO Endofall
CALL Ssc
OPEN "c:qbnwindowsNbase.hlp" FOR INPUT AS #3
FOR t = 1 TO i * 5 - 5: LINE INPUT #3, s$: NEXT
FOR t = 1 TO 5
LINE INPUT #3, B$(t)
NEXT
CALL Lwin(10, 10, 50, 19)
LOCATE 11, 11: PRINT B$(1)
FOR t = 2 TO 5
LOCATE 11 + t, 11: PRINT B$(t)
NEXT
CALL MErcan(11, 18, " Нажмите любую клавишу ..")
CLOSE #3
CALL Lsc
Endofall:

END SUB

SUB Help.ON.Help
SHARED bv$()
LOCATE 10, 6: PRINT " "
bv$(1) = "Основная "
bv$(2) = "Операторная "
bv$(3) = "Cancle "
y = Neo.menu(15, 9, " Помощь ", bv$(), 3)
IF y = 1 THEN CALL Help.Content
IF y = 2 THEN CALL Help.Index
LOCATE 10, 6: PRINT " "

END SUB

FUNCTION Helpmenu (x1, y1, Mag$, n, nn)
SHARED Help$(), Volue
DIM ZXcur2(300)
s = LEN(Help$(1))
ss = 2 + x1 + s + 1
sy = y1 + 1 + n + 1
CALL Lwin(x1, y1, ss, sy)
LOCATE y1, x1 + 2: PRINT "[" + CHR$(254) + "]": LOCATE y1, ss - 3: PRINT "[" + CHR$(24) + "]"

dd = x1 + 2
sy2 = y1 + 1

FOR t = 1 TO n
LOCATE sy2 + t, dd
IF t <= nn THEN PRINT Help$(t): k = k + 1 ELSE PRINT SPACE$(9)
NEXT

sss = x1 + (ss - x1) / 2 - LEN(Help$(1)) / 2 + 2

'sss = x1 + INT(ss / 2) - INT(LEN(Mag$) / 2) - 4
'LOCATE y1, sss: PRINT CHR$(175); " "; Mag$; " "; CHR$(174)
'LOCATE y1 + 2, x1 + 2: PRINT Help$(1)
g = 1: GOSUB eW2e1
ERee1: a$ = INKEY$

IF a$ = CHR$(0) + CHR$(80) THEN GOSUB eW1e1: g = g + 1: GOSUB eW2e1
IF a$ = CHR$(0) + CHR$(72) THEN GOSUB eW1e1: g = g - 1: GOSUB eW2e1
IF a$ = CHR$(13) THEN GOTO eOK2e1
IF a$ = CHR$(9) THEN GOSUB eW1e1: GOTO eOKe71
IF a$ = CHR$(27) THEN Helpmenu = 999: GOTO eOKe71
GOTO ERee1
eW1e1: LOCATE y1 + 1 + g, x1 + 2: PRINT Help$(g + Scr): RETURN
eW2e1: GOSUB eERORSe1:
GET ((x1 + 2) * 8 - 8, (y1 + 1 + g) * 8 - 8)-((x1 + 35) * 8 - 1, (y1 + 1 + g) * 8 - 1), ZXcur2
PUT ((x1 + 2) * 8 - 8, (y1 + 1 + g) * 8 - 8), ZXcur2, PRESET
'LOCATE y1 + 1 + g, x1 + 2: COLOR c3, c4: PRINT Help$(g + Scr)
RETURN

eERORSe1:
IF g < 1 AND k < n THEN g = 1

IF g < 1 AND k >= n THEN
Scr = Scr - 1
IF Scr < 0 THEN Scr = 0
GOSUB Scroll1
g = 1
END IF
IF g > n AND g <= nn THEN
Scr = Scr + 1
IF Scr + n > nn - 1 THEN Scr = Scr - 1
GOSUB Scroll1
g = n
END IF
IF g > nn THEN g = nn
RETURN

Scroll1:
FOR t = 1 TO n
LOCATE y1 + 1 + t, dd: PRINT Help$(t + Scr)
NEXT
RETURN
eeOK2e1: END
eOK2e1: Helpmenu = g + Scr
eOKe71:
END FUNCTION

FUNCTION Intement$ (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 - 1 > 3 THEN g$ = MID$(s$, 1, LEN(f$) + 3)
Intement$ = g$

END FUNCTION

FUNCTION j$ (B$)
k$ = "C:/B2"
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

FUNCTION L.menu (xl, yl, Mag$, m$(), n)
DIM a(500)
IF xl < 2 THEN xl = 2
IF yl < 2 THEN yl = 2
x1 = xl * 8 - 15: y1 = yl * 8 - 10
'x1 = 20: y1 = 10
x2 = x1 + LEN(m$(1)) * 8 + 10 + 2
y2 = y1 + n * 8 + 15

LINE (x1 - 2, y1 - 2)-(x2 + 10, y2 + 2), 0, BF
LINE (x1, y1)-(x2 + 8, y2), 2, B
LINE (x1 - 2, y1 - 2)-(x2 + 10, y2 + 2), 2, B
FOR i = yl TO yl + n
LOCATE i, xl: PRINT m$(i - yl)
NEXT
y = 1

GOSUB 1690
DO
a$ = INKEY$
IF LEN(a$) <> 0 THEN
GOSUB 1690
IF a$ = CHR$(0) + CHR$(72) THEN y = y - 1
IF a$ = CHR$(0) + CHR$(80) THEN y = y + 1
IF a$ = CHR$(13) THEN aspect = 1
IF a$ = CHR$(27) THEN aspect = 1: y = 0
IF y > n THEN y = 1
IF y < 1 THEN y = n

GOSUB 1690
END IF
LOOP UNTIL aspect = 1


GOTO 1680
1690 : GET (x1 + 6, y1 + 2 + y * 8)-(x1 + 6 + LEN(m$(1)) * 8, y1 + 2 + y * 8 + 8), a
PUT (x1 + 6, y1 + 2 + y * 8), a, PRESET
RETURN

1680 : L.menu = y
'LINE (0, 0)-(639, 9), 0, BF

END FUNCTION

FUNCTION LINE.INPUT$
SHARED Drive$, PathSpec$
li$ = Nput$(30 + LEN(Drive$ + PathSpec$), 10)
IF li$ <> "" AND li$ <> " " AND li$ <> " " AND li$ <> " " AND li$ <> "" THEN
IF LEN(li$) > 12 AND INSTR(li$, ".") > 9 THEN li$ = LEFT$(li$, 8) + ".spc"
IF LEN(li$) > 12 AND INSTR(li$, ".") <= 9 THEN li$ = LEFT$(li$, INSTR(li$, ".") + 3)
t = INSTR(li$, ".")
IF t > 9 THEN
li$ = LEFT$(li$, 8)
t2 = INSTR(li$, ".")
IF t <> 0 THEN li$ = "Noname.spc" ELSE li$ = li$ + ".spc"
END IF
END IF
LINE.INPUT$ = li$
END FUNCTION

SUB Loading
SHARED Edit$(), nolimits, Limon, Ety
CALL Ssc: path$ = Autodir$: CALL Lsc
OPEN path$ FOR INPUT AS #5

INPUT #5, Edit$(1)
IF STR$(VAL(Edit$(1))) = " " + Edit$(1) THEN numer = VAL(Edit$(1)) ELSE numer = 245

FOR t = 1 TO numer
LINE INPUT #5, Edit$(t + 1): Limon = Limon + 1
IF Edit$(t + 1) = "" OR EOF(5) THEN GOTO h10
NEXT
h10:

CLOSE #5
END SUB

SUB Lsc
DEF SEG = &HB800
BLOAD "c:qbpictureNbase.grf", &H0
END SUB

SUB Lsc2
DEF SEG = &HB800
BLOAD "c:qbpictureNbase2.grf", &H0
END SUB

SUB Lwin (x1, y1, x2, y2)
SHARED Shodow$
LINE ((x1 - 1) * 8 - 2, (y1 - 1) * 8 + 2)-(x2 * 8 + 2, y2 * 8 + 2), 0, BF

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

LINE (x2 * 8 + 3, y1 * 8)-((x2 + 1) * 8 + 3, (y2 + 1) * 8 + 2), 0, BF
LINE ((x1 + 1) * 8, (y2 * 8) + 2)-((x2 + 1) * 8, (y2 + 1) * 8 + 2), 0, BF

LINE (x2 * 8 + 3, y1 * 8)-((x2 + 1) * 8 + 3, (y2 + 1) * 8 + 2), 1, B
LINE ((x1 + 1) * 8, (y2 * 8) + 2)-((x2 + 1) * 8, (y2 + 1) * 8 + 2), 1, B
LINE (x2 * 8 + 3, (y2 * 8) + 2)-((x2 + 1) * 8 + 2, (y2 * 8) + 2), 0
LINE (x2 * 8 + 3, (y2 * 8) + 2)-(x2 * 8 + 3, (y2 + 1) * 8 + 1), 0
PAINT (x2 * 8 + 5, y1 * 8 + 2), Shodow$, 1
END SUB

SUB Magazine
LOCATE 10, 6: PRINT " "
'CALL Lwin(5, 5, 40, 10):
Mag$ = " Select "
LOCATE 10, 6: PRINT
DIM fg$(2): fg$(1) = " All Numbers ": fg$(2) = " Num. at their THIRD letter."
ddd = 123
y = makemenu(35, 9, fg$(), 2)
CALL Ssc2
ddd = 0
' PCOPY 3, 0: FOR gg = 1 TO 100: NEXT ELSE CLS : CALL Lwin(5, 7, 40, 10)


ON y GOTO 810, 690
690
CALL Lwin(5, 7, 40, 10)
LOCATE 8, 6: PRINT " Enter THIRD letter .."
LOCATE 9, 6: INPUT "...", h$
tt = 6
CALL Lwin(5, 5, 25, 20)
d$ = fnm$(" " + h$)
CLOSE : z = 1: m = 1: LOCATE 5, 7: PRINT CHR$(175); " Kart # Base # "; CHR$(174)
OPEN "R", 1, d$
IF LOF(1) = 0 THEN CALL Lwin(10, 10, 40, 13): LOCATE 11, 11: PRINT " No File on this letter.": LOCATE 12, 11: PRINT " Press any key..": CALL Pause: CLS : CLOSE : GOTO 90
730 FIELD #1, 3 AS E$, 5 AS k$, 25 AS g$, 5 AS peace$
GET #1, z
IF z <> LOF(1) / 128 + 1 THEN 760
LOCATE 20, 7: PRINT CHR$(175); " End of List."; CHR$(174): CALL Pause: CLS : CLOSE : GOTO 90
760 IF E$ <> "999" THEN z = z + 1: GOTO 730
tt = tt + 1
LOCATE tt, 6: PRINT z, k$: m = m + 1: IF tt > 18 THEN LOCATE 20, 7: PRINT CHR$(175); "Press any key.."; CHR$(174): CALL Pause: tt = 6: CALL Lwin(5, 5, 25, 20)
'IF INT(m / 17) = m / 17 THEN INPUT "Press ENTER..", m$
z = z + 1
GOTO 730

810
tt = 6
CALL Lwin(5, 5, 52, 20)
LOCATE 5, 7: PRINT "Kart #", "Keyword"
x = ASC("0")
840 d$ = fnm$(" " + CHR$(x))
z = 1
CLOSE
OPEN "R", 1, d$
IF LOF(1) <> 0 THEN 890
x = x + 1: IF x <= ASC("9") THEN 840 ELSE LOCATE 20, 7: PRINT " End of List": CALL Pause: CLS : CLOSE : GOTO 90
890
'FIELD #1, 3 AS E$, 5 AS K$, 105 AS g$
FIELD #1, 3 AS E$, 5 AS k$, 25 AS g$, 5 AS peace$
IF z <> LOF(1) / 128 + 1 THEN 910
IF INKEY$ = CHR$(27) THEN CLOSE : GOTO 90

x = x + 1: IF x <= ASC("9") THEN 840 ELSE LOCATE 20, 7: PRINT " End of List": CALL Pause: CLS : CLOSE : GOTO 90
910 GET #1, z
IF E$ <> "999" THEN z = z + 1: GOTO 890
tt = tt + 1: ff = ff + 1
IF tt > 18 THEN
LOCATE 20, 7: PRINT "Press any key.."

Nick2: Vbg$ = INKEY$
IF Vbg$ = CHR$(27) THEN CLOSE : GOTO 90
IF Vbg$ = "" THEN GOTO Nick2
tt = 6: CALL Lwin(5, 5, 52, 20)
END IF
LOCATE tt, 6: PRINT ff, k$; " "; g$
z = z + 1
GOTO 890
90 CALL Lsc2
END SUB

FUNCTION makemenu (xl, yl, m$(), n)
CALL Ssc
DIM a(500)
IF xl < 2 THEN xl = 2
IF yl < 2 THEN yl = 2
x1 = xl * 8 - 15: y1 = yl * 8 - 10
'x1 = 20: y1 = 10
x2 = x1 + LEN(m$(1)) * 8 + 10
y2 = y1 + n * 8 + 15

LINE (x1 - 2, y1 - 2)-(x2 + 2, y2 + 2), 0, BF
LINE (x1, y1)-(x2, y2), 2, B
LINE (x1 - 2, y1 - 2)-(x2 + 2, y2 + 2), 2, B
FOR i = yl TO yl + n
LOCATE i, xl: PRINT m$(i - yl)
NEXT
y = 1

GOSUB 169
DO
a$ = INKEY$
IF LEN(a$) <> 0 THEN
GOSUB 169
IF a$ = CHR$(0) + CHR$(72) THEN y = y - 1
IF a$ = CHR$(0) + CHR$(80) THEN y = y + 1
IF a$ = CHR$(13) THEN aspect = 1
IF a$ = CHR$(27) THEN aspect = 1: y = 0
IF y > n THEN y = 1
IF y < 1 THEN y = n

GOSUB 169
END IF
LOOP UNTIL aspect = 1


GOTO 168
169 : GET (x1 + 6, y1 + 2 + y * 8)-(x1 + 6 + LEN(m$(1)) * 8, y1 + 2 + y * 8 + 7), a
PUT (x1 + 6, y1 + 2 + y * 8), a, PRESET
RETURN

168 : makemenu = y
'LINE (0, 0)-(639, 9), 0, BF
CALL Lsc


END FUNCTION

FUNCTION Menu.Magazin
SHARED c$(), c2$(), B$
LOCATE 10, 6: PRINT " "
'call lwin(5, 5, 40, 10):
Mag$ = " Select "
LOCATE 10, 6: PRINT
DIM fg$(2): fg$(1) = " All Numbers ": fg$(2) = " Num. at their THIRD letter."
ddd = 123
y = makemenu(35, 9, fg$(), 2)
CALL Ssc2
ddd = 0
' call Lsc2: FOR gg = 1 TO 100: NEXT ELSE call lwin(5, 7, 40, 10)


ON y GOTO 8100, 6900
6900 CALL Lwin(5, 7, 40, 10)
LOCATE 8, 6: PRINT " Enter THIRD letter .."
LOCATE 9, 6: INPUT "..", h$

tt = 6
'call lwin(5, 5, 25, 20)
d$ = fnm$(" " + h$)
CLOSE : z = 1: m = 1: 'LOCATE 5, 7: PRINT CHR$(175); " Kart # Base # "; CHR$(174)
OPEN "R", 1, d$
IF LOF(1) = 0 THEN CALL Lwin(10, 10, 40, 13): LOCATE 11, 11: PRINT " No File on this letter.": LOCATE 12, 11: PRINT " Press any key..": CALL Pause: CLOSE : GOTO 90000
7300 FIELD #1, 3 AS E$, 5 AS k$, 25 AS g$, 5 AS peace$
GET #1, z
IF z <> LOF(1) / 128 + 1 THEN 7600
c$(m + 1) = "End": h = L.menu(5, 1, "", c$(), m + 1):
IF h <> m + 1 THEN lkj$ = c2$(h): CLOSE : GOTO 90000
CLOSE : lkj$ = " ": GOTO 90000
7600 IF E$ <> "999" THEN z = z + 1: GOTO 7300
tt = tt + 1


LOCATE tt, 6: gn = gn + 1: c2$(m) = k$: c$(m) = STR$(gn) + SPACE$(10 - LEN(STR$(gn))) + k$: m = m + 1: IF m > 7 THEN c$(m) = "Next": h = L.menu(5, 1, "", c$(), 8): m = 1: tt = 6: IF h <> 8 THEN lkj$ = c2$(h): CLOSE : GOTO 90000


z = z + 1
GOTO 7300

8100

tt = 6: m = 1
'call lwin(5, 5, 25, 20)
'LOCATE 5, 7: PRINT "Kart #", "Keyword"
x = ASC("1")
8400 d$ = fnm$(" " + CHR$(x))
z = 1
CLOSE
OPEN "R", 1, d$
IF LOF(1) <> 0 THEN 8900
x = x + 1: IF x <= ASC("9") THEN 8400 ELSE LOCATE 20, 7: PRINT " End of List": CALL Pause: CLOSE : GOTO 90000
8900 FIELD #1, 3 AS E$, 5 AS k$, 105 AS g$
IF z <> LOF(1) / 128 + 1 THEN 9100
IF INKEY$ = CHR$(27) THEN CLOSE : GOTO 90000

x = x + 1: IF x <= ASC("9") THEN GOTO 8400 ELSE c$(m) = "End": h = L.menu(5, 1, "", c$(), m): IF h <> m + 1 THEN lkj$ = c2$(h): CLOSE : GOTO 90000 ELSE CLOSE : lkj$ = " ": GOTO 90000


9100 GET #1, z
IF E$ <> "999" THEN z = z + 1: GOTO 8900
tt = tt + 1: ff = ff + 1
IF tt > 18 THEN
g = L.menu(10, 10, "", c$(), 8): n = 0'LOCATE 20, 7: PRINT "Press any key.."
END IF
n = n + 1

LOCATE tt, 6: gn = gn + 1: c2$(m) = k$: c$(m) = STR$(gn) + " " + k$: m = m + 1: IF m > 7 THEN c$(m) = "Next": h = L.menu(5, 1, "", c$(), 8): m = 1: tt = 6: IF h <> 8 THEN lkj$ = c2$(h): CLOSE : GOTO 90000

'c$(n) = STR$(tt) + " .." + k$

z = z + 1
GOTO 8900
90000 CALL Lsc2
'PRINT " "
LOCATE 10, 6: PRINT lkj$
B$ = lkj$

END FUNCTION

SUB MErcan (x, y, n$)
SHARED Printers
x2 = LEN(n$) + x
a$ = INKEY$
WHILE a$ = ""
a$ = INKEY$: l = l + 1
IF l < 10 THEN LOCATE y, x: PRINT n$ ELSE LINE (x * 8 - 8, y * 8 - 8)-(x2 * 8, y * 8), 0, BF
IF l > 20 THEN l = 0
WEND
IF a$ = CHR$(27) THEN Printers = 56 ELSE Printers = 0
END SUB

FUNCTION Neo.menu (x1, y1, Mag$, m$(), n)
SHARED gh()
CALL Ssc2
s = LEN(m$(1))
ss = 2 + x1 + s * n + n * 3
'IF ss > 77 THEN GOTO Ok
CALL Lwin(x1, y1, ss, y1 + 3)
dd = x1 + 2
FOR t = 1 TO n
LOCATE y1 + 2, dd: PRINT m$(t)
dd = dd + s + 3
NEXT

sss = x1 + (ss - x1) / 2 - LEN(m$(1)) / 2 - 2

LOCATE y1, sss: PRINT CHR$(16); " "; Mag$; " "; CHR$(17)
g = 1
LOCATE y1 + 2, x1 + s * (g - 1) + 2 + 3 * (g - 1): PRINT m$(g)
GOSUB Q1
Main: a$ = INKEY$
IF a$ = CHR$(0) + CHR$(77) OR a$ = " " THEN GOSUB Q1: g = g + 1: GOSUB Q1
IF a$ = CHR$(0) + CHR$(75) THEN GOSUB Q1: g = g - 1: GOSUB Q1
IF a$ = CHR$(13) THEN GOTO ok

GOTO Main
Q1:
GOSUB ERRORS
'LOCATE y1 + 2, x1 + s * (g - 1) + 2 + 3 * (g - 1): COLOR 7, 0: PRINT m$(g)
GET ((x1 + s * (g - 1) + 2 + 3 * (g - 1)) * 8 - 8, (y1 + 2) * 8 - 8)-((x1 + s * (g - 1) + 2 + 3 * (g - 1)) * 8 + 8 + LEN(m$(1)) * 8, (y1 + 2) * 8), gh
PUT ((x1 + s * (g - 1) + 2 + 3 * (g - 1)) * 8 - 8, ((y1 + 2) * 8 - 8)), gh, PRESET
RETURN

ERRORS:
IF g < 0 OR g = 0 THEN g = n
IF g > n THEN g = 1
RETURN
ok:
CALL Lsc2
Neo.menu = g
END FUNCTION

SUB New.WINDOW (x1, y1, x2, y2, n)
SHARED Edit$()
LINE ((x1 - 1) * 8 - 2, (y1 - 1) * 8 - 2)-(x2 * 8 + 2, y2 * 8 + 2), 0, BF
LINE ((x1 - 1) * 8, (y1 - 1) * 8)-(x2 * 8, y2 * 8), 1, B
LINE ((x1 - 1) * 8 - 2, (y1 - 1) * 8 - 2)-(x2 * 8 + 2, y2 * 8 + 2), 1, B
LINE (x2 * 8 + 3, y1 * 8)-((x2 + 1) * 8 + 3, (y2 + 1) * 8 + 2), 1, BF
LINE ((x1 + 1) * 8, (y2 * 8) + 2)-((x2 + 1) * 8, (y2 + 1) * 8 + 2), 1, BF
FOR t = y1 + 1 TO y2 - 1'17
dd = dd + 1
LOCATE t, x1 + 1: PRINT LEFT$(Edit$(dd + n - 1), x2 - x1 - 1)
NEXT
END SUB

SUB Newk
SHARED bv$(), adb$()
bv$(1) = " New "
bv$(2) = " See "
bv$(3) = " Del "
bv$(4) = " Exit "
CALL Ssc
Newk:
CALL Lsc
Lclub:
y = Neo.menu(35, 9, " Functions ", bv$(), 4)

IF y = 4 THEN GOTO Ef

IF y = 1 THEN
270 'Input new Kart
CLS
CALL Lwin(10, 10, 18, 12)
LOCATE 11, 11: PRINT "_____"
LOCATE 9, 9: PRINT "Input N^ of N_"
LOCATE 11, 11: INPUT "", B$
CLS
'PRINT b$
'b$ = STR$(h): PRINT b$
CALL Lwin(10, 10, 40, 12)
LOCATE 8, 10: PRINT "Input Name (E)"
LOCATE 11, 11: PRINT "_________________________"
LOCATE 11, 11
320 INPUT "", c$
IF LEN(c$) > 25 THEN 320
CLS
'call lwin(10, 10, 40, 12)
'LOCATE 11, 11: PRINT "_________________________"
'LOCATE 8, 10: PRINT "Input Name (R)"
'CALL russ(10, 11)
'CLS
CALL Lwin(10, 10, 40, 12)
LOCATE 8, 10: PRINT "Input Peaces "
LOCATE 11, 11: INPUT "", peace2$
CLS
d$ = fnm$(B$)
CLOSE
OPEN "R", 1, d$: z = 1
FIELD #1, 3 AS E$, 5 AS k$, 25 AS g$, 5 AS peace$
380 GET #1, z
IF E$ = "999" THEN z = z + 1: IF z = LOF(1) / 128 + 1 THEN 400 ELSE 380

400
LSET k$ = B$
LSET rus$ = rus2$
LSET g$ = c$
LSET E$ = "999"
LSET peace$ = peace2$
PUT #1, z
CLOSE
CLS
GOTO Newk
END IF


IF y = 2 THEN
REM Find Zametka
'CLS
CALL Lwin(10, 10, 40, 12)
LOCATE 11, 11: INPUT "Enter number =>", B$
'CLS
'b$ = STR$(h)
d$ = fnm$(B$)
CLOSE : z = 1
OPEN "R", 1, d$
IF LOF(1) = 0 THEN BEEP: PRINT "No Files !": CALL Pause: CLS : CLOSE : GOTO Newk
10100 IF z <> LOF(1) / 128 + 1 THEN 10200
LOCATE 12, 7: PRINT "Press any key..": CALL Pause
CLOSE : CLS : GOTO Newk
10200 FIELD #1, 3 AS E$, 5 AS k$, 25 AS g$, 5 AS peace$
GET #1, z
IF E$ <> "999" THEN z = z + 1: GOTO 10100

IF LEFT$(k$, 5) = LEFT$(B$, 5) THEN 10800

'IF LEFT$(k$, LEN(b$)) = b$ THEN 10800
z = z + 1
GOTO 10100
10800
CALL Lwin(5, 5, 45, 12)
LOCATE 5, 7: PRINT "P #"; z, "N_ - "; k$
PRINT
LOCATE 7, 6: PRINT "Name Word (E) "; g$
'IF sqw = 1 THEN LOCATE 8, 6: PRINT "Name Word (R) "; rus$
'IF sqw = 2 THEN LOCATE 8, 6: PRINT "Name Word (R) ": IF rus$ <> "" THEN FOR t = 1 TO LEN(rus$) - 1: f = OUTtrans(ASC(MID$(rus$, t, 1))): xxx = xxx + 1: CALL Wchar(19 + xxx, 8, f): NEXT
xxx = 0
LOCATE 9, 6: PRINT "Peaces=>"; peace$
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 : CALL Lwin(5, 5, 40, 12)
IF m > 1 AND sqw = 2 THEN LOCATE 12, 7: PRINT "N_ have one more name !": CALL Pause: CLS : CALL Lwin(5, 5, 40, 12)
'INT(m / 5) = m / 5 OR
GOTO 10100
END IF

IF y = 3 THEN
'DELETE

1140 CALL Ssc2
CLS
LOCATE 2, 40: PRINT ".. DELETING .."
CALL Lwin(10, 10, 40, 12)
LOCATE 11, 11: INPUT "ENTER N_ , # =>", B$, z
CLS : d$ = fnm$(B$)
CLOSE
OPEN "R", #1, d$
FIELD #1, 3 AS E$, 5 AS k$, 25 AS g$, 5 AS peace$

GET #1, z
IF LEFT$(k$, 5) = LEFT$(B$, 5) THEN 1220
PRINT "Name with this number have not this number !"
CLOSE : GOTO Newk
1220 CLS : CALL Lwin(2, 2, 40, 6)
LOCATE 2, 4: PRINT "N_ "; k$
LOCATE 3, 3: PRINT "Name (E) -"; g$
LOCATE 4, 3: PRINT "Price -"; Dol$
LOCATE 5, 3: PRINT "Peaces -"; peace$

LOCATE 6, 45: PRINT "Do you want to Delete this Num. ?"
adb$(1) = " No . ": adb$(2) = " Yes . "
a = makemenu(35, 9, adb$(), 2)

IF a = 1 THEN CLOSE : CALL Lsc2: GOTO Lclub
IF a = 2 OR a = 3 THEN GOTO 9000
9000
FIELD #1, 3 AS E$, 5 AS k$, 105 AS g$
LSET peace$ = ""
LSET Dol$ = ""
'LSET rus$ = ""
LSET k$ = ""
LSET E$ = ""
LSET g$ = ""

PUT #1, z
CLOSE
CALL Lsc2

GOTO Lclub
END IF

Ef: CALL Lsc
LOCATE 10, 6: PRINT " "

END SUB

SUB NIT
nx = 90: ny = 45
c = 2
CLS
'DEF SEG = &HB800
' BLOAD "c:qbpictureNbase4.grf", &H0
'DEF SEG
'LOCATE 23, 30: PRINT " Press any key ... "
'CALL pause
'CLS
'GOTO Yuk
'LOCATE 10, 10: PRINT "Lomonosov Porcean Factory and "
'FOR t = 1 TO 100: LOCATE INT(RND * 23) + 1, INT(RND * 80) + 1: PRINT ".": NEXT
'LOCATE 10, 10: PRINT " "
LINE (110 + nx, 80 + ny)-(90 + nx, 130 + ny), c
LINE (115 + nx, 80 + ny)-(95 + nx, 130 + ny), c
LINE (160 + nx, 80 + ny)-(140 + nx, 130 + ny), c
LINE (165 + nx, 80 + ny)-(145 + nx, 130 + ny), c
LINE (115 + nx, 80 + ny)-(140 + nx, 130 + ny), c

LINE (110 + nx, 80 + ny)-(115 + nx, 80 + ny), c
LINE (160 + nx, 80 + ny)-(165 + nx, 80 + ny), c
LINE (140 + nx, 130 + ny)-(145 + nx, 130 + ny), c
LINE (90 + nx, 130 + ny)-(95 + nx, 130 + ny), c
PAINT (94 + nx, 129 + ny), 2, 2: PAINT (163 + nx, 82 + ny), 2, 2

'FOR t = 70 TO 5 STEP -6: LOCATE 12, t: PRINT "Nick ": LOCATE 12, t: PRINT " ": NEXT: LOCATE 12, 5: PRINT "Nick "
FOR t = 1 TO 20: SOUND t + 1000, .1: LOCATE t, 16: PRINT "Nick": FOR i = 1 TO 4: NEXT: LOCATE t, 16: PRINT " ": NEXT: LOCATE 20, 16: PRINT "Nick"
FOR t = 70 TO 21 STEP -6: SOUND t + 1000, .1: LOCATE 20, t: PRINT "Computers": LOCATE 20, t: PRINT " ": NEXT: LOCATE 20, 21: PRINT "Computers"

FOR t = 70 TO 31 STEP -6: SOUND t + 1000, .1: LOCATE 20, t: PRINT "Print corp.": LOCATE 20, t: PRINT " ": NEXT: LOCATE 20, 31: PRINT "Print corp."
SOUND 1000, .1
SOUND 1000, .2
LOCATE 15, 25: PRINT "Present ."
CIRCLE (130 + nx, 105 + ny), 110

CALL Gov(30, 8, "Нажмите любую клавишу ...")

CALL Pause
Yuk:
LOCATE 8, 30: PRINT " "
END SUB

FUNCTION Nput$ (x, y)
CALL Scu(y, x)
DEF SEG = &H40
Cm10: a$ = INKEY$
IF PEEK(&H17) = 0 THEN LOCATE 1, 1: PRINT " "
IF PEEK(&H17) = 8 THEN CALL file(0): GOTO Cm10
IF PEEK(&H17) = 64 THEN LOCATE 1, 1: PRINT "Cups"
IF PEEK(&H17) = 32 THEN LOCATE 1, 6: PRINT "Num"
IF PEEK(&H17) = 96 THEN LOCATE 1, 1: PRINT "Cups": LOCATE 1, 6: PRINT "Num"
IF PEEK(&H17) = 128 THEN LOCATE 1, 12: PRINT "Insert"
IF PEEK(&H17) = 16 THEN LOCATE 1, 32: PRINT "Scroll Lock"


IF a$ <> "" THEN
IF ASC(a$) > 31 AND ASC(a$) < 123 AND ASC(a$) <> 13 THEN
CALL Scu(y, x)
LOCATE y, x: PRINT a$
x = x + 1
v$ = v$ + a$
CALL Scu(y, x)
END IF

IF a$ = CHR$(0) + CHR$(75) OR a$ = CHR$(8) THEN
IF LEN(v$) < 1 THEN SOUND 300, .1: GOTO Dlkm
CALL Scu(y, x)
x = x - 1
LOCATE y, x: PRINT " "
v$ = LEFT$(v$, LEN(v$) - 1)
CALL Scu(y, x)
Dlkm:
END IF
IF a$ = CHR$(13) THEN CALL Scu(y, x): Nput$ = v$: GOTO Cm23
IF a$ = CHR$(27) THEN CALL Scu(y, x): Nput$ = "": GOTO Cm23
IF a$ = CHR$(9) THEN CALL Scu(y, x): Nput$ = "": GOTO Cm23
END IF

GOTO Cm10
Cm23:
END FUNCTION

SUB OFF.the.SYSTEM
CALL Ssc
FOR x = 4 TO 74 STEP 3
FOR y = 4 TO 10 STEP 4
a$ = INKEY$
IF a$ = " " THEN GOTO Ye10
ix = INT(RND * 74) + 3: ky = INT(RND * 10) + 4
iy = INT(RND * 10) + 4: kx = INT(RND * 74) + 3
lx = INT(RND * 74) + 3: my = INT(RND * 10) + 4
ly = INT(RND * 10) + 4: mx = INT(RND * 74) + 3
LOCATE y, x: PRINT " ": LOCATE y + 2, x: PRINT " "
LOCATE y + 1, x: PRINT " ": LOCATE y + 3, x: PRINT " "

NEXT: NEXT
Ye10: IF INKEY$ <> "" THEN GOTO ye12
PSET (RND * 640, RND * 200), 1
PSET (RND * 640, RND * 200), 0
PSET (RND * 640, RND * 200), 0
PSET (RND * 640, RND * 200), 0
PSET (RND * 640, RND * 200), 0
ii = ii + 1

IF y = 0 AND ii < 80 THEN xx = RND * 640: yy = RND * 200: CIRCLE (xx, yy), 6, 1: y = 1
IF y = 1 AND ii > 80 THEN CIRCLE (xx, yy), 6, 0: y = 0: ii = 0: ll = 0

GOTO Ye10
ye12: CALL Lsc

END SUB

FUNCTION Orangemenu$ (x1, y1, Mag$, n, nn)
SHARED Dir$(), Volue
DIM ZXcur2(300)
s = LEN(Dir$(1))
ss = 2 + x1 + s + 1
sy = y1 + 1 + n + 1
'CALL wn(x1, y1, ss, sy)
dd = x1 + 2
sy2 = y1 + 1

FOR t = 1 TO n
LOCATE sy2 + t, dd
IF t <= nn THEN PRINT Dir$(t): k = k + 1 ELSE PRINT SPACE$(9)
NEXT

sss = x1 + (ss - x1) / 2 - LEN(Dir$(1)) / 2 + 2

'sss = x1 + INT(ss / 2) - INT(LEN(Mag$) / 2) - 4
'LOCATE y1, sss: PRINT CHR$(175); " "; Mag$; " "; CHR$(174)
'LOCATE y1 + 2, x1 + 2: PRINT Dir$(1)
g = 1: GOSUB eW2e
ERee: a$ = INKEY$
IF a$ = CHR$(0) + CHR$(80) THEN GOSUB eW1e: g = g + 1: GOSUB eW2e
IF a$ = CHR$(0) + CHR$(72) THEN GOSUB eW1e: g = g - 1: GOSUB eW2e
IF a$ = CHR$(13) THEN GOTO eOK2e
IF a$ = CHR$(9) THEN GOSUB eW1e: GOTO eOKe7
IF a$ = CHR$(27) THEN Orangemenu$ = "": GOTO eOKe7
GOTO ERee
eW1e: LOCATE y1 + 1 + g, x1 + 2: PRINT Dir$(g + Scr): RETURN
eW2e: GOSUB eERORSe:
GET ((x1 + 2) * 8 - 8, (y1 + 1 + g) * 8 - 8)-((x1 + 10) * 8 - 1, (y1 + 1 + g) * 8 - 1), ZXcur2
PUT ((x1 + 2) * 8 - 8, (y1 + 1 + g) * 8 - 8), ZXcur2, PRESET
'LOCATE y1 + 1 + g, x1 + 2: COLOR c3, c4: PRINT Dir$(g + Scr)
RETURN

eERORSe:
IF g < 1 AND k < n THEN g = 1

IF g < 1 AND k >= n THEN
Scr = Scr - 1
IF Scr < 0 THEN Scr = 0
GOSUB Scroll
g = 1
END IF
IF g > n AND g <= nn THEN
Scr = Scr + 1
IF Scr + n > nn - 1 THEN Scr = Scr - 1
GOSUB Scroll
g = n
END IF
IF g > nn THEN g = nn
RETURN

Scroll:
FOR t = 1 TO n
LOCATE y1 + 1 + t, dd: PRINT Dir$(t + Scr)
NEXT
RETURN
eeOK2e: END
eOK2e: Orangemenu$ = Dir$(g + Scr)
Volue = g + Scr
eOKe7:
END FUNCTION

SUB Pause
99998 IF INKEY$ = "" THEN GOTO 99998
END SUB

FUNCTION Pic.menu
SHARED oper(), operat
CALL Ssc
IF operat = 0 THEN
GET (143, 53)-(188, 162), oper
OPEN "C:QBPICTURENBASEMN2.BIN" FOR BINARY AS #6
FOR t = 0 TO 168
GET #6, , oper(t)
NEXT
CLOSE #6
operat = 56
END IF
x1 = 10: y1 = 3: x2 = 35: y2 = 19
CALL Lwin(x1, y1, x2, y2)
LOCATE y1, x1 + 2: PRINT "["; CHR$(254); "]"
LOCATE y1, x2 - 3: PRINT "["; CHR$(24); "]"
LOCATE y1 + 1, x1 + 2: PRINT " Основное МЕНЮ"
LOCATE y1 + 3, x1 + 2: PRINT "Сохранить"
LOCATE y1 + 5, x1 + 2: PRINT "Вызов "
LOCATE y1 + 7, x1 + 2: PRINT "Слияние "
LOCATE y1 + 9, x1 + 2: PRINT "Просмотр "
LOCATE y1 + 11, x1 + 2: PRINT "Помощь "
LOCATE y1 + 13, x1 + 2: PRINT "ДОС "
LOCATE y1 + 15, x1 + 2: PRINT "Меню "
PUT (180, 37), oper

REDIM NMv(20)
GET (211, 87)-(222, 97), NMv
PUT (211, 87), NMv
lx = 227: ly = 37: St = 16
PUT (lx, ly), NMv
KEY 1, "H"
East: a$ = INKEY$
IF a$ = "H" THEN BEEP: GOSUB Helpew: vb = 6
IF a$ = CHR$(0) + CHR$(80) THEN PUT (lx, x * St + ly), NMv: x = x + 1: GOSUB ERRos: PUT (lx, x * St + ly), NMv
IF a$ = CHR$(0) + CHR$(72) THEN PUT (lx, x * St + ly), NMv: x = x - 1: GOSUB ERRos: PUT (lx, x * St + ly), NMv
IF a$ = CHR$(13) AND vb <> 6 THEN GOTO Union
vb = 0
GOTO East
ERRos:
IF x < 0 THEN x = 6
IF x > 6 THEN x = 0
RETURN

Helpew:
OPEN "c:qbnwindowsNbase.hlp" FOR INPUT AS #3
WHILE a$ <> ""
LINE INPUT #3, a$
WEND
CALL Ssc2
CALL Lwin(7, 10, 50, 18)
LOCATE 10, 9: PRINT "["; CHR$(254); "]"
LOCATE 10, 47: PRINT "["; CHR$(24); "]"

FOR t = 1 TO x
FOR y = 1 TO 4
INPUT #3, a$
NEXT
NEXT
INPUT #3, a$: LOCATE 11, 9: PRINT " "; a$
INPUT #3, a$: LOCATE 13, 9: PRINT a$
INPUT #3, a$: LOCATE 14, 9: PRINT a$
INPUT #3, a$: LOCATE 15, 9: PRINT a$

CALL MErcan(9, 17, " Нажмите любую клавишу ..")
CLOSE #3
CALL Lsc2
RETURN
Union:
CALL Lsc
Pic.menu = x + 1
KEY 1, "Help " + CHR$(13)

END FUNCTION

SUB Pmw
CALL Ssc
CALL Lwin(6, 10, 24, 14)
LOCATE 11, 7: PRINT " Вы ошиблись"
LOCATE 13, 7: PRINT "Запишите заново.."
CALL Pause
CALL Lsc
END SUB

FUNCTION Pref$ (B$)
SHARED peaa$
d$ = j$(B$)
CLOSE : z = 1
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

'CALL Lwin(4, 4, 40, 12)
'LOCATE 5, 7: PRINT "Page #"; z, "Art - "; k$
'PRINT
'LOCATE 7, 6: PRINT "Name "; g$
GOTO Newks
'LOCATE 8, 6: PRINT "Peace "; Pea$
xxx = 0

'1CALL 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 Prices
SHARED gff
DIM gf$(3)
gf$(1) = " With out Prices "
gf$(2) = " With LFZ Prices "
gff = Neo.menu(35, 9, " Цены ", gf$(), 2) - 1

END SUB

SUB Printer
SHARED Printers, y(), ch$(), Amount()
CALL Ssc
CALL Lwin(10, 10, 60, 12)
CALL MErcan(11, 11, "Insert page and strike any key.(Esc to Cancle)")
LOCATE 11, 11: PRINT SPACE$(46)
IF Printers = 56 THEN CALL Lsc: GOTO Stoped2
LOCATE 11, 11: LINE INPUT "Atributes =>", a$
LOCATE 11, 11: PRINT SPACE$(LEN(a$) + 12)
d = 30 - INT(LEN(a$) 2)
ON ERROR GOTO 920
LPRINT CHR$(14); SPACE$(d); a$

LPRINT CHR$(14)
FOR t = 1 TO y(Active)
LPRINT CHR$(14); ch$(t, Active)
NEXT
LPRINT CHR$(14); " ----------"
LPRINT CHR$(14); " "; Amount(Active)
LPRINT CHR$(14); ""
LPRINT CHR$(14); ""
LPRINT CHR$(14); "Seller _________ Buyer _________ Date _______ "
SOUND 1000, 8: LOCATE 11, 11: PRINT " Printing Completed ": SLEEP (2): CALL Lsc: LOCATE 10, 6: PRINT " "
Stoped2:


END SUB

FUNCTION qn$ (B$)
k$ = "C:/B2"
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

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 Scroll.READ
SHARED ch$(), y(), Amount(), vindov(), vindov2(), qa(), qc(), qd()
uu = y(Active)
IF uu = 1 THEN BEEP: LOCATE 10, 6: PRINT " Illegal.Can't Read..": FOR t = 1 TO 150: NEXT: LOCATE 10, 6: PRINT " ": GOTO y30
Limit = uu: n = uu: kl = 1
ch$(uu + 1, Active) = " "
GET (0, 0)-(630, 31), vindov2
PUT (0, 0), vindov, PSET
FOR t = 100 TO 500 STEP 200
LINE (t, 3)-(t + 50, 30), 0, BF
LINE (t, 3)-(t + 50, 30), 1, B
NEXT
REDIM r$(3)
r$(1) = "ALT + w": r$(2) = "ALT + r": r$(3) = "ALT + c"
FOR t = 0 TO 400 STEP 200
LINE ((t 8) * 8 + 7, 6)-((t 8) * 8 + 71, 18), 0, BF
LINE ((t 8) * 8 + 7, 6)-((t 8) * 8 + 71, 18), 1, B
r = r + 1: LOCATE 2, (t 8) + 2: PRINT r$(r)
NEXT

PUT (105, 9), qa, PSET: PUT (303, 4), qc, PSET: PUT (501, 4), qd, PSET

Y10:

LOCATE 5, 30, 0: PRINT CHR$(16); " Line - "; n - 1; " "; CHR$(17)
LOCATE 8, 6, 0: PRINT ch$(n, Active); SPACE$(68 - LEN(ch$(n, Active)))
LOCATE 9, 6, 0: PRINT ch$(n + 1, Active); SPACE$(68 - LEN(ch$(n + 1, Active)))
LOCATE 10, 6, 0: PRINT ch$(n + 2, Active); SPACE$(68 - LEN(ch$(n + 2, Active)))
CALL Scur(8, 5 + kl)
y20: n$ = INKEY$
IF n$ = CHR$(0) + CHR$(72) THEN n = n - 1: GOSUB E: GOTO Y10
IF n$ = CHR$(0) + CHR$(80) THEN n = n + 1: GOSUB E: GOTO Y10
IF n$ = CHR$(0) + CHR$(73) THEN n = n - 10: GOSUB E: GOTO Y10
IF n$ = CHR$(0) + CHR$(81) THEN n = n + 10: GOSUB E: GOTO Y10
IF n$ = CHR$(0) + CHR$(75) THEN CALL Scur(8, 5 + kl): kl = Set.LOC(5, kl): CALL Scur(8, 5 + kl)
IF n$ = CHR$(0) + CHR$(77) THEN CALL Scur(8, 5 + kl): kl = Set.LOC(4, kl): CALL Scur(8, 5 + kl)
IF n$ = CHR$(0) + CHR$(17) THEN CALL Scur(8, 5 + kl): LOCATE 8, 5 + kl: k$ = Cletters$(kl, n): GOTO Y10
IF n$ = CHR$(0) + CHR$(46) THEN
CALL Ssc2
CALL Lwin(30, 8, 73, 11)
LOCATE 10, 31: PRINT ">"
LOCATE 9, 31: PRINT " * Calculator * "
CALL Calculator
CALL Lsc2
END IF
IF n$ = CHR$(0) + CHR$(19) THEN
Lamount = Amount(Active)
FOR t = 2 TO y(Active)
AAmount = VAL(MID$(ch$(y, Active), 57, 9))
Amount(Active) = Amount(Active) + AAmount
NEXT
IF Lamount = Amount(Active) THEN CALL Gov(35, 19, "Правильно ") ELSE CALL Gov(35, 19, "Ошибка ")
CALL Pause
LOCATE 19, 36: PRINT "Итог "; Amount(Active); " "
END IF
IF n$ = CHR$(25) THEN
CALL Scur(8, 5 + kl)
LOCATE 8, 5: PRINT STRING$(LEN(ch$(n, Active)) + 2, 178)
AAmount = VAL(MID$(ch$(n, Active), 57, 9))

FOR t = n TO y(Active)
ch$(t, Active) = ch$(t + 1, Active)
NEXT
ch$(t, Active) = ""
AAmount = VAL(MID$(ch$(n, Active), 57, 9))
Amount(Active) = Amount(Active) - AAmount
y(Active) = y(Active) - 1: Limit = Limit - 1
IF Limit < 2 THEN GOTO y30
GOSUB E
LOCATE 19, 36: PRINT "Итог "; Amount(Active); " "
GOTO Y10
END IF
IF n$ = CHR$(13) OR n$ = CHR$(27) THEN GOTO y30
GOTO y20
E:
IF n < 2 THEN n = 2
IF n > Limit THEN n = Limit
RETURN
y30:



END SUB

SUB Scrolling (n, x, x2, y, y2, Trot)
SHARED Edit$(), Limon
x1 = 1 + x: y1 = y + 1
IF n < 1 THEN n = 1
IF n > Limon THEN n = Limon
IF Trot < 0 THEN Trot = 0
LOCATE y + 1, x + 4: PRINT CHR$(16); " "; n; " "; CHR$(17)
FOR t = y1 + 1 TO y2 - 1'17
dd = dd + 1
f$ = MID$(Edit$(dd + n - 1), Trot + 1, x2 - x1 - 1)
LOCATE t, x1 + 1: PRINT f$; SPACE$(x2 - x1 - 1 - LEN(f$))'LEFT$(Edit$(dd + n - 1), x2 - x1 - 1) + SPACE$(x2 - x1 - 1 - LEN(LEFT$(Edit$(dd + n - 1), x2 - x1 - 1)))
NEXT
END SUB

SUB Scu (y, x)
SHARED v()
GET (x * 8 - 8, y * 8 - 8)-(x * 8 + 3, y * 8 - 1), v
PUT (x * 8 - 8, y * 8 - 8), v, PRESET

END SUB

SUB Scur (y, x)
SHARED v()
GET (x * 8 - 8, y * 8 - 8)-(x * 8 + 7, y * 8 - 1), v
PUT (x * 8 - 8, y * 8 - 8), v, PRESET

END SUB

FUNCTION Set.LOC (MP, i)
jk = i
n = 1: Names = 7: Pcs = 33: Price = 39: Qty = 48: Amount = 57
IF i = 1 AND MP = 4 THEN i = 7: GOTO E3
IF i = Names AND MP = 4 THEN i = Pcs: GOTO E3
IF i = Pcs AND MP = 4 THEN i = Price: GOTO E3
IF i = Price AND MP = 4 THEN i = Qty: GOTO E3
IF i = Qty AND MP = 4 THEN i = Amount: GOTO E3
IF i = Amount AND MP = 4 THEN i = n: GOTO E3

IF i = Amount AND MP = 5 THEN i = Qty: GOTO E3
IF i = Qty AND MP = 5 THEN i = Price: GOTO E3
IF i = Price AND MP = 5 THEN i = Pcs: GOTO E3
IF i = Pcs AND MP = 5 THEN i = Names: GOTO E3
IF i = Names AND MP = 5 THEN i = n: GOTO E3
IF i = n AND MP = 5 THEN i = Amount: GOTO E3
'LOCATE 1, 1: PRINT jk; i; MP
E3:
Set.LOC = i

END FUNCTION

SUB Seven.up
SHARED Fil, Dir, Fil$(), Dir$(), Drive$, PathSpec$, NMerc$
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 PRINT Dir$(t) ELSE PRINT SPACE$(9)
NEXT

West46: ll = 1:
'LOCATE 5, 34 - INT(LEN(Drive$ + PathSpec$) / 2): PRINT Drive$ + PathSpec$
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 LOCATE y + 5, i + 10: PRINT Fil$(qnn + y + nn) ELSE LOCATE y + 5, i + 10: PRINT " "

NEXT
qnn = qnn + 11
NEXT

GOSUB Q246
Start46: a$ = INKEY$
IF a$ <> "" AND MID$(a$, 1, 1) = CHR$(0) THEN
Merc$ = ClearSpace$(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 THENCALL DEF.usr2(3): NMerc$ = "": GOTO Stoping
IF a$ = CHR$(9) THEN
i$ = Orangemenu$(4, 4, "", 10, Dir)
IF i$ = "" THEN CALL DEF.usr2(3): NMerc$ = "": GOTO Stoping
IF i$ = "" THEN GOTO Start46
IF MID$(i$, 1, 8) = ".. " THEN PathSpec$ = ClearSlash$(PathSpec$): Dir = 0: GOTO Stoping
PathSpec$ = PathSpec$ + ClearSpace$(MID$(i$, 1, 8)) + ""
GOSUB Q246
GOTO Stoping
END IF
IF a$ = CHR$(13) AND u <> 0 THEN
NMerc$ = Drive$ + PathSpec$ + ClearSpace$(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:
LOCATE 5 + u, 21: PRINT Fil$(nn + u)
RETURN

Q246:
GET (21 * 8 - 8, (5 + u) * 8 - 8)-(33 * 8 - 1, (5 + u) * 8 - 1), ZXcur
PUT (21 * 8 - 8, (5 + u) * 8 - 8), ZXcur, PRESET
'COLOR 7, 0: LOCATE 5 + u, 11: PRINT Fil$(nn + u): COLOR 0, 7
RETURN
Stoping:



END SUB

SUB Spec.Small
CALL Ssc
CLS
CALL wind(5, 5, 75, 9)
CALL wind(5, 6, 75, 9)
x = 5: xx = 75
FOR t = 1 TO 37 STEP 7
CLS :
x = x + 7: xx = xx - 7
CALL wind(x, 5, xx, 9)
CALL wind(x, 6, xx, 9)
NEXT
CALL Pause
CALL Lsc
END SUB

SUB Speed
SHARED bv$(), Sp

bv$(1) = " Быстрая "
bv$(2) = " Средняя "
bv$(3) = " Медленная "
y = Neo.menu(35, 9, " Скорость ", bv$(), 3)
IF y = 1 THEN Sp = 0
IF y = 2 THEN Sp = 10
IF y = 3 THEN Sp = 40
LOCATE 10, 6: PRINT " "
END SUB

SUB Ssc
DEF SEG = &HB800
BSAVE "c:qbpicturenbase.grf", &H0, &H4000
END SUB

SUB Ssc2
DEF SEG = &HB800
BSAVE "c:qbpicturenbase2.grf", &H0, &H4000
END SUB

SUB Text.Editor
x1 = 5: y1 = 5: x2 = 75: y2 = 19
REDIM f$(1150), tcur(10), tcuri(16)
CALL Ssc
path$ = Autodir$
CALL Lsc
a = FREEFILE
OPEN path$ FOR INPUT AS #a
WHILE NOT EOF(a)
i = i + 1: LINE INPUT #a, f$(i)
WEND
CLOSE #a
CALL Lwin(x1, y1, x2, y2)
LOCATE y1, x1 + 3: PRINT "[" + CHR$(254) + "]": LOCATE y1, x2 - 3: PRINT "[" + CHR$(24) + "]"
Dt = INT((x2 - x1) / 2) + 2 + x1
LOCATE y1, Dt: PRINT "[ ]"
LOCATE y1, x1 + 9: PRINT "["; " "; path$; " "; "]"
LOCATE y1, x2 - 19: PRINT "[ Overwrite ]"
LOCATE 7, 7: PRINT CHR$(219)
GET (6 * 8, 6 * 8)-(7 * 8, 7 * 8), tcur
LINE (6 * 8, 6 * 8)-(7 * 8, 7 * 8 - 4), 0, BF
GET (6 * 8, 6 * 8)-(7 * 8, 7 * 8), tcuri
PUT (6 * 8, 6 * 8), tcur, PRESET
GOSUB TE1
x = 1: y = 1
GOSUB Tput
Tstart:
a$ = INKEY$
IF a$ <> "" THEN

IF a$ = CHR$(0) + CHR$(83) THEN
IF x + TX > LEN(f$(TY + y)) THEN
g$ = f$(TY + y) + f$(TY + y + 1)
FOR t = TY + y TO i
f$(t) = f$(t + 1)
NEXT
f$(t) = ""
f$(TY + y) = g$
GOSUB Tput
GOSUB TE1
GOSUB Tput
GOTO Tstart
END IF

h$ = MID$(f$(y + TY), x + TX + 1, LEN(f$(y + TY)) - (x + TX))
IF (x + TX - 2) > -1 THEN i$ = MID$(f$(y + TY), 1, x + TX - 1) ELSE GOTO twt
f$(y + TY) = i$ + h$
GOSUB Tput
GOSUB TE2
GOSUB Tput
END IF


IF a$ = CHR$(8) THEN
IF LEN(f$(y + TY)) < x + TX THEN f$(y + TY) = f$(y + TY) + SPACE$(x + TX - LEN(f$(y + TY)))
h$ = MID$(f$(y + TY), x + TX, LEN(f$(y + TY)) - (x + TX) + 1)
IF (x + TX - 2) > -1 THEN i$ = MID$(f$(y + TY), 1, x + TX - 2) ELSE GOTO twt
f$(y + TY) = i$ + h$
GOSUB Tput
x = x - 1
GOSUB Terry2
GOSUB TE2
GOSUB Tput
twt:
END IF

IF a$ = CHR$(25) THEN
FOR t = TY + y TO i
f$(t) = f$(t + 1)
NEXT
f$(t) = ""
GOSUB Tput
LOCATE 5 + y, 6: PRINT STRING$(63, 219)
GOSUB TE1
GOSUB Tput
i = i - 1
END IF
IF a$ = CHR$(13) THEN
IF LEN(f$(y + TY)) < x + TX THEN f$(y + TY) = f$(y + TY) + SPACE$(x + TX - LEN(f$(y + TY)))

IF x + TX = 1 OR MID$(f$(y + TY), 1, x + TX) = SPACE$(x + TX) THEN
FOR t = i + 1 TO y + TY + 1 STEP -1
f$(t) = f$(t - 1)
NEXT
f$(y + TY) = ""
END IF
IF x + TX > 1 THEN
FOR t = i TO y + TY + 2 STEP -1
f$(t) = f$(t - 1)
NEXT
t$ = MID$(f$(y + TY), x + TX, LEN(f$(y + TY)) - (x + TX))
i$ = MID$(f$(y + TY), 1, x + TX - 1)
f$(TY + y) = i$
f$(TY + y + 1) = t$
x = 1: TX = 0
END IF

GOSUB Tput
y = y + 1
GOSUB Terry2
GOSUB TE1
GOSUB Tput
i = i + 1
END IF

IF ASC(a$) >= 32 AND ASC(a$) <= 125 THEN
LOCATE y1, Dt + 1: PRINT "*": Dt2 = 1
IF ins = 0 THEN
IF LEN(f$(y + TY)) < x + TX THEN f$(y + TY) = f$(y + TY) + SPACE$(x + TX - LEN(f$(y + TY)))
MID$(f$(y + TY), x + TX, 1) = a$
GOSUB Tput
LOCATE 5 + y, 5 + x: PRINT a$
x = x + 1
GOSUB Terry2
GOSUB Tput
END IF


IF ins = 1 THEN
IF LEN(f$(y + TY)) < x + TX THEN f$(y + TY) = f$(y + TY) + SPACE$(x + TX - LEN(f$(y + TY)))
h$ = MID$(f$(y + TY), x + TX, LEN(f$(y + TY)) - (x + TX) + 1)
i$ = MID$(f$(y + TY), 1, x + TX - 1)
f$(y + TY) = i$ + a$ + h$
GOSUB Tput
x = x + 1
GOSUB Terry2
GOSUB TE2
GOSUB Tput
END IF
END IF
END IF
IF a$ = CHR$(0) + CHR$(79) THEN
forint = LEN(f$(TY + y))
IF forint <= x2 - x1 THEN GOSUB Tput: x = forint: GOSUB Tput
IF forint > x2 - x1 THEN GOSUB Tput: k = INT(forint / (x2 - x1)): TX = k * (x2 - x1): x = forint - k * (x2 - x1): GOSUB Terry2: GOSUB TE1: GOSUB Tput
END IF

IF a$ = CHR$(0) + CHR$(71) THEN
forint = LEN(f$(TY + y)): GOSUB Tput
FOR t = 1 TO x2 - x1
fori = fori + 1
IF MID$(f$(TY + y), t, 1) <> " " THEN GOTO TE14
NEXT
TE14: x = fori:
IF forint > x2 - x1 THEN IF fori > x2 - x1 THEN TX = fori - 1: x = 1: GOSUB TE1 ELSE TX = 1: GOSUB TE1
GOSUB Tput: fori = 0
END IF
IF a$ = CHR$(0) + CHR$(75) THEN GOSUB Tput: x = x - 1: GOSUB Terry2: GOSUB Tput
IF a$ = CHR$(0) + CHR$(77) THEN GOSUB Tput: x = x + 1: GOSUB Terry2: GOSUB Tput
IF a$ = CHR$(0) + CHR$(72) THEN GOSUB Tput: y = y - 1: GOSUB Terry: GOSUB Tput
IF a$ = CHR$(0) + CHR$(80) THEN GOSUB Tput: y = y + 1: GOSUB Terry: GOSUB Tput
IF a$ = CHR$(0) + CHR$(73) THEN GOSUB Tput: TY = TY - 13 + y: y = 1: GOSUB Terry: GOSUB Tput
IF a$ = CHR$(0) + CHR$(81) THEN GOSUB Tput: TY = TY + 13 - y: y = 1: GOSUB Terry: GOSUBGOSUB Tput
IF a$ = CHR$(27) THEN
REDIM Neo$(4)
Neo$(1) = " Save ": Neo$(2) = " Save As..": Neo$(3) = "Don't Save": Neo$(4) = " Continue."
er = Neo.menu(5, 10, "File has been modificated ", Neo$(), 4)
IF er = 1 THEN GOSUB Tsave: GOTO Tend
IF er = 2 THEN path$ = Dir.LIST$: GOSUB Tsave: GOTO Tend
IF er = 3 THEN GOTO Tend
IF er = 4 THEN GOTO Tstart
END IF

IF a$ = CHR$(0) + CHR$(82) THEN
GOSUB Tput
IF ins = 0 THEN ins = 1: LOCATE y1, x2 - 17: PRINT "Insert " ELSE ins = 0: LOCATE y1, x2 - 17: PRINT "Overwrite "
GOSUB Tput
END IF
GOTO Tstart

TE1:
FOR t = 1 TO 13
LOCATE 5 + t, 6
IF LEN(f$(TY + y)) <= 68 THEN PRINT MID$(f$(t + TY), 1 + TX, 68) + SPACE$(68 - LEN(MID$(f$(t + TY), 1 + TX, 68))) ELSE PRINT MID$(f$(t + TY), 1 + TX, 68)
NEXT
RETURN
TE2:
LOCATE 5 + y, 6: PRINT MID$(f$(y + TY), 1 + TX, 68) + SPACE$(68 - LEN(MID$(f$(y + TY), 1 + TX, 68)))
RETURN
Tput: IF ins = 0 THEN PUT ((x + 5) * 8 - 8, (y + 5) * 8 - 8), tcur
IF ins = 1 THEN PUT ((x + 5) * 8 - 8, (y + 5) * 8 - 8), tcuri
RETURN
Terry:
IF y < 1 THEN
y = 1
IF TY <> 0 THEN TY = TY - 1: GOSUB TE1
END IF
IF y > 13 THEN
IF TY <> i + 13 THEN TY = TY + 1: GOSUB TE1
y = 13
END IF
RETURN
Terry2:
IF x < 1 THEN
x = 1
IF TX <> 0 THEN TX = TX - 1: GOSUB TE1
END IF
IF x > 68 THEN
TX = TX + 1: GOSUB TE1
x = 68
END IF
RETURN
Tsave:
OPEN path$ FOR OUTPUT AS #4
FOR tt = 1 TO i
PRINT #4, f$(tt)
NEXT
RETURN
Tend: CALL Lsc

END SUB

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 wind (x1, y1, x2, y2)
LINE ((x1 - 1) * 8, (y1 - 1) * 8 + 4)-(x2 * 8, y2 * 8), 1, B
LINE ((x1 - 1) * 8 - 2, (y1 - 1) * 8 + 2)-(x2 * 8 + 2, y2 * 8 + 2), 1, B
END SUB


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