hxs.bas

中学化学CAI制作平台 (QB4.5+简体字库)

hz$ = "二氧化碳"
h16 334, 198, 16, hz$
sy "(", 404, 200, 0
hz$ = "气泡"
h16 412, 198, 16, hz$
sy ",", 445, 199, 0
hz$ = "它使澄清石灰水变浑浊"
h16 452, 198, 16, hz$
sy ")", 610, 200, 0
hz$ = "反应方程式": COLOR 13
h16 300, 220, 16, hz$
sy ":", 385, 224, 0
hz$ = "碱式碳酸铜": COLOR 10
h16 320, 260, 16, hz$
sy "____", 403, 256, 0
sy ">", 430, 262, 0
hz$ = "加热"
h16 400, 252, 16, hz$
hz$ = "氧化铜"
h16 440, 260, 16, hz$
sy "+", 493, 260, 0
hz$ = "水"
h16 502, 260, 16, hz$
sy "+", 524, 260, 0
hz$ = "二氧化碳"
h16 540, 260, 16, hz$
hz$ = "我们把这种变化时都生成了其它物质的": COLOR 1
h16 340, 290, 16, hz$
hz$ = "变化叫做化学变化"
h16 315, 310, 16, hz$
waiting
music 4
pcls 1
PUT (13, 308), arr
PUT (13, 368), arr
GOTO beging
RETURN
Ending: END

FUNCTION arrow
null$ = CHR$(0)
DO
 a$ = INKEY$
LOOP WHILE a$ = ""
SELECT CASE a$
CASE null$ + CHR$(75)
     arrow = -1
CASE null$ + CHR$(77)
     arrow = 1
CASE null$ + CHR$(72)
     arrow = 2
CASE null$ + CHR$(80)
     arrow = -2
CASE CHR$(13)
     arrow = 0
END SELECT
END FUNCTION

SUB Bcolor (n, p1, p2, p3)
IF n > 4 THEN pal n, p1, p2, p3
END SUB

SUB bubble (x1, y1, y11, x2, y2, y21, x3, y3, y31)
 Y10 = y1: y20 = y2: y30 = y3
 LOCATE 28, 15: PRINT CHR$(248)
 GET (113, 433)-(117, 437), bm

 PUT (113, 433), bm

FOR i = 1 TO 10

a$ = INKEY$
 y1 = y1 - RND * 10: IF y1 <= y11 THEN y1 = Y10
 y2 = y2 - RND * 10: IF y2 <= y21 THEN y2 = y20
 y3 = y3 - RND * 10: IF y3 <= y31 THEN y3 = y30
     PUT (x1, y1), bm
     PUT (x2, y2), bm
     PUT (x3, y3), bm
time 15
     PUT (x1, y1), bm
     PUT (x2, y2), bm
     PUT (x3, y3), bm
NEXT i

END SUB

SUB bubble1 (x1, y1, y11, x2, y2, y21, x3, y3, y31)
Y10 = y1: y20 = y2: y30 = y3
 LOCATE 28, 15: PRINT CHR$(248)
 GET (113, 433)-(117, 437), bm
 PUT (113, 433), bm

FOR i = 1 TO 4
 a$ = INKEY$
 y1 = y1 - RND * 10: IF y1 <= y11 THEN y1 = Y10
 y2 = y2 - RND * 10: IF y2 <= y21 THEN y2 = y20
 y3 = y3 - RND * 10: IF y3 <= y31 THEN y3 = y30
     PUT (x1, y1), bm
     PUT (x2, y2), bm
     PUT (x3, y3), bm
     time 15
     PUT (x1, y1), bm
     PUT (x2, y2), bm
     PUT (x3, y3), bm
NEXT i


END SUB

SUB co
FOR i = 0 TO 15
x = 101 + i * 20
LINE (x, 30)-STEP(10, 15), i, BF
COLOR 2
sy STR$(i), x - 7, 46, 0
NEXT i
LINE (195, 27)-STEP(0, 18), 1
END SUB

SUB colorpal
pal 5, .5, .5, .5
pal 6, .6, .6, .6
pal 7, .8, .8, .8
pal 8, .5, .4, .9
pal 9, 1, 1, 1
pal 10, 0, 0, 1
pal 11, 0, 1, 0
pal 12, 0, 0, 0
pal 13, 1, 0, 1
pal 14, 0, 1, 1
pal 15, 1, .6, .3
'*** Fix Pal 0,1,2,3 ***
pal 0, .7, .7, .7    'Back Color
pal 1, .4, .4, .4    'Photo Color
pal 2, 1, 0, 0       'Red word
pal 3, .8, .8, 0     'Yellow word
pal 4, .3, .3, .3    'Border Color
END SUB

SUB gas (x1, y1, x2, y2)
 LOCATE 28, 15: PRINT CHR$(177)
 GET (112, 436)-(114, 440), bm
 PUT (112, 436), bm
 LINE (110, 430)-STEP(10, 17), 0, BF
dx = x2 - x1 - 8: dy = y1 - y2 - 8
FOR s = 1 TO 5
x = x1 + RND * dx: y = y1 - RND * dy
  PUT (x, y), bm
  PUT (x, y), bm
NEXT s
END SUB

SUB getxyq
DIM ms(100)
LINE (100, 100)-STEP(20, 0), 1
LINE (100, 100)-STEP(0, 20), 1
GET (100, 100)-(120, 120), ms
PUT (100, 100), ms
x = x1: y = y1
PUT (x, y), ms
re: z = arrow
PUT (x, y), ms
SELECT CASE z
CASE 1
x = x + 1
CASE -1
x = x - 1
CASE 2
y = y - 1
CASE -2
y = y + 1
CASE 0
GOTO qd1
END SELECT
PUT (x, y), ms
GOTO re
qd1: x1 = x: y1 = y
LINE (100, 120)-STEP(20, 0), 1
LINE -(120, 100), 1
GET (100, 100)-(120, 120), ms
PUT (100, 100), ms
x = x + 80: y = y + 80
PUT (x, y), ms
re1: z = arrow
PUT (x, y), ms
SELECT CASE z
CASE 1
x = x + 1
CASE -1
x = x - 1
CASE 2
y = y - 1
CASE -2
y = y + 1
CASE 0
GOTO qd2
END SELECT
PUT (x, y), ms
GOTO re1
qd2: x2 = x + 20: y2 = y + 20
LINE (x1 - 2, y1 - 2)-(x2 + 2, y2 + 2), 1, B
GET (x1, y1)-(x2, y2), bm
DEF SEG = VARSEG(bm(0))
LOCATE 27, 5: PRINT "                                     "
LOCATE 27, 5: INPUT "file Name:"; a$
a$ = a$ + ".xyq"
BSAVE a$, VARPTR(bm(0)), 14000
PUT (300, 150), bm, PSET

END SUB

SUB h16 (x6, y6, bb, hz$)
DIM hd(30)
lenHz = LEN(hz$): ttn = lenHz \ 2
FOR i = 1 TO lenHz STEP 2
a$ = MID$(hz$, i, 1)
cod1 = ASC(a$) - 160
a$ = MID$(hz$, i + 1, 1)
cod2 = ASC(a$) - 160
hd(i \ 2 + 1) = cod1 * 100 + cod2
NEXT i
OPEN "CCLIBJ.DOT" FOR RANDOM AS #1 LEN = 32
px = x6: py = y6: pt = 256!
FOR tt = 1 TO ttn
cod = hd(tt)
qn = INT(cod / 100): wn = cod - qn * 100
 L% = (qn - 14) * 94 + wn + 658
FIELD #1, 32 AS a$
GET #1, L%
FOR j = 0 TO 31 STEP 2
m$ = MID$(a$, j + 1, 1)
dt1% = ASC(m$)
mi$ = MID$(a$, j + 2, 1)
dt2% = ASC(mi$)
dt% = VAL("&H" + HEX$(dt1% * pt + dt2%))
IF dt% <> -32768 THEN LINE (px, py + j \ 2)-(px + 15, py + j \ 2), , , dt%: GOTO 344
 PSET (px, py + j \ 2)
344 NEXT j
px = px + bb
NEXT tt
CLOSE #1
END SUB

SUB h24 (x6, y6, bb, hz$, hzk$, mode)
DIM hd(30)
lenHz = LEN(hz$): ttn = lenHz \ 2
FOR i = 1 TO lenHz STEP 2
a$ = MID$(hz$, i, 1)
cod1 = ASC(a$) - 160
a$ = MID$(hz$, i + 1, 1)
cod2 = ASC(a$) - 160
hd(i \ 2 + 1) = cod1 * 100 + cod2
NEXT i
OPEN hzk$ FOR RANDOM AS #1 LEN = 72
px = x6: py = y6
 FOR tt = 1 TO ttn
     cod = hd(tt)
code1 = INT(cod / 100): code2 = cod - code1 * 100
L% = (code1 - 16) * 94 + code2
FIELD #1, 72 AS a$
GET #1, L%
FOR j = 0 TO 70 STEP 3
m$ = MID$(a$, j + 1, 1)
dt1% = ASC(m$)
mi$ = MID$(a$, j + 2, 1)
dt2% = ASC(mi$)
mi1$ = MID$(a$, j + 3, 1)
dt3% = ASC(mi1$)
dd1% = VAL("&H" + HEX$(dt1% + dt2 + dt3))
dd2% = VAL("&H" + HEX$(dt2 + dt2% + dt3))
dd3% = VAL("&H" + HEX$(dt3 + dt2 + dt3%))
LINE (px + j / 3, py)-(px + j / 3, py + 23), , , dd1%
py1 = py + 8: py2 = py + 16
LINE (px + j / 3, py1)-(px + j / 3, py1 + 23), , , dd2%
LINE (px + j / 3, py2)-(px + j / 3, py2 + 23), , , dd3%
NEXT j
IF mode = 1 THEN
   py = py + bb
ELSE
    px = px + bb
END IF
NEXT tt
CLOSE #1
END SUB

SUB mouse (x, y)
PUT (x, y), mous
DO
x1 = x: y1 = y
z = arrow
SELECT CASE z
 CASE 1
   x = x + 7
 CASE -1
   x = x - 7
 CASE 2
   y = y - 7
 CASE -2
   y = y + 7
 CASE 0
   EXIT DO
END SELECT
IF x > 618 THEN x = 618
IF x < 8 THEN x = 8
IF y > 440 THEN y = 440
IF y < 20 THEN y = 20
PUT (x1, y1), mous
PUT (x, y), mous
'LOCATE 5, 40: PRINT x, y
LOOP WHILE 1
PUT (x, y), mous
END SUB

SUB move (x1, y1, x2, y2, step1)
IF x2 < x1 THEN step1 = -step1
dy = (y2 - y1) * step1 / (x2 - x1)
PUT (x1, y1), bm
y = y1
FOR x = x1 TO x2 STEP step1
  y = y + dy
  PUT (x, y), bm
  time 1
  PUT (x, y), bm
NEXT x
PUT (x2, y2), bm
END SUB

SUB music (n)
SELECT CASE n
CASE 1
   FOR ixt = 440 TO 1000 STEP 100
   SOUND ixt, ixt / 1000
   NEXT
CASE 2
  PLAY "L18FD"
CASE 3
  PLAY "L18GA"
CASE 4
 FOR i = 2000 TO 1000 STEP -20
 SOUND i, .5
 NEXT
END SELECT
END SUB

SUB pal (n, r!, g!, B!)
r& = r! * 63!
g& = g! * 63!
B& = B! * 63!
shad& = r& + g& * 256& + B& * 65536
PALETTE n, shad&
END SUB

SUB pcls (n)
SELECT CASE n
CASE 0
  LINE (100, 20)-(618, 458), 0, BF
CASE 1
  FOR i = 1 TO 259
  IF i > 181 THEN
  LINE (359 + i, 64)-(359 + i, 408), 1
  LINE (358 + i, 64)-(358 + i, 408), 0
  LINE (540, 408)-(540, 458), 0
 ELSE
  LINE (359 + i, 64)-(359 + i, 458), 1
  LINE (358 + i, 64)-(358 + i, 458), 0
 END IF
  LINE (359 - i, 64)-(359 - i, 458), 1
  LINE (360 - i, 64)-(360 - i, 458), 0
  NEXT i
CASE 2
  FOR i = 1 TO 20
  x = 100 + RND * 460: y = 20 + RND * 379
  LINE (x, y)-STEP(8, 8), 0, BF
  x = 100 + RND * 460: y = 20 + RND * 379
  LINE (x, y)-STEP(30, 10), 0, BF
  x = 100 + RND * 460: y = 20 + RND * 379
  LINE (x, y)-STEP(10, 10), 0, BF
  x = 100 + RND * 460: y = 20 + RND * 379
  LINE (x, y)-STEP(20, 20), 0, BF
  time 0
  NEXT i
  LINE (100, 20)-(618, 458), 0, BF
END SELECT
END SUB

SUB photo (x, y, name$, mode)
DEF SEG = VARSEG(bm(0))
BLOAD name$, VARPTR(bm(0))
IF mode = 1 THEN
   PUT (x, y), bm, PSET
ELSE
   PUT (x, y), bm
END IF
END SUB

SUB photose (x1, y1, x2, y2, n)
FOR x = x1 TO x2
FOR y = y1 TO y2
IF POINT(x, y) = 1 THEN PSET (x, y), n
NEXT y, x
END SUB

SUB rota (x0, y0, x1, y1, x2, y2, set, bb)
set = set * 3.14 / 180
FOR x = x1 TO x2
FOR y = y1 TO y2
 IF POINT(x, y) = 1 THEN
    r = SQR((x - x0) * (x - x0) + (y - y0) * (y - y0))
    fai = ATN((y - y0) / (x - x0))
    x10 = x0 + r * COS(fai - set) + bb
    Y10 = y0 + r * SIN(fai - set)
    PSET (x10, Y10)
  END IF
NEXT y
NEXT x
END SUB

SUB sol (x1, y1, x2, y2, yp, xp)
y = y1
DO
x3 = x1
y = y + yp
IF y > y2 THEN EXIT DO
  DO
  x3 = x3 + RND * 7
  x4 = x3 + RND * 5
  IF x4 < x2 THEN
  LINE (x3, y)-(x4, y)
  ELSE
  EXIT DO
  END IF
  x3 = x4
  LOOP WHILE 1
yp = yp * 1.01
x2 = x2 - x2 * xp
LOOP WHILE 1
END SUB

SUB surface
SCREEN 12
colorpal
LINE (0, 0)-(638, 478), 4, BF
LINE (0, 0)-(638, 478), 0, B
LINE (100, 20)-(618, 458), 0, BF
hz$ = "初中化学实验": COLOR 3
h24 35, 40, 40, hz$, "HZK24H", 1
photo 540, 410, "chemstry.XYQ", 1
END SUB

SUB sy (a$, x, y, mode)
LOCATE 28, 15: PRINT a$
x2 = 8 * LEN(a$) - 1
IF mode = 0 THEN
   FOR x1 = 112 TO x2 + 112
   FOR y1 = 432 TO 446
   dd1 = POINT(x1, y1): IF dd1 = 0 THEN GOTO sy11
   PSET (x1 + x - 112, y1 - 432 + y), dd1
sy11: NEXT y1, x1
ELSE
   FOR x1 = 112 TO x2 + 112
   FOR y1 = 432 TO 446
   dd1 = POINT(x1, y1): IF dd1 = 0 THEN GOTO sy12
   PSET (y1 - 432 + x, y + 112 - x1), dd1
sy12: NEXT y1, x1
END IF
LINE (112, 432)-STEP(x2, 14), 0, BF
END SUB

SUB time (sec)
a01 = TIMER
DO
IF TIMER - a01 > sec * .01 THEN EXIT DO
LOOP WHILE 1
END SUB

SUB waiting
a$ = INPUT$(1)
END SUB

SUB xg
x = 300: y = 200: st = 1
tpi: DO: a$ = INKEY$
LOOP WHILE a$ = ""
SELECT CASE a$
 CASE "i"
  y = y - st
 CASE "m"
  y = y + st
 CASE "j"
   x = x - st
 CASE "k"
  x = x + st
 CASE "h"
 st = 10
 CASE "l"
 st = 1
 CASE "s"
   END
END SELECT
PSET (x1, y1), 15
PSET (x, y), 4
LOCATE 22, 1: PRINT "x:"; x; "y:"; y
x1 = x: y1 = y
GOTO tpi

END SUB