网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索

 
 
 
日一二三四五六
       
       
       
       
       
       

签到排名:今日本吧第个签到,

本吧因你更精彩,明天继续来努力!

本吧签到人数:0

一键签到
成为超级会员,使用一键签到
一键签到
本月漏签0次!
0
成为超级会员,赠送8张补签卡
如何使用?
点击日历上漏签日期,即可进行补签。
连续签到:天  累计签到:天
0
超级会员单次开通12个月以上,赠送连续签到卡3张
使用连续签到卡
06月03日漏签0天
qbasic吧 关注:823贴子:5,297
  • 看贴

  • 图片

  • 吧主推荐

  • 游戏

  • 0回复贴,共1页
<<返回qbasic吧
>0< 加载中...

QBasic写的DOS弹球游戏

  • 取消只看楼主
  • 收藏

  • 回复
  • blueglass2
  • 初级粉丝
    1
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
用了一上午的时间用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



登录百度账号

扫二维码下载贴吧客户端

下载贴吧APP
看高清直播、视频!
  • 贴吧页面意见反馈
  • 违规贴吧举报反馈通道
  • 贴吧违规信息处理公示
  • 0回复贴,共1页
<<返回qbasic吧
分享到:
©2025 Baidu贴吧协议|隐私政策|吧主制度|意见反馈|网络谣言警示