用了一上午的时间用QB写了一个DOS弹球游戏,
已经调试过了,没问题。源代码如下:
'弹球游戏
'2键左移 6键右移 0键退出(^_^)
SCREEN 12
type RECT
x1 as integer
y1 as integer
full as integer
end type
dim rec(10,3)
dim box(10,3) as RECT
dim w1,h1,bx,by,dx,dy,cont,befull
dim nowxp as integer,xpos as integer, ypos as integer
w1=64:h1=48:bx=320:by=445:dx=6:dy=6:nowxp=280:befull=0
for i=0 to 9
for j=0 to 2
rec(i,j)=0
box(i,j).x1=0
box(i,j).y1=0
box(i,j).full=0
xpos=i*w1
ypos=j*h1
next j,i
do
a$=Inkey$
bx=bx-dx
by=by-dy
if bx<=20 then dx=-dx
if bx>=620 then dx=-dx
if by<=20 then dy=-dy
if by>=460 then call win(1)
if by>=445 and bx>=nowxp+20 and bx<=nowxp+80 and by<=465 then dy=-dy
for i=1 TO 13:circle (bx,by),i,0:next
for i=1 TO 6:circle (bx,by),i,15:next
for i=0 to 9
for j=0 to 2
xpos=i*w1
ypos=j*h1
if rec(i,j)=0 then
line (xpos+1,ypos+1)-(xpos+w1-1,ypos+h1-1),i+2,BF
end if
if box(i,j).full=1 then
box(i,j).y1=box(i,j).y1+3:if box(i,j).y1>=480 then box(i,j).full=0
line (box(i,j).x1,box(i,j).y1-4)-(box(i,j).x1+w1,box(i,j).y1+h1),black,BF
line (box(i,j).x1,box(i,j).y1)-(box(i,j).x1+w1,box(i,j).y1+h1),7,BF
end if
if by<=ypos+h1 and by>=ypos then
if bx>=xpos+32 and bx<=xpos+64 then
if rec(i,j)=0 then
dx=-dx
end if
end if
end if
if bx>=xpos+12 and bx<=xpos+42 and by<=ypos+56 and by>=ypos+12 then
if rec(i,j)=0 then
cls
dy=-dy
rec(i,j)=rec(i,j)+1
box(i,j).x1=xpos
box(i,j).y1=ypos
box(i,j).full=1
cont=cont+1
if cont>=27 then call win(0)
end if
end if
if by<=ypos+h1 and by>=j*6 then
if bx>=i*w1-6 and bx<=i*w1 then
if rec(i,j)=0 then
dx=-dx
end if
end if
end if
next j,i
select case a$
case "4"
nowxp=nowxp-12
if nowxp<=6 then nowxp=6
case "6"
nowxp=nowxp+12
if nowxp>=560 then nowxp=560
end select
call ball(nowxp)
sound 40, 1
loop until a$="0"
sub ball(xp as integer)
line (xp-20,458)-(xp+100,480),0,BF
line (xp,460)-(xp+80,480),11,BF
end sub
sub win(idx as integer)
cls
for i=1 to 5
locate 15, 30
color i
if idx=0 then
print "ALLRIGHT! You WIN!"
else
print "GAME OVER!"
end if
sleep 1
next i
end
end sub
已经调试过了,没问题。源代码如下:
'弹球游戏
'2键左移 6键右移 0键退出(^_^)
SCREEN 12
type RECT
x1 as integer
y1 as integer
full as integer
end type
dim rec(10,3)
dim box(10,3) as RECT
dim w1,h1,bx,by,dx,dy,cont,befull
dim nowxp as integer,xpos as integer, ypos as integer
w1=64:h1=48:bx=320:by=445:dx=6:dy=6:nowxp=280:befull=0
for i=0 to 9
for j=0 to 2
rec(i,j)=0
box(i,j).x1=0
box(i,j).y1=0
box(i,j).full=0
xpos=i*w1
ypos=j*h1
next j,i
do
a$=Inkey$
bx=bx-dx
by=by-dy
if bx<=20 then dx=-dx
if bx>=620 then dx=-dx
if by<=20 then dy=-dy
if by>=460 then call win(1)
if by>=445 and bx>=nowxp+20 and bx<=nowxp+80 and by<=465 then dy=-dy
for i=1 TO 13:circle (bx,by),i,0:next
for i=1 TO 6:circle (bx,by),i,15:next
for i=0 to 9
for j=0 to 2
xpos=i*w1
ypos=j*h1
if rec(i,j)=0 then
line (xpos+1,ypos+1)-(xpos+w1-1,ypos+h1-1),i+2,BF
end if
if box(i,j).full=1 then
box(i,j).y1=box(i,j).y1+3:if box(i,j).y1>=480 then box(i,j).full=0
line (box(i,j).x1,box(i,j).y1-4)-(box(i,j).x1+w1,box(i,j).y1+h1),black,BF
line (box(i,j).x1,box(i,j).y1)-(box(i,j).x1+w1,box(i,j).y1+h1),7,BF
end if
if by<=ypos+h1 and by>=ypos then
if bx>=xpos+32 and bx<=xpos+64 then
if rec(i,j)=0 then
dx=-dx
end if
end if
end if
if bx>=xpos+12 and bx<=xpos+42 and by<=ypos+56 and by>=ypos+12 then
if rec(i,j)=0 then
cls
dy=-dy
rec(i,j)=rec(i,j)+1
box(i,j).x1=xpos
box(i,j).y1=ypos
box(i,j).full=1
cont=cont+1
if cont>=27 then call win(0)
end if
end if
if by<=ypos+h1 and by>=j*6 then
if bx>=i*w1-6 and bx<=i*w1 then
if rec(i,j)=0 then
dx=-dx
end if
end if
end if
next j,i
select case a$
case "4"
nowxp=nowxp-12
if nowxp<=6 then nowxp=6
case "6"
nowxp=nowxp+12
if nowxp>=560 then nowxp=560
end select
call ball(nowxp)
sound 40, 1
loop until a$="0"
sub ball(xp as integer)
line (xp-20,458)-(xp+100,480),0,BF
line (xp,460)-(xp+80,480),11,BF
end sub
sub win(idx as integer)
cls
for i=1 to 5
locate 15, 30
color i
if idx=0 then
print "ALLRIGHT! You WIN!"
else
print "GAME OVER!"
end if
sleep 1
next i
end
end sub