怎么用free pascal编游戏

怎么用freepascal编游戏,具体点能有教程的最好了。。。。。... 怎么用free pascal编游戏,具体点能有教程的最好了。。。。。 展开
 我来答
wwwxxxccc1347
2011-10-14 · TA获得超过248个赞
知道小有建树答主
回答量:165
采纳率:0%
帮助的人:185万
展开全部
要会用一些库,我同学遍了一个游戏,你看一看,
求最佳答案。
代码如下(代码有点长...):
program pkzhan;
uses gameunit,
{$ifdef Win32}
Windows,
WinCrt,
{$else}
Crt,
{$endif}
graph;
label 1,2;
type rec=record
x,y,s,d:real;
l,h:integer;
end;
rec2=record
x,y,zd,now:integer;
end;
const ht_begins:array[1..3,1..4]of integer
=((660,190,780,230),
(660,400,780,440),(660,610,780,650));
col:array[1..4]of integer
=(white,lightred,lightgreen,lightred);
var i,j,x,y,w,x1,y1,x2,y2,maxzds,hp,tj,score,cdd,cdd2,cdd3,zdss:longint;
gd,gm:integer;s1,s2:string;
zd:array[1..10000]of rec;
bz:array[1..1000]of rec2;
function cos90(m:real):real;
begin
cos90:=cos(m*pi/180);
end;
function sin90(m:real):real;
begin
sin90:=sin(m*pi/180);
end;
procedure drawstart;
begin
for i:=1 to 3 do
rectangle(ht_begins[i,1],ht_begins[i,2],ht_begins[i,3],ht_begins[i,4]);
moveto(705,205);
outtext('Play');
moveto(700,415);
outtext('Option');
moveto(705,625);
outtext('Exit');
end;
function min(a,b:longint):longint;
begin
if a>b then min:=b
else min:=a;
end;
function zfj:boolean;
begin
if trunc(sqrt(sqr(zd[i].x-x)+sqr(zd[i].y-y)))<=tj then zfj:=true
else zfj:=false;
end;
procedure newzd(l:integer);
begin
w:=random(100);
if w<=min(35,10+score div 1500)then
begin
w:=random(4)+1;
inc(maxzds);
case w of
1:
begin
zd[maxzds].y:=5;
zd[maxzds].x:=random(1430)+5;
zd[maxzds].s:=2+random*(sqrt(score)*0.002+2);
zd[maxzds].d:=random(180)+180;
end;
2:begin
zd[maxzds].y:=835;
zd[maxzds].x:=random(1430)+5;
zd[maxzds].s:=random*(sqrt(score)*0.002+2);
zd[maxzds].d:=random(180);
end;
3:begin
zd[maxzds].x:=5;
zd[maxzds].y:=random(830)+5;
zd[maxzds].s:=(2+sqrt(score)*0.002)*random;
zd[maxzds].d:=(random(180)+270)mod 360;
end;
4:begin
zd[maxzds].x:=1435;
zd[maxzds].y:=random(830)+5;
zd[maxzds].s:=(2+sqrt(score)*0.002)+random;
zd[maxzds].d:=random(180)+90;
end;
end;
zd[maxzds].l:=l;
if zd[maxzds].l=2 then
begin
zd[maxzds].h:=random(1000)+200;
end
else if zd[maxzds].l=4 then
begin
zd[maxzds].h:=random(300)+75;
end;
end;
end;
procedure flyzd;
var fj:integer;b:boolean;
jl,xx,xy:real;
begin
setcolor(black);
for i:=1 to maxzds do
begin
if zd[i].l<>4 then
line(round(zd[i].x),round(zd[i].y),round(zd[i].x),round(zd[i].y))
else
circle(round(zd[i].x),round(zd[i].y),2);
if zd[i].l=2 then
begin
jl:=sqrt(sqr(zd[i].x-x)+sqr(zd[i].y-y));
xx:=(x-zd[i].x)/jl;
xy:=(y-zd[i].y)/jl;
zd[i].x:=zd[i].x+xx*zd[i].s;
zd[i].y:=zd[i].y+xy*zd[i].s;
dec(zd[i].h);
if zd[i].h=0 then zd[i].s:=0;
end
else
begin
zd[i].y:=zd[i].y-zd[i].s*sin90(zd[i].d);
zd[i].x:=zd[i].x+zd[i].s*cos90(zd[i].d);
if zd[i].l<>4 then
begin
zd[i].d:=zd[i].d-6+12*random;
zd[i].s:=zd[i].s-0.3+0.6*random;
end;
end;
if(zd[i].x<0)or(zd[i].x>1440)or
(zd[i].y<0)or(zd[i].y>840)then
begin
zd[i].s:=0;
end
else
if zfj then
begin
if zd[i].l=3 then inc(hp)
else
if zd[i].l<>4 then dec(hp);
zd[i].s:=0;
end;
{setcolor(col[trunc(zd[i].l)]);
if zd[i].l=2 then
case zd[i].h of
801..1500:setcolor(lightred);
601..800:setcolor(red);
401..600:setcolor(lightgray);
201..400:setcolor(yellow);
101..200:setcolor(lightblue);
1..100:setcolor(blue);
end;
if zd[i].l<>4 then
line(round(zd[i].x),round(zd[i].y),round(zd[i].x),round(zd[i].y))
else
circle(round(zd[i].x),round(zd[i].y),2);}
end;
i:=1;
setcolor(black);
while i<=maxzds do
begin
if zd[i].s=0 then
begin
if zd[i].l=4 then
begin
circle(round(zd[i].x),round(zd[i].y),2);
inc(zdss);
bz[zdss].x:=round(zd[i].x);
bz[zdss].y:=round(zd[i].y);
bz[zdss].now:=0;
bz[zdss].zd:=random(550)+50;
end
else
line(round(zd[i].x),round(zd[i].y),round(zd[i].x),round(zd[i].y));
dec(maxzds);
zd[i]:=zd[maxzds+1];
end
else
begin
setcolor(col[trunc(zd[i].l)]);
if zd[i].l=2 then
case zd[i].h of
801..1500:setcolor(lightred);
601..800:setcolor(red);
401..600:setcolor(lightgray);
201..400:setcolor(yellow);
101..200:setcolor(lightblue);
1..100:setcolor(blue);
end;
if zd[i].l<>4 then
line(round(zd[i].x),round(zd[i].y),round(zd[i].x),round(zd[i].y))
else
circle(round(zd[i].x),round(zd[i].y),2);
inc(i);
end;
end;
setcolor(white);
end;
procedure flybz;
var i,j:integer;
begin
setcolor(black);
for i:=1 to zdss do
begin
circle(bz[i].x,bz[i].y,bz[i].now shr 2+1);
inc(bz[i].now);
end;
setcolor(yellow);
i:=1;
while i<=zdss do
begin
if bz[i].now=bz[i].zd then
begin
dec(zdss);
bz[i]:=bz[zdss+1];
end
else
begin
circle(bz[i].x,bz[i].y,bz[i].now shr 2+1);
inc(i);
end;
end;
end;
procedure gotoplay;
begin
cleardevice;
setmouseposition(720,420);
x:=720;
y:=420;
hp:=15;
score:=0;
tj:=5;cdd:=0;
while hp>0 do
begin
getmousestate(x,y,w);
setcolor(red);
circle(x,y,tj);
delay(20);
for i:=1 to min(100,random(trunc(sqrt(score))div 7+5))do
newzd(1);
if cdd=0 then
begin
//if random(100)<=30 then
for i:=1 to random(4)+1 do newzd(2);
cdd:=random(50)+10;
end
else dec(cdd);

if cdd2=0 then
begin
//if random(100)<=30 then
for i:=1 to random(3)+1 do newzd(3);
cdd2:=random(80)+10;
end
else dec(cdd2);
if cdd3=0 then
begin
for i:=1 to random(20)+1 do newzd(4);
cdd3:=random(160)+10;
end
else dec(cdd3);

flyzd;
flybz;
inc(score);
setcolor(black);
circle(x,y,tj);
tj:=min(12,5+trunc(sqrt(score))div 25);
str(score,s1);
moveto(0,0);
bar(0,0,300,20);
setcolor(white);
outtext('Score:'+s1);
moveto(0,10);
str(hp,s1);
outtext('Hp:'+s1);
str(sqrt(score)*0.002+2:0:4,s1);
outtext(' Max speed:'+s1);
str(maxzds,s1);
outtext(' Zds:'+s1);
end;
moveto(675,415);
str(score,s1);
outtext('Game over! Your score is:'+s1);
delay(3000);
end;
procedure options;
begin
cleardevice;
end;
begin
gd:=detect;
gm:=0;
{$ifdef Win32}
ShowWindow(GetActiveWindow,0);
{$endif}
initgraph(gd,gm,'C:\');
initmouse;
i:=0;j:=0;
randomize;
setviewport(0,0,getmaxx,getmaxy,clipoff);
clearviewport;
while true do
begin
drawstart;
x:=0;w:=0;
while x mod 2<>1 do
getmousestate(i,j,x);
for x:=1 to 3 do
if(i>ht_begins[x,1])and(i<ht_begins[x,3])and(j>ht_begins[x,2])and(j<ht_begins[x,4])
then w:=x;
case w of
1:
begin
cleardevice;maxzds:=0;
gotoplay;
cleardevice;
end;
2:options;
3:begin
moveto(660,655);
outtext('Are you sure you want to leave?');
moveto(660,665);
outtext('Yes No');
rectangle(660,665,685,675);
rectangle(695,665,720,675);
x1:=660;
y1:=665;
x2:=685;
y2:=675;
2:x:=0;
while x mod 2=0 do getmousestate(i,j,x);
if(i>660)and(i<685)and(j>665)and(j<675)then
goto 1
else
if(i>695)and(i<720)and(j>665)and(j<675)then
begin
cleardevice;
drawstart;
end
else goto 2;
end;
end;
end;
1:
closegraph;
donemouse;
end.
祥子194
2011-10-13
知道答主
回答量:8
采纳率:0%
帮助的人:5.8万
展开全部
这个问题太大了,要有一定编程基础~~~
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
我是陈水蛋
2011-10-22 · 超过13用户采纳过TA的回答
知道答主
回答量:164
采纳率:0%
帮助的人:114万
展开全部
我给你一些我自己编的游戏吧 !!http://good.gd/1708431.htm

有什么问题问我 qq:523213189
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
收起 更多回答(1)
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式