QB源码

一：out 的示例

'这是个对调色板进行out的示例，也可以用palette实现，不过慢得厉害

'QB4.5   WINDOWSXP下通过，VGA                      

' IROII   2005/9/28

cls

randomize timer

screen 13

for i=0 to 255 step 2

             line (0,i)-(639,i*2),i/2,bf

next

do

            if inkey$=chr$(27) then end

           q=int(rnd*256)

           for i=0 to 255

                      out &h3c8,i

                      out &h3c9,q and &hff       'b

                      out &h3c9,q+i and &hff    'g

                       out &h3c9,q-i and &hff     'r

            next

loop while inkey$<>chr$(27)

二：汉字显示（需要HZK16库）

'这是个显示汉字的程序，点阵；注意为了节省时间没写任何可以判断错误的语句，所以第5行那里一定
'要是汉字，而且HZK16一定要放在QB文件目录下  

  'QB4.5   WINDOWSXP下通过              

' IROII   2005/9/30
DECLARE SUB hanzi (x!, y!, a$, col!)
CLS
OPEN "hzk16" FOR BINARY AS #1
SCREEN 12
hanzi 50, 50, "这里是你要显示的汉字", 10
END

SUB hanzi (x, y, a$, col)
 x0 = x: y0 = y
 FOR n = 1 TO LEN(a$)
  quhao = ASC(MID$(a$, n, 1))
  n = n + 1
  weihao = ASC(MID$(a$, n, 1))
  ps& = ((quhao - 161) * 94& + weihao - 161) * 32& + 1
  SEEK #1, ps&
  zimo$ = INPUT$(32, 1)
  m = 1
  FOR yy = 0 TO 15
   ch1$ = MID$(zimo$, m, 1)
   m = m + 1
   ch2$ = MID$(zimo$, m, 1)
   m = m + 1
   ch3$ = ch2$ + ch1$
   LINE (x, y + yy)-STEP(15, 0), col, , CVI(ch3$)
  NEXT yy
  x = x + 16
 NEXT n
 x = x0: y = y0
END SUB

三：256色BMP显示

'QB4.5   WINDOWSXP下通过                   

' IROII   2005/9/28

REM 我没有做边界检查，注意图片不要大于320*200

DIM w AS LONG, h AS LONG, t1 AS INTEGER, t2 AS LONG
DIM dataweizhi AS LONG   '图象DATA开始的位置

main:
start:  'SCREEN 0
 CLS
 INPUT "输入256色BMP文件全名，注意文件名必须正确格式，否则将导致无法预料的结果:", filename$
 OPEN filename$ FOR BINARY AS #1
 SEEK #1, 1
 IF INPUT$(2, #1) <> "BM" THEN GOTO exitt
 GET #1, 19, w
 GET #1, 23, h
 GET #1, 11, dataweizhi
 dataweizhi = dataweizhi + 1
 GET #1, 29, t1
 IF t1 <> 8 THEN GOTO exitt
 GET #1, 31, t2
 IF t2 <> 0 THEN GOTO exitt
 
readandsetpalette:
 SCREEN 13
 OUT &H3C6, 255
 DIM p(1 TO 4) AS INTEGER
 FOR i = 0 TO 255
  SEEK #1, 55 + 4 * i
  p(1) = int(ASC(INPUT$(1, #1))/4)
  SEEK #1, 56 + 4 * i
  p(2) = int(ASC(INPUT$(1, #1))/4)
  SEEK #1, 57 + 4 * i
  p(3) = int(ASC(INPUT$(1, #1))/4)
  '下面的是掩码         
  SEEK #1, 58 + 4 * i
  p(4) = ASC(INPUT$(1, #1))
  OUT &H3C8, i
  OUT &H3C9, p(1)
  OUT &H3C9, p(2)
  OUT &H3C9, p(3)
 NEXT
 ERASE p

DATA:
 
 DIM col AS INTEGER
 i = 0
 FOR y = 0 TO h - 1
  FOR x = 0 TO 639
   SEEK #1, dataweizhi + i
   IF x >= w THEN
    col = 0
   ELSE
    i = i + 1
    col = ASC(INPUT$(1, #1))
   END IF
   PSET (x, 200 - y), col
  NEXT x
  dataweizhi = dataweizhi + w
  i = 0
 NEXT y
  
exitt:   END

四 下面是我的一次作业

注意：（在QB45，WINDOWS XP，VGA，17寸显示器下通过测试）

 1：此文件夹必须命名为zuoye而且必须放在D：/下（因为由于内存限制，采用程序的连接实现菜单。）

      是4个txt文件：rukou.txt  2ddemo.txt   3ddemo.txt    gamedemo.txt（需要一张256BMP，命名为1.bmp）

 2：需要qb.bi，将它也放在D：/下（以支持鼠标）,如果你的QB根目录下没有，就把这个文件夹里的那个
    拖过去。
 3：rukou.txt 是入口程序，需要从MS-DOS下以qb/l命令启动，F5运行就可以。
 4：使用'WSAD'这4个键移动，回车进入选项。

一些不足与BUG：
      1：rukou.txt中按钮的字色不好调整，由于PUT语句的使用，我不清楚用OR还是XOR，但2个都不能令人满意
      2：gamedemo.txt是使用鼠标操纵红球躲避白球的游戏。其中为了省事我没有对红球移动速度做限制，因此当快速
 移动鼠标时红球移动发生跳跃，即在碰撞测试前跳过过远距离，可以算是个BUG。
      3：2ddemo.txt是个2D图形演示。我加入了256色BMP的显示，OUT控制端口实现渐变色，任意汉字的显示（使用HZK16字库）。
 其中的SUB ldb是显示BMP的，但它对有些256色BMP可以正确显示，有些不行，我找不出原因。
      4: 3ddemo.txt是个3D图形演示。这个程序的跳出方法是时间或键盘控制。这个程序计算波动方程时非常非常卡，FPS才0.3
 左右，使得完全没有水波的感觉，写得比较失败的程序。
 

           2005-11-4     iroii

rukou.txt 

REM 这是第一个文件，请保存为rukou.txt，放在zuoye文件夹中

DECLARE SUB xj (aj AS INTEGER)
DECLARE SUB initaj (dise AS INTEGER, gse AS INTEGER, dse AS INTEGER, x AS INTEGER, y AS INTEGER, wz AS INTEGER, aj AS INTEGER)
REM 整个程序的入口，DOS下以命令行QB/L启动
REM 2005-11-3    iroii
SCREEN 12
CLS
getzimo:
DIM SHARED gamedemo(1 TO 616)  AS INTEGER
PRINT "GAMEDEMO"
GET (0, 0)-(64, 16), gamedemo
CLS
DIM SHARED demo3d(1 TO 544) AS INTEGER
PRINT "3DDEMO"
GET (0, 0)-(48, 16), demo3d
CLS
DIM SHARED demo2d(1 TO 544) AS INTEGER
PRINT "2DDEMO"
GET (0, 0)-(48, 16), demo2d
CLS
DIM SHARED quitt(1 TO 544) AS INTEGER
PRINT "QUit"
GET (0, 0)-(48, 16), quitt
CLS

initdata:
TYPE pt
 x AS INTEGER
 y AS INTEGER
 wz AS INTEGER
END TYPE
DIM SHARED anjian(1 TO 4) AS pt
DIM SHARED aj AS INTEGER
aj = 1
DIM SHARED col1 AS INTEGER, col2 AS INTEGER
col1 = 15: col2 = 8
check = 0

initmenu:
anjian(1).x = 190: anjian(1).y = 140: anjian(1).wz = 10
anjian(2).x = 290: anjian(2).y = 140: anjian(2).wz = 19
anjian(3).x = 190: anjian(3).y = 190: anjian(3).wz = 19
anjian(4).x = 290: anjian(4).y = 190: anjian(4).wz = 28
'initaj 8, col1, col2, anjian(1).x, anjian(1).y, anjian(1).wz, 1
initaj 8, col1, col2, anjian(2).x, anjian(2).y, anjian(2).wz, 2
initaj 8, col1, col2, anjian(3).x, anjian(3).y, anjian(3).wz, 3
initaj 8, col1, col2, anjian(4).x, anjian(4).y, anjian(4).wz, 4
xj 1
main:
DO
 k$ = INKEY$
 SELECT CASE k$
 CASE CHR$(119), CHR$(115)
  'PRINT aj
  initaj 8, col1, col2, anjian(aj).x, anjian(aj).y, anjian(aj).wz, aj
      
  SELECT CASE aj
  CASE 1
   aj = 3
  CASE 2
   aj = 4
  CASE 3
   aj = 1
  CASE 4
   aj = 2
  END SELECT
  xj aj
  'PRINT anjian(aj).x; anjian(aj).y; aj
 CASE CHR$(97), CHR$(100)
  initaj 8, col1, col2, anjian(aj).x, anjian(aj).y, anjian(aj).wz, aj
  SELECT CASE aj
  CASE 1
   aj = 2
  CASE 2
   aj = 1
  CASE 3
   aj = 4
  CASE 4
   aj = 3
  END SELECT
  xj aj
 CASE CHR$(13)
  check = 1
  EXIT DO
 END SELECT
LOOP WHILE k$ <> CHR$(27)
IF check = 1 THEN
 IF aj = 1 THEN CHAIN "d:/zuoye/gamedemo.txt"
 IF aj = 2 THEN CHAIN "d:/zuoye/2ddemo.txt"
 IF aj = 3 THEN CHAIN "d:/zuoye/3ddemo.txt"
END IF
exitt:  END

SUB initaj (dise AS INTEGER, gse AS INTEGER, dse AS INTEGER, xx AS INTEGER, yy AS INTEGER, wz AS INTEGER, aj AS INTEGER)
 LINE (xx, yy)-(xx + 84, yy + 24), gse, B
 PAINT (xx + 2, yy + 2), dise, gse
 IF aj = 2 THEN PUT (xx + wz, yy + 4), demo2d, OR
 IF aj = 1 THEN PUT (xx + wz, yy + 4), gamedemo, OR
 IF aj = 3 THEN PUT (xx + wz, yy + 4), demo3d, OR
 IF aj = 4 THEN PUT (xx + wz, yy + 4), quitt, OR
 LINE (xx, yy + 24)-(xx + 84, yy + 24), dse
 LINE (xx + 84, yy)-(xx + 84, yy + 24), dse
END SUB

SUB xj (a AS INTEGER)
 initaj 8, col2, col1, anjian(a).x, anjian(a).y, anjian(a).wz, a
END SUB

2ddemo.txt 

REM 这是2ddemo.txt,放在zuoye下

DECLARE SUB delay (t!)
DECLARE SUB hanzi (x!, y!, a$, col!)
DECLARE SUB ldb (filn$)
REM 2ddemo
REM 2005-10-5   iroii

start:
SCREEN 0
LOCATE 11, 39
COLOR 10
PRINT "2DDEMO"
LOCATE 2, 5
delay 2.5

main:
CLS
filename$ = "d:/zuoye/1.bmp"
ldb filename$
tim = TIMER
DO
LOOP WHILE TIMER < 1 + tim
t = 0
OUT &H3C6, 255
DO
 FOR i = 0 TO 255
  OUT &H3C7, i
  r = INP(&H3C9)
  g = INP(&H3C9)
  b = INP(&H3C9)
  'PRINT r; g; b
  IF r > 0 THEN r = r - 1
  IF g > 0 THEN g = g - 1
  IF b > 0 THEN b = b - 1
  OUT &H3C8, i
  OUT &H3C9, r
  OUT &H3C9, g
  OUT &H3C9, b
 NEXT
 delay .05
 t = t + 1
LOOP WHILE t < 70
SCREEN 9, , 1, 0
CLS
OPEN "d:/zuoye/hzk16" FOR BINARY AS #1
t = 0
DO
 t = t + 2
 hanzi 180, 200 - t, "以前看了黑客帝国", 10
 IF t > 20 THEN hanzi 180, 220 - t, "电影开始时的那个画面给我很深的印象", 10
 IF t > 40 THEN hanzi 180, 240 - t, "我做了这个程序模拟一下", 10
 IF t > 60 THEN hanzi 180, 260 - t, "做的很粗糙只搏一笑", 10
 PCOPY 1, 0
 delay .15
 CLS
LOOP WHILE t < 100
tim = TIMER
DO
LOOP WHILE TIMER < 1.5 + tim
OUT &H3C6, 255
FOR i = 0 TO 63
 OUT &H3C8, 0
 OUT &H3C9, 0
 OUT &H3C9, i
 OUT &H3C9, 0
 delay .05
NEXT

initjuzhen:
RANDOMIZE TIMER
DIM ch(1 TO 1840) AS INTEGER
DIM sd(1 TO 80)  AS INTEGER
DIM temp(1 TO 4) AS INTEGER
FOR i = 1 TO 80
 FOR j = 1 TO 23
  ch((j - 1) * 80 + i) = INT(RND * 200) + 15
 NEXT
 sd(i) = INT(RND * 3) + 2
NEXT
start2:
t = 0
COLOR 10
DO
 FOR i = 1 TO 80 STEP 2
  sd = sd(i)
  FOR k = 1 TO sd
   temp(k) = ch((23 - k) * 80 + i)
  NEXT
  FOR m = 23 TO sd + 1 STEP -1
   ch((m - 1) * 80 + i) = ch((m - sd) * 80 + i)
  NEXT
  FOR m = 1 TO sd STEP 1
   ch((m - 1) * 80 + i) = temp(sd - m + 1)
  NEXT
 NEXT
 OUT &H3C7, 0
 r = INP(&H3C9)
 g = INP(&H3C9)
 b = INP(&H3C9)
 IF g > 0 THEN
  g = g - 1
  OUT &H3C8, 0
  OUT &H3C9, 0
  OUT &H3C9, g
  OUT &H3C9, 0
 END IF
 FOR i = 1 TO 80 STEP 2
  FOR j = 1 TO 23
   LOCATE j, i
   PRINT CHR$(ch((j - 1) * 80 + i))
  NEXT
 NEXT
 t = t + 1
 PCOPY 1, 0
 CLS
 delay .05
LOOP WHILE t < 120
ERASE ch, sd, temp

theend:
CLS
DIM r2  AS INTEGER, r3 AS INTEGER, sdu(1 TO 3) AS SINGLE
DIM a(1 TO 40) AS SINGLE
DIM bb(1 TO 40) AS SINGLE
DIM c(1 TO 40) AS SINGLE
pi = 3.1415926#: sdu(1) = .02: sdu(2) = -.02: sdu(3) = .01
 r2 = 90: r3 = 130
FOR i = 1 TO 40
 a(i) = (i - 1) * pi / 20
 bb(i) = a(i) - .05
 c(i) = a(i) + .05
NEXT
DO
 k$ = INKEY$
 hanzi 215, 170, "按回车退出，按空格重来一遍", 10
 FOR i = 1 TO 40
  PSET (INT(r3 * COS(bb(i))) + 320, INT(r2 * SIN(bb(i))) + 180), 2
  PSET (INT(r3 * COS(c(i))) + 320, INT(r3 * SIN(c(i))) + 180), 2
  a(i) = a(i) + sdu(1)
  bb(i) = bb(i) + sdu(2)
  c(i) = c(i) + sdu(3)
 NEXT
 PCOPY 1, 0
 CLS
LOOP WHILE k$ <> CHR$(13) AND k$ <> CHR$(32)
CLOSE #1
ERASE a, bb, c, sdu
IF k$ = CHR$(32) THEN GOTO start
IF k$ = CHR$(13) THEN CHAIN "d:/zuoye/rukou.txt"

exitt:  END

SUB delay (t)
 tim = TIMER
 DO
 LOOP WHILE TIMER < t + tim
END SUB

SUB hanzi (x, y, a$, col)
 x0 = x: y0 = y
 FOR n = 1 TO LEN(a$)
  quhao = ASC(MID$(a$, n, 1))
  n = n + 1
  weihao = ASC(MID$(a$, n, 1))
  ps& = ((quhao - 161) * 94& + weihao - 161) * 32& + 1
  SEEK #1, ps&
  zimo$ = INPUT$(32, 1)
  m = 1
  FOR yy = 0 TO 15
   ch1$ = MID$(zimo$, m, 1)
   m = m + 1
   ch2$ = MID$(zimo$, m, 1)
   m = m + 1
   ch3$ = ch2$ + ch1$
   LINE (x, y + yy)-STEP(15, 0), col, , CVI(ch3$)
  NEXT yy
  x = x + 16
 NEXT n
 x = x0: y = y0
END SUB

SUB ldb (filn$)
 OPEN filn$ FOR BINARY AS #1
 DIM w AS LONG, h AS LONG, t1 AS INTEGER, t2 AS LONG
 DIM dataweizhi AS LONG   '图象DATA开始的位置
 GET #1, 19, w
 GET #1, 23, h
 LOCATE 2, 10
 
 GET #1, 11, dataweizhi
 dataweizhi = dataweizhi + 1
 
readandsetpalette:
 SCREEN 13
 OUT &H3C6, 255
 DIM p(1 TO 4) AS INTEGER
 FOR i = 0 TO 255
  SEEK #1, 55 + 4 * i
  p(3) = INT(ASC(INPUT$(1, #1)) / 4)
  SEEK #1, 56 + 4 * i
  p(2) = INT(ASC(INPUT$(1, #1)) / 4)
  SEEK #1, 57 + 4 * i
  p(1) = INT(ASC(INPUT$(1, #1)) / 4)
  '下面的是掩码
  SEEK #1, 58 + 4 * i
  p(4) = ASC(INPUT$(1, #1))
  OUT &H3C8, i
  OUT &H3C9, p(1)
  OUT &H3C9, p(2)
  OUT &H3C9, p(3)
 NEXT
 ERASE p

viewbmp:
 
 DIM col AS INTEGER, ymin AS INTEGER
 IF h < 200 THEN ymin = h ELSE ymin = 200
 i = w * h - 1
 IF w >= 320 THEN
  FOR y = 0 TO ymin - 1
   FOR x = 0 TO 319
    SEEK #1, dataweizhi + i
    IF x = 0 THEN
     'i = i - w + 317
     col = ASC(INPUT$(1, #1))
     i = i - w + 317
    ELSE
     col = ASC(INPUT$(1, #1))
     i = i - 1
    END IF
    PSET (319 - x, y), col
   NEXT x
  NEXT y
       
 ELSE
  FOR y = 0 TO ymin - 1
   FOR x = 0 TO w - 1
    SEEK #1, dataweizhi + i
    col = ASC(INPUT$(1, #1))
    PSET (160 + INT(w / 2) - x, y), col
    i = i - 1
   NEXT x
   i = i - 2
  NEXT y
 END IF
 CLOSE #1
END SUB

3ddemo.txt

REM 这是3ddemo.txt，放在zuoye下

screen 0
locate 11,39
color 10
print "3DDEMO"
locate 10,37
delay 2

SCREEN 8, , 1, 0
CLS
demdata:
TYPE pts
 x AS INTEGER
 y AS INTEGER
 z AS INTEGER
END TYPE
DIM SHARED pt(1 TO 29, 1 TO 29) AS pts
DIM SHARED x, y, z, xa, ya, za, sx, sy, p15x, p15y'世界坐标，临时坐标，临时屏幕坐标，pt(15,15)坐标
DIM SHARED r1!, r2!, r3!           '分别绕Z,Y,X旋转的弧度
DIM SHARED cr1, cr2, cr3, sr1, sr2, sr3 '分别代表cos(r1!)...  sin(r1!)...等等
LET r1! = 0: LET r2! = 0: LET r3! = 0
DIM SHARED pyx AS INTEGER, pyy AS INTEGER'pt(15,15)与屏幕中心的偏移

initdata:
FOR i = 1 TO 29
 FOR j = 1 TO 29
  pt(i, j).x = (i - 1) * 20 + 1
  pt(i, j).y = (j - 1) * 8 + 1
  pt(i, j).z = 1
 NEXT
NEXT

main:
DIM SHARED tt AS INTEGER, fps AS SINGLE, ttt AS SINGLE, num AS INTEGER, n0 AS INTEGER
xianshi
t = 0: tt = 0: ttt = TIMER
DO
 'delay .1
 IF t >= 0 AND t < 800 THEN
  r3! = .007 + r3!
 END IF
 IF t >= 800 AND t < 1500 THEN
  r2! = .007 + r2!
 END IF
 IF t >= 1400 AND t < 1850 THEN
  r1! = .007 + r1!
 END IF
 IF t >= 1850 AND t < 1950 THEN
  r3! = -.005 + r3!
 END IF
 IF t >= 1950 AND t < 2050 THEN
  r2! = -.017 + r2!
 END IF
 'IF t = 2050 THEN
 '        r1! = 0: r2! = 0: r3! = 1.8
 'END IF
 xianshi
 t = t + 1
 IF t > 2050 THEN
  tt = tt + 1
  xianshi
  IF tt = 10 THEN EXIT DO
 END IF
LOOP WHILE INKEY$ = ""

CLS
COLOR 10
LOCATE 10, 36
PRINT "THE END"
PCOPY 1, 0
delay 2

CHAIN "d:/zuoye/rukou.txt"
END

SUB bodong
 IF tt <> 0 THEN
  ptx = pt(15, 15).x
  pty = pt(15, 15).y
  FOR i = 1 TO 29
   FOR j = 1 TO 29
    pt(i, j).z = 10 * COS((tt - SQR((pt(i, j).x - ptx) * (pt(i, j).x - ptx) + (pt(i, j).y - pty) * (pt(i, j).y - pty)) / 10) / 4)
   NEXT
  NEXT
 END IF
END SUB

SUB delay (t)
 tim = TIMER
 DO
 LOOP WHILE TIMER < tim + t
END SUB

SUB jd
 sr1 = SIN(r1!)
 sr2 = SIN(r2!)
 sr3 = SIN(r3!)
 cr1 = COS(r1!)
 cr2 = COS(r2!)
 cr3 = COS(r3!)
END SUB

SUB ty
 sy = INT(y + (p15y - y) * z / (z - 400))
 sx = INT(x + (p15x - x) * z / (z - 400))
END SUB

SUB xianshi
 
 n0 = n0 + 1
 jd
 x = pt(15, 15).x
 y = pt(15, 15).y
 z = pt(15, 15).z
 p15x = x
 p15y = y
 zh
 ty
 pyx = 320 - sx
 pyy = 100 - sy

 FOR i = 1 TO 29
  FOR j = 1 TO 29
   x = pt(i, j).x
   y = pt(i, j).y
   z = pt(i, j).z
   bodong
   zh
   ty
   PSET (pyx + sx, pyy + sy), 10
   'PRINT pyx + sx, pyy + sy, j
  NEXT j
 NEXT i
 WHILE TIMER - ttt > 1
  fps = (n0 - num) / (TIMER - ttt)
  num = n0
  ttt = TIMER
 WEND
 
 COLOR 15
 LOCATE 1, 60
 IF fps > 1 THEN
  PRINT "FPS="; fps
 ELSE
  PRINT "FPS=0"; fps
 END IF
 PCOPY 1, 0
 CLS
END SUB

SUB zh
 xa = cr1 * x - sr1 * z
 za = sr1 * x + cr1 * z
 x = cr2 * xa + sr2 * y
 ya = cr2 * y - sr2 * xa
 z = cr3 * za - sr3 * ya
 y = sr3 * za + cr3 * ya
END SUB

gamedemo.txt

REM 这是gamedemo.txt，要放在zuoye下

DECLARE FUNCTION pz% ()
DECLARE FUNCTION pd% (n AS INTEGER)
DECLARE SUB delay (t!)
DECLARE SUB shua (n%)
DECLARE SUB mouse (a%, b%, c%, d%)
DECLARE FUNCTION mouse.x! ()
DECLARE FUNCTION mouse.y! ()
rem 鼠标控制红球躲白球，开始是是40个球，每过一关加12个
rem 2005-11-4     iroii
'$INCLUDE: 'qb.bi'
SCREEN 0
CLS
LOCATE 12, 28
COLOR 10
PRINT "YOU CAN USE MOUSE TO PLAY"
tnow = TIMER
DO
LOOP WHILE TIMER < tnow + 4
CLS
LOCATE 12, 39
PRINT "3"
tnow = TIMER
DO
LOOP WHILE TIMER < tnow + 2
CLS
LOCATE 12, 39
PRINT "2"
tnow = TIMER
DO
LOOP WHILE TIMER < tnow + 2
CLS
LOCATE 12, 39
PRINT "1"
tnow = TIMER
DO
LOOP WHILE TIMER < tnow + 2

SCREEN 9, , 1, 0
CLS

init:
CIRCLE (100, 100), 5, 12
PAINT (100, 100), 14, 12
'LINE (98, 93)-(102, 95), 10, B
'LINE (93, 98)-(95, 102), 10, B
'LINE (105, 98)-(107, 102), 10, B
'LINE (98, 105)-(102, 107), 10, B
DIM ship(1 TO 124) AS INTEGER
GET (93, 93)-(107, 107), ship
CLS
CIRCLE (100, 100), 4, 7
PAINT (100, 100), 7
CIRCLE (101, 99), 1, 15
PAINT (101, 99), 15
DIM ball(1 TO 112) AS INTEGER
GET (96, 96)-(104, 104), ball
CLS
'PUT (100, 100), ship
'PUT (140, 100), ball
'PCOPY 1, 0

mouseinit:
mouse 0, 0, 0, 0
mouse 1, 0, 0, 0
Ma% = 0: MB% = 0
mouse Ma%, MB%, 0, 0
DIM SHARED Maa AS INTEGER, Mbb AS INTEGER
Maa = 0: Mbb = 0

ballinit:

TYPE fc
 jd AS SINGLE
 v AS INTEGER
 x AS INTEGER
 y AS INTEGER
END TYPE
TYPE vxy
 vx AS INTEGER
 vy AS INTEGER
END TYPE
DIM SHARED num AS INTEGER
start:
num = 10

nn = 4 * num
DIM SHARED qiu(1 TO nn) AS fc
DIM SHARED qiuex(1 TO nn) AS vxy
DIM SHARED lv AS INTEGER, ex AS INTEGER
lv = 1: ex = 1
DIM SHARED check AS INTEGER
DIM SHARED bx AS INTEGER, by AS INTEGER
check = 1
DIM pengzhuang AS INTEGER
pengzhuang = 0

main:

DO
 LOCATE 1, 15
 COLOR 14
 PRINT "LEVEL="; lv - 1
 'LOCATE 1, 50
 'PRINT "exp="; ex - 1
 LINE (94, 14)-(536, 320), 15, B
 
 IF check = 1 THEN
  ex = ex + 1
  IF ex MOD 3 = 2 THEN
   lv = lv + 1
   num = 15 + lv + 3
   ERASE qiu
   ERASE qiuex
   nn = 4 * num
   DIM SHARED qiu(1 TO nn) AS fc
   DIM SHARED qiuex(1 TO nn) AS vxy
  END IF
  shua num
 END IF
       
 Maa = (mouse.x * 2) / 3
 Mbb = (mouse.y * 5) / 6
 PUT (Maa + 95, Mbb + 15), ship, OR
 'LINE (Maa + 95, Mbb + 15)-(Maa + 109, Mbb + 29), 10, B

 FOR i = 1 TO 4 * num
  qiu(i).x = qiu(i).x + qiuex(i).vx
  qiu(i).y = qiu(i).y + qiuex(i).vy
  bx = qiu(i).x + 93: by = 319 - qiu(i).y
  IF bx > 93 AND bx < 521 AND by > 13 AND by < 305 THEN
   PUT (bx, by), ball, OR
  END IF
  pengzhuang = pz%
  IF pengzhuang = 1 THEN EXIT DO
  'PRINT qiu(i).x + 93; 319 - qiu(i).y
 NEXT
 check = pd%(num)
 
 PCOPY 1, 0
 CLS
LOOP WHILE INKEY$ <> CHR$(27)
LOCATE 10, 30
COLOR 10
PRINT "YOU LOSE THIS GAME!"
LOCATE 11, 25
PRINT "YOU CAN PRESS SPACE TO PLAY AGAIN"
LOCATE 12, 22
PRINT "AND,YOU CAN PRESS ESC TO QUIT THIS GAME"
LOCATE 13, 35
PRINT "PLAY AGAIN?"
PCOPY 1, 0
DO
 k$ = INKEY$
 IF k$ = CHR$(32) THEN GOTO again
LOOP WHILE k$ <> CHR$(27)
chain "d:/zuoye/rukou.txt"
exitt:   END

again:
 ERASE qiu
 ERASE qiuex
 GOTO start

SUB delay (t)
 tim = TIMER
 WHILE TIMER < t + tim
 WEND
END SUB

SUB mouse (a%, b%, c%, d%)
 DIM inr AS RegType, outr AS RegType
 inr.ax = a%
 inr.bx = b%
 inr.cx = c%
 inr.dx = d%
 INTERRUPT &H33, inr, outr
 a% = outr.ax
 b% = outr.bx
 c% = outr.cx
 d% = outr.dx
END SUB

FUNCTION mouse.x
 mouse 3, 0, x%, y%
 mouse.x = x%
END FUNCTION

FUNCTION mouse.y
 mouse 3, 0, x%, y%
 mouse.y = y%
END FUNCTION

FUNCTION pd% (n AS INTEGER)
 pd% = 1
 i = 1
 DO
  bx = qiu(i).x + 93: by = 319 - qiu(i).y
  IF bx > 93 AND bx < 521 AND by > 13 AND by < 305 THEN
   pd% = 0
   EXIT DO
  END IF
  i = i + 1
 LOOP WHILE i <= 4 * n
END FUNCTION

FUNCTION pz%
 pz% = 0
 IF bx > Maa + 93 AND bx < Maa + 103 AND by > Mbb + 5 AND by < Mbb + 23 THEN
  pz% = 1
 END IF
END FUNCTION

SUB shua (n%)
 RANDOMIZE TIMER
 FOR i = 1 TO n%
  qiu(i).y = 306
  qiu(i).x = INT(RND * 428)
  qiu(i).jd = RND + .25
  qiu(i).v = 4
 NEXT

 FOR i = n% + 1 TO 2 * n%
  qiu(i).x = 428
  qiu(i).y = INT(RND * 293) + 14
  qiu(i).jd = RND + .25
  qiu(i).v = 4
 NEXT

 FOR i = 2 * n% + 1 TO 3 * n%
  qiu(i).y = 14
  qiu(i).x = INT(RND * 428)
  qiu(i).jd = RND + .25
  qiu(i).v = 4
 NEXT

 FOR i = 3 * n% + 1 TO 4 * n%
  qiu(i).x = 0
  qiu(i).y = INT(RND * 293) + 14
  qiu(i).jd = RND + .25
  qiu(i).v = 4
 NEXT

 FOR i = 1 TO 4 * n%
  IF qiu(i).x < 221 THEN
   qiuex(i).vx = INT(qiu(i).v * COS(qiu(i).jd))
  ELSE
   qiuex(i).vx = -INT(qiu(i).v * COS(qiu(i).jd))
  END IF
  IF qiu(i).y < 103 THEN
   qiuex(i).vy = INT(qiu(i).v * SIN(qiu(i).jd))
  ELSE
   qiuex(i).vy = -INT(qiu(i).v * SIN(qiu(i).jd))
  END IF
 NEXT
END SUB