کسی میتونه این کارو انجام بده ؟

[alllallle]

کم برنامه بازی Minesweeper به زبان دلفی دارم ولی باید به زبان پاسکال تحویلش بدم کسی می تونه بهم کمک کنه ؟
---------------------------------------------------------------------------------------------

​

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, directdraw, ddutil, AppEvnts, ExtCtrls;

type
TForm1 = class(TForm)
ApplicationEvents1: TApplicationEvents;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure ApplicationEvents1Restore(Sender: TObject);
procedure ApplicationEvents1Deactivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
fdd:idirectdraw7;
fddsprimary:idirectdrawsurface7;//primary surface
fddsback:idirectdrawsurface7;//backbuffer surface
fddsbackground:idirectdrawsurface7;//background surface
fddsbackground1:idirectdrawsurface7;//additional background surfce
fddslevelch:idirectdrawsurface7;//level choice label surface
fddsbuildings:idirectdrawsurface7;//buildings surface
fddsplane:idirectdrawsurface7;//plane surface
fddsblow:idirectdrawsurface7;//blow surface
fddsbomb:idirectdrawsurface7;//bomb surface
fddslosewin:idirectdrawsurface7;//losewin surface

procedure errorout(hret: hresult; funcname:string);//direct draw error message procedure
procedure idle1(sender:tobject; var done:boolean);//main loop
function restoreall : hresult;//surfaces restoration function
function createsurf(fname:string):idirectdrawsurface7;//surface creationg function
procedure initlevel(lev1:byte);//level initialization
procedure constrcity();//city construction on the additional background surface
procedure constrbuild(ind1:word);//builsing construction on the additional background surface
function choprect(rectin:trect; position:tpoint):trect;//choping blitting rectangle to make sureit fits on the screen
function choppos(position:tpoint):tpoint;//making sure point of blitting is on the screen
public
{ Public declarations }
protected
procedure formsetcursor(var amsg:tmessage); message WM_SETCURSOR;//getting rid of windows cursor
end;

type wlabel = record
position:tpoint;
width,height:integer;
end;

//building segments record (used as a part of wbuilding record)
type wsegments = record
type1,height:byte;
position:tpoint;
drawrectt:trect;
drawrectprect;
end;

//building record
type wbuilding = record
type1,segmentsn,statustag:shortint;//(type of building, number of segments including roof, statustag 1-undamaged,2-damaged,3,destroyed)
width:byte;
positionx:word;
segments:array[1..30] of wsegments;
end;

//plane record
type wplane = record
position,auxpos,nosemxpos:tpoint;
width,height:integer;
frame,framenum,statustag,speed:byte;
drawrectt:trect;
drawrectprect;
crashtag:boolean;
end;

//blow record
type wblow = record
position:tpoint;
width,height:byte;
frame,framenum:byte;
statustag:byte;

drawrectt:trect;
drawrectprect;
end;

//bomb record
type wbomb = record
position,gridpos:tpoint;
height,width,statustag,speed:byte;
end;

//abtract type for building destruction
type wbuilddestr = record
statustag,segmentsblow,secsbcount,delay,delayc:integer;
position,posmx:tpoint;//position actual and on the matrix
end;

//lose and win label
type wlosewin = record
position:tpoint;
width,height:word;
condition:byte;//0-lose,1-win
drawrectt:trect;
drawrectprect;
end;
//--//

var
Form1: TForm1;
factive:boolean;//running flag
fps,fps1:word;//actual FPS (press "F" while game running)
showfps:shortint;//(-1-false,1-true)
wrkint:integer;//used to get a number of building types based on the buildings bitmap

screenidx:byte;//screen index (1-first screen, 2-game screen, 3-losewin screen)
levelch:wlabel;
leveln:byte;//(0-9)

//buildings
building:array[1..40] of wbuilding;
buildsnum:integer;//number of buildings
btypesnum:byte;
segstot:integer;
buildmx:array[0..39,0..29] of byte;//buildings matrix (holds the Y index of a segment, X index is the building index);

//plane
plane1:wplane;

//blow
blow:array[1..50] of wblow;

//builddestr
builddestr1:array[1..10] of wbuilddestr;

//bomb
bomb1:wbomb;
sh1:boolean;

//losewin
losewin1:wlosewin;

const
//resolution (will not work with other resolutions as it is. will have to change many things besides thiese two constants)
resx = 640;
resy = 480;

implementation

procedure tform1.errorout(hret:hresult; funcname:string);
begin
//procedure to show direct draw errors
messagebox(0,pchar(funcname+': '+#13+dderrorstring(hret)), pchar(caption), MB_OK or MB_ICONSTOP);
end;

function tform1.restoreall:hresult;
var hret:hresult;
begin
//functions to restore lost surfaces
hret:=fddsprimary._Restore;
if succeeded(hret) then begin
hret:=fddslosewin._Restore;
if failed (hret) then begin
result:=hret;
exit;
end;
hret:=ddreloadbitmap(fddslosewin,'bmp\losewin.bmp');
if failed (hret) then begin
result:=hret;
exit;
end;

hret:=fddsbomb._Restore;
if failed (hret) then begin
result:=hret;
exit;
end;
hret:=ddreloadbitmap(fddsbomb,'bmp\bomb.bmp');
if failed (hret) then begin
result:=hret;
exit;
end;

hret:=fddsblow._Restore;
if failed (hret) then begin
result:=hret;
exit;
end;
hret:=ddreloadbitmap(fddsblow,'bmp\blow.bmp');
if failed (hret) then begin
result:=hret;
exit;
end;

hret:=fddsplane._Restore;
if failed (hret) then begin
result:=hret;
exit;
end;
hret:=ddreloadbitmap(fddsplane,'bmp\plane1.bmp');
if failed (hret) then begin
result:=hret;
exit;
end;

hret:=fddsbuildings._Restore;
if failed (hret) then begin
result:=hret;
exit;
end;
hret:=ddreloadbitmap(fddsbuildings,'bmp\build.bmp');
if failed (hret) then begin
result:=hret;
exit;
end;

hret:=fddslevelch._Restore;
if failed (hret) then begin
result:=hret;
exit;
end;
hret:=ddreloadbitmap(fddslevelch,'bmp\levelch.bmp');
if failed (hret) then begin
result:=hret;
exit;
end;

if screenidx=2 then begin
hret:=fddsbackground1._Restore;
if failed (hret) then begin
result:=hret;
exit;
end;
hret:=ddreloadbitmap(fddsbackground1,'bmp\back1.bmp');
if failed (hret) then begin
result:=hret;
exit;
end;
constrcity();
end;

hret:=fddsbackground._Restore;
if failed (hret) then begin
result:=hret;
exit;
end;
result:=ddreloadbitmap(fddsbackground,'bmp\back1.bmp');
end
else result:=hret;
end;

procedure tform1.formsetcursor(var amsg:tmessage);
begin
setcursor(0);//setting cursor to be invisible
end;

function tform1.createsurf(fname:string):idirectdrawsurface7;
var wrkbmp:tbitmap;
hret:hresult;
ddsd:tddsurfacedesc2;
begin
wrkbmp:=tbitmap.Create;
wrkbmp.LoadFromFile(fname);

//creating surface
fillchar(ddsd,sizeof(ddsd),0);
ddsd.dwSize:=sizeof(ddsd);
ddsd.dwFlags:=ddsd_caps or ddsd_height or ddsd_width;
ddsd.ddsCaps.dwCaps:=ddscaps_offscreenplain or ddscaps_videomemory;
ddsd.dwWidth:=wrkbmp.Width;
ddsd.dwHeight:=wrkbmp.Height;
hret:=fdd.CreateSurface(ddsd,result,nil);
if hret<>dd_ok then begin
errorout(hret,'create particle surface');
exit;
end;

//loading bitmap
result:=ddloadbitmap(fdd,pchar(fname),wrkbmp.Width,wrkbmp.Height);
if result=nil then errorout(dd_false,'ddloadbitmap');

//setting the color key for the offscreen surface (upper left corner pixel color)
hret:=ddsetcolorkey(result,rgb(getrvalue(wrkbmp.Canvas.Pixels[0,0]),getgvalue(wrkbmp.Canvas.Pixels[0,0]),getbvalue(wrkbmp.Canvas.Pixels[0,0])));
if failed(hret) then begin
errorout(hret, 'ddsetcolorkey');
exit;
end;

wrkint:=wrkbmp.Width div 16;
wrkbmp.Free;
end;

procedure tform1.initlevel(lev1:byte);
var i,j,x1,y1:integer;
maxheight,minheight:byte;
hret:hresult;
ddsd:tddsurfacedesc2;
begin
//defining smallest building size in accordance with level
maxheight:=25;
minheight:=trunc(lev1*2.4)+1;
//--//
//clearing buildings matrix
for i:=0 to 29 do begin
for j:=0 to 39 do begin
buildmx[j,i]:=0;
end;
end;
segstot:=0;
//--//
//initializing buildings
buildsnum:=(resx div 16)-2;
x1:=16;
for i:=1 to buildsnum do begin
with building do begin
width:=16;
positionx:=x1;
statustag:=1;
type1:=random(btypesnum);
segmentsn:=minheight+random(maxheight-minheight);
//segmentsn:=1;
y1:=resy-16;
for j:=1 to segmentsn do begin
with segments[j] do begin
type1:=1;
if j=segmentsn then type1:=0;
height:=16;
position.X:=building.positionx;
position.Y:=y1;
buildmx[x1 div building.width, y1 div height]:=j;//filling the buildings matrix
drawrectt:=rect(building.type1*building.width,type1*height,(building.type1+1)*building.width,(type1+1)*height);
drawrectp:=@drawrectt;
y1:=y1-height;
segstot:=segstot+1;//total number of segments
end;
end;
x1:=x1+width;
end;
end;

//creating additional background surface
fddsbackground1:=nil;
fillchar(ddsd,sizeof(ddsd),0);
ddsd.dwSize:=sizeof(ddsd);
ddsd.dwFlags:=ddsd_caps or ddsd_height or ddsd_width;
ddsd.ddsCaps.dwCaps:=ddscaps_offscreenplain;
ddsd.dwWidth:=resx;
ddsd.dwHeight:=resy;
hret:=fdd.CreateSurface(ddsd,fddsbackground1,nil);
if hret<>dd_ok then begin
errorout(hret,'create particle surface');
exit;
end;
//loading bitmap to an ofscreen surface
fddsbackground1:=ddloadbitmap(fdd,pchar('bmp\back1.bmp'),resx,resy);
if fddsbackground1=nil then errorout(dd_false,'ddloadbitmap');
//--//
//cunstructing city on the additional background surface
constrcity();
//--//

//initializing plane
with plane1 do begin
width:=48;
height:=16;
position:=point(-48,0);
//position:=point(-48,416);
auxpos:=position;
nosemxpos.X:=(position.X+40) div 16;
nosemxpos.Y:=(position.Y+8) div 16;
framenum:=0;
frame:=0;
speed:=2;
statustag:=1;
crashtag:=false;
drawrectt:=rect(frame*width,0,(frame+1)*width,height);
drawrectp:=@drawrectt;
end;
//--//

//initializing blow
for i:=1 to 50 do begin
with blow do begin
width:=96;
height:=60;
frame:=0;
framenum:=8;
statustag:=0;
drawrectp:=@drawrectt;
end;
end;
//--//

//initializing bomb
with bomb1 do begin
width:=16;
height:=16;
statustag:=0;
speed:=2;
end;
sh1:=false;

//initializing abstruct structure
for i:=1 to 10 do begin
with builddestr1 do begin
delay:=2;
segmentsblow:=3;
statustag:=0;
end;
end;
//--//

//losewin
with losewin1 do begin
width:=191;
height:=47;
condition:=0;
drawrectp:=@drawrectt;
end;
//--//
end;

procedure tform1.constrcity();
var i:integer;
begin
for i:=1 to buildsnum do begin
constrbuild(i);
end;
end;

procedure tform1.constrbuild(ind1:word);
var j:integer;
hret:hresult;
begin
with building[ind1] do begin
if statustag<3 then begin
for j:=1 to segmentsn do begin
with segments[j] do begin
drawrectt:=rect(building[ind1].type1*building[ind1].width,type1*height,(building[ind1].type1+1)*building[ind1].width,(type1+1)*height);
while True do begin
hRet := FDDSbackground1.Bltfast (position.X,position.Y,fddsbuildings , drawrectp, DDBLTFAST_WAIT or ddbltfast_srccolorkey);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
end;
end;
end;
end;
end;

function tform1.choprect(rectin:trect; position:tpoint):trect;
var rect1:trect;
begin
rect1:=rectin;
if position.X<0 then rect1.Left:=rectin.Left-position.X;
if position.Y<0 then rect1.top:=rectin.top-position.Y;

if position.X+(rectin.Right-rectin.Left)>=resx then rect1.Right:=rectin.Right-(position.X+(rectin.Right-rectin.Left)-resx);
if position.Y+(rectin.bottom-rectin.top)>=resy then rect1.bottom:=rectin.bottom-(position.Y+(rectin.bottom-rectin.top)-resy);

result:=rect1;
end;

function tform1.choppos(position:tpoint):tpoint;
var p1:tpoint;
begin
p1:=position;
if position.X<0 then p1.X:=0;
if position.Y<0 then p1.Y:=0;
result:=p1;
end;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var hret:hresult;
ddsd:tddsurfacedesc2;
ddscaps:tddscaps2;
begin
randomize;

application.OnIdle:=idle1;
factive:=true;

screenidx:=1;

//clearing all surfaces
fddslosewin:=nil;
fddsbomb:=nil;
fddsblow:=nil;
fddsplane:=nil;
fddsbuildings:=nil;
fddslevelch:=nil;
fddsbackground1:=nil;
fddsbackground:=nil;
fddsback:=nil;
fddsprimary:=nil;
fdd:=nil;

fps1:=0;
showfps:=-1;

//creating direct draw main object
hret:=directdrawcreateex(nil,fdd,idirectdraw7,nil);
if hret<>dd_ok then begin
errorout(hret,'directdrawcreateex');
exit;
end;
//seeting cooperative level
hret:=fdd.SetCooperativeLevel(form1.handle,ddscl_fullscreen or ddscl_exclusive);
if hret<>dd_ok then begin
errorout(hret,'setcooperativelevel');
exit;
end;

//setting dysplay mode
hret:=fdd.SetDisplayMode(resx,resy,16,0,0);
if hret<>dd_ok then begin
errorout(hret,'setdisplaymode');
exit;
end;

//creating primary surface with backbuffer
fillchar(ddsd,sizeof(ddsd),0);
ddsd.dwSize:=sizeof(ddsd);
ddsd.dwFlags:=ddsd_caps or ddsd_backbuffercount;
ddsd.ddsCaps.dwCaps:=ddscaps_primarysurface or ddscaps_flip or ddscaps_complex;
ddsd.dwBackBufferCount:=1;
hret:=fdd.CreateSurface(ddsd,fddsprimary,nil);
if hret<>dd_ok then begin
errorout(hret,'create primary surface');
exit;
end;

//attaching backbuffer surface (there is no need to create it)
fillchar(ddscaps,sizeof(ddscaps),0);
ddscaps.dwCaps:=ddscaps_backbuffer;
hret:=fddsprimary.GetAttachedSurface(ddscaps,fddsback);
if hret<>dd_ok then begin
errorout(hret,'getattachedsurface');
exit;
end;

//creating background surface
fillchar(ddsd,sizeof(ddsd),0);
ddsd.dwSize:=sizeof(ddsd);
ddsd.dwFlags:=ddsd_caps or ddsd_height or ddsd_width;
ddsd.ddsCaps.dwCaps:=ddscaps_offscreenplain;
ddsd.dwWidth:=resx;
ddsd.dwHeight:=resy;
hret:=fdd.CreateSurface(ddsd,fddsbackground,nil);
if hret<>dd_ok then begin
errorout(hret,'create particle surface');
exit;
end;
//loading bitmap to an ofscreen surface
fddsbackground:=ddloadbitmap(fdd,pchar('bmp\back1.bmp'),resx,resy);
if fddsbackground=nil then errorout(dd_false,'ddloadbitmap');

//creating first screen label surface
fddslevelch:=createsurf('bmp\levelch.bmp');
with levelch do begin
width:=331;
height:=36;
with position do begin
x:=(resx-width) div 2;
y:=(resy-height) div 4;
end;
end;
//--//

//creating buildings surface
fddsbuildings:=createsurf('bmp\build.bmp');
btypesnum:=wrkint;
//--//

//creating plane sureface
fddsplane:=createsurf('bmp\plane1.bmp');
//--//

//creating blow surface
fddsblow:=createsurf('bmp\blow.bmp');
//--//

//creaing bomb surface
fddsbomb:=createsurf('bmp\bomb.bmp');
//--//

//creaing losewin surface
fddslosewin:=createsurf('bmp\losewin.bmp');
//--//

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
//destroying direct draw surfaces along with the main direct draw object
if assigned(fdd) then begin
if assigned(fddslosewin) then fddslosewin:=nil;
if assigned(fddsbomb) then fddsbomb:=nil;
if assigned(fddsblow) then fddsblow:=nil;
if assigned(fddsplane) then fddsplane:=nil;
if assigned(fddsbuildings) then fddsbackground:=nil;
if assigned(fddslevelch) then fddsbackground:=nil;
if assigned(fddsbackground1) then fddsbackground:=nil;
if assigned(fddsbackground) then fddsbackground:=nil;
if assigned(fddsback) then fddsback:=nil;
if assigned(fddsprimary) then fddsprimary:=nil;
fdd:=nil;
end;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if screenidx=1 then begin
if key=#27 then close
else if (key='0') or (key='1') or (key='2') or (key='3') or (key='4') or (key='5') or (key='6') or (key='7') or (key='8') or (key='9') then begin
leveln:=strtoint(key);
initlevel(leveln);
screenidx:=2;
end;
end
else if screenidx=2 then begin
if key=#27 then begin
screenidx:=1;
end;
end
else if screenidx=3 then begin
if key=#27 then begin
screenidx:=1;
end;
end;
if key='f' then showfps:=-1*showfps;
end;

procedure TForm1.ApplicationEvents1Restore(Sender: TObject);
begin
WindowState := wsMaximized;
factive:=true;
end;

procedure TForm1.ApplicationEvents1Deactivate(Sender: TObject);
begin
application.Minimize;
factive:=false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
form1.Hide;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
fps1:=fps;
fps:=0;
end;

procedure tform1.idle1(sender:tobject; var done:boolean);
var hRet : HRESULT;
wrkrect:trect;
wrkrectprect;
i,j:integer;
begin
done:=false;
sleep(16);
if not factive then exit;

if screenidx=1 then begin
//putting background from the offscreen surface to the backbuffer surface
while True do begin
hRet := FDDSback.Bltfast (0,0, fddsbackground, nil, DDBLTFAST_WAIT);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
//putting level choice label to the backbuffer surface
while True do begin
hRet := FDDSback.Bltfast (levelch.position.X,levelch.position.Y,fddslevelch , nil, DDBLTFAST_WAIT or ddbltfast_srccolorkey);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
end
else if screenidx=2 then begin
//processing game
//plane
with plane1 do begin
//flying
if statustag=1 then begin
position.X:=position.X+speed;
if position.X>=resx then statustag:=2;
if (nosemxpos.X>=0) and (nosemxpos.X<40) and (nosemxpos.y>=0) and (nosemxpos.y<30) then begin
if buildmx[nosemxpos.X,nosemxpos.Y]>0 then statustag:=3;
end;
end;
//moving to lower altitude
if statustag=2 then begin
position.X:=0;
position.Y:=position.Y+height;
if position.Y>resy-height then position.Y:=0;
statustag:=1;
end;
//plane crash
if statustag=3 then begin
building[nosemxpos.X].segments[buildmx[nosemxpos.X,nosemxpos.Y]].type1:=2;
wrkrect:=rect(building[nosemxpos.X].positionx,0,building[nosemxpos.X].positionx+building[nosemxpos.X].width,resy);
wrkrectp:=@wrkrect;
//redrawing the back of the building
while True do begin
hRet := fddsbackground1.Bltfast (building[nosemxpos.X].positionx,0,fddsbackground , wrkrectp, DDBLTFAST_WAIT);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
//--//
//redrawing building with new parameters
constrbuild(nosemxpos.X);
//--//
//finding the next availabel blow and assigning position for it
i:=1;
while (blow.statustag>0) and (i<50) do
i:=i+1;
if i<50 then begin
blow.statustag:=1;
blow.position.X:=nosemxpos.X*16+(16-blow.width) div 2;
blow.position.Y:=nosemxpos.Y*16+(16-blow.height) div 2;
end;
//--//
statustag:=0;//the plain is crashed
crashtag:=true;
end;
//--//
auxpos:=position;
nosemxpos.X:=(position.X+40) div 16;
nosemxpos.Y:=(position.Y+8) div 16;
if auxpos.X>resx-width then begin
auxpos.X:=-1*(resx-position.X);
auxpos.Y:=position.Y+height;
if auxpos.Y>resy-height then auxpos.Y:=0;
if position.X>resx-width+8 then begin
nosemxpos.X:=(auxpos.X+40) div 16;
nosemxpos.Y:=(auxpos.Y+8) div 16;
end;
end;
end;
//--//

//Blow
for i:=1 to 50 do begin
with blow do begin
if statustag=1 then begin
frame:=0;
statustag:=2;
end;
if statustag=2 then begin
frame:=frame+1;
if frame>framenum then begin
statustag:=0;
if segstot<=0 then begin
screenidx:=3;//win
plane1.frame:=1;
losewin1.condition:=1;
end
else if plane1.crashtag then begin
screenidx:=3;//lose
losewin1.condition:=0;
end;
end;
end;
end;
end;
//--//

//bomb
with bomb1 do begin
if statustag=1 then begin
position.X:=(plane1.nosemxpos.X-1)*width;
position.Y:=(plane1.nosemxpos.Y+1)*height-height div 2;
if position.X div width >39 then position.X:=39*width;
if position.X<0 then position.X:=0;
statustag:=2;
end;
if statustag=2 then begin
position.Y:=position.Y+speed;
//finding bomb position on the grid
gridpos.X:=(position.X+(width div 2)) div 16;
gridpos.Y:=(position.Y+height-1) div 16;
//--//
if (gridpos.X>=0) and (gridpos.X<40) and (gridpos.Y>0) and (gridpos.Y<30) then begin
//bomb blows on building
if buildmx[gridpos.X,gridpos.Y]>0 then begin
statustag:=0;
//finding next available abstruct structure
i:=1;
while (builddestr1.statustag>0) and (i<10) do i:=i+1;
if i<10 then begin
builddestr1.statustag:=1;
builddestr1.posmx.X:=gridpos.X;
builddestr1.posmx.Y:=buildmx[gridpos.X,gridpos.Y];
builddestr1.position:=building[builddestr1.posmx.X].segments[builddestr1.posmx.Y].position;
builddestr1.secsbcount:=0;
end;
end;
//--//
end;

//bomb hits the ground
if statustag=2 then begin
if position.Y+height>resy then begin
statustag:=3;
end;
end;
if statustag=3 then begin
statustag:=0;
//finding the next availabel blow and assigning position for it
i:=1;
while (blow.statustag>0) and (i<50) do
i:=i+1;
if i<50 then begin
blow.statustag:=1;
blow.position.X:=position.X+(width-blow.width) div 2;
blow.position.Y:=position.Y+height-1-blow.height div 2;
end;
//--//
end;
end;
end;
//--//

//abstract structure to destroy building
for i:=1 to 10 do begin
with builddestr1 do begin
if statustag=1 then begin
statustag:=2;
delayc:=0;
//reducing the size of the building
buildmx[posmx.X,30-building[posmx.X].segmentsn]:=0;
building[posmx.X].segmentsn:=building[posmx.X].segmentsn-1;
secsbcount:=secsbcount+1;
segstot:=segstot-1;//subtractin 1 from total number of segments
if (secsbcount>=segmentsblow) or (building[posmx.X].segmentsn<=0) then statustag:=0;
//--//
//changing segment type
building[posmx.X].segments[posmx.Y-1].type1:=2;
wrkrect:=rect(building[posmx.X].positionx,0,building[posmx.X].positionx+building[posmx.X].width,resy);
wrkrectp:=@wrkrect;
//redrawing the back of the building
while True do begin
hRet := fddsbackground1.Bltfast (building[posmx.X].positionx,0,fddsbackground , wrkrectp, DDBLTFAST_WAIT);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
//--//
//redrawing building with new parameters
constrbuild(posmx.X);
//--//
//finding the next availabel blow and assigning position for it
j:=1;
while (blow[j].statustag>0) and (j<50) do
j:=j+1;
if j<50 then begin
blow[j].statustag:=1;
blow[j].position.X:=position.X+(16-blow[j].width) div 2;
blow[j].position.Y:=position.Y+(16-blow[j].height) div 2;
end;
//--//
end;
if statustag=2 then begin
delayc:=delayc+1;
if delayc>delay then begin
statustag:=1;
position.Y:=position.Y+16;
posmx.Y:=posmx.Y-1;
end
end;
end;
end;
//--//

//drawing
//putting background from the offscreen surface to the backbuffer surface
while True do begin
hRet := FDDSback.Bltfast (0,0, fddsbackground1, nil, DDBLTFAST_WAIT);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
//putting plane to the backbuffer surface
with plane1 do begin
if statustag>0 then begin
drawrectt:=choprect(rect(frame*width,0,(frame+1)*width,height),position);
while True do begin
hRet := FDDSback.Bltfast (choppos(position).X,choppos(position).Y,fddsplane , drawrectp, DDBLTFAST_WAIT or ddbltfast_srccolorkey);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
//putting nose of the plane if its ass is sticking from the opposite side of the screen
if position.X>resx-width then begin
drawrectt:=choprect(rect(frame*width,0,(frame+1)*width,height),auxpos);
while True do begin
hRet := FDDSback.Bltfast (choppos(auxpos).X,choppos(auxpos).Y,fddsplane , drawrectp, DDBLTFAST_WAIT or ddbltfast_srccolorkey);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
end;
end;
end;
//--//

//drawing blow
for i:=1 to 50 do begin
with blow do begin
if statustag>0 then begin
drawrectt:=choprect(rect(frame*width,0,(frame+1)*width,height),position);
while True do begin
hRet := FDDSback.Bltfast (choppos(position).X,choppos(position).Y, fddsblow, drawrectp, DDBLTFAST_WAIT or ddbltfast_srccolorkey);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
end;
end;
end;
//--//
//drawing bomb
with bomb1 do begin
if statustag>0 then begin
while True do begin
hRet := FDDSback.Bltfast (position.X,position.Y, fddsbomb, nil, DDBLTFAST_WAIT or ddbltfast_srccolorkey);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
end;
end;
//--//
end;
//winning
if screenidx=3 then begin
//plane
with plane1 do begin
if statustag=1 then begin
position.X:=position.X+speed;
if position.X>=resx then statustag:=2;
if (nosemxpos.X>=39) and (nosemxpos.Y>=29) then statustag:=3;
end;
if statustag=2 then begin
position.X:=0;
position.Y:=position.Y+height;
if position.Y>resy-height then position.Y:=0;
statustag:=1;
end;
auxpos:=position;
nosemxpos.X:=(position.X+40) div 16;
nosemxpos.Y:=(position.Y+8) div 16;
if auxpos.X>resx-width then begin
auxpos.X:=-1*(resx-position.X);
auxpos.Y:=position.Y+height;
if auxpos.Y>resy-height then auxpos.Y:=0;
if position.X>resx-width+8 then begin
nosemxpos.X:=(auxpos.X+40) div 16;
nosemxpos.Y:=(auxpos.Y+8) div 16;
end;
end;
end;
//--//
with losewin1 do begin
position.X:=(resx-width) div 2;
position.Y:=(resy-height) div 2;
drawrectt:=rect(0,condition*height,width,(condition+1)*height);
drawrectp:=@drawrectt;
end;

//putting background from the offscreen surface to the backbuffer surface
while True do begin
hRet := FDDSback.Bltfast (0,0, fddsbackground1, nil, DDBLTFAST_WAIT);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;

//putting plane to the backbuffer surface
with plane1 do begin
if statustag>0 then begin
drawrectt:=choprect(rect(frame*width,0,(frame+1)*width,height),position);
while True do begin
hRet := FDDSback.Bltfast (choppos(position).X,choppos(position).Y,fddsplane , drawrectp, DDBLTFAST_WAIT or ddbltfast_srccolorkey);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
//putting nose of the plane if its ass is sticking from the opposite side of the screen
if position.X>resx-width then begin
drawrectt:=choprect(rect(frame*width,0,(frame+1)*width,height),auxpos);
while True do begin
hRet := FDDSback.Bltfast (choppos(auxpos).X,choppos(auxpos).Y,fddsplane , drawrectp, DDBLTFAST_WAIT or ddbltfast_srccolorkey);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
end;
end;
end;
//--//

//putting losewin label to the backbuffer surface
while True do begin
hRet := FDDSback.Bltfast (losewin1.position.X,losewin1.position.Y,fddslosewin , losewin1.drawrectp, DDBLTFAST_WAIT or ddbltfast_srccolorkey);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;
end;

//flipping the primary and backbuffer surfaces
while True do begin
hRet := FDDSprimary.Flip (nil, DDFLIP_WAIT);
if hRet = DDERR_SURFACELOST then begin
if Failed (RestoreAll) then Exit;
end
else Break;
end;

//FPS
fps:=fps+1;
if showfps>0 then form1.Canvas.TextOut(0,0,inttostr(fps1));
//form1.Canvas.TextOut(0,0,inttostr(plane1.nosemxpos.X)+', '+inttostr(plane1.nosemxpos.y));
//form1.Canvas.TextOut(0,0,inttostr(plane1.nosemxpos.X)+', '+inttostr(buildmx[plane1.nosemxpos.X,plane1.nosemxpos.Y]));
//form1.Canvas.TextOut(bomb1.position.X,bomb1.position.y,inttostr(bomb1.gridpos.X)+', '+inttostr(bomb1.gridpos.Y));
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//bomb dropping (use space or down arrow)
if screenidx=2 then begin
if not plane1.crashtag then begin
if (key=32) or (key=40) then begin
if not sh1 then begin
sh1:=true;
if bomb1.statustag=0 then bomb1.statustag:=1;
end;
end;
end;
end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key=32) or (key=40) then sh1:=false;
end;

end.
برنامه هم اینه !

 

[sascovach]

فکر کنم بخش رو اشتباه اومدی

 

[farbod_123]

فکر کنم بخش رو اشتباه اومدی

تایید میشه

 

[alllallle]

برم کجا؟

 

[sascovach]

برم کجا؟

بخش برنامه نویسی هم داره پرشین تولز

 

[mdibmehr2]

برو به این فروم :::
http://forum.persiantools.com/f18.html

 

[MahdiΩ]

نمیشه گفت بخش رو اشتباه اومدن چون سورس برنامه فعلا با دلفی هست و پاسکال هم که از اجداد دلفی محسوب میشه.

فقط چون آخر ترم هست بچه ها همه خودشون مشغولی های زیادی دارن و وقت نمیکنن کمک کنن !

پیاده سازی این برنامه توی توربو پاسکال کلی وقت میبره (کارهای گرافیکی+ پیاده سازی منطق برنامه+ ....)

اگه خدای نکرده این ترم افتادین بگین تا توی تابستون برنامه رو ردیف کنیم انشاالله واسه ترم بعد !!

 

[alllallle]

اگه گرافیکی هم نبود مهم نیست ! یه چیزی شبیهش هم باشه خوبه ! :wacko:

 

[S_Engineer]

شما چرا به سایت های سورس دلفی و پاسکال سری نمیزنید؟ اونجا سورس اکثر برنامه های دانشگاهی رو میتونید پیدا کنید
programmersheaven.com
delphi3000.com
http://www.hidarneh.net/

اینم یه لینک گوگل با کلی سورس این بازی برای پاسکال

http://www.google.com/search?hl=en&q=pascal+source+code+minesweeper&btnG=Google+Search

 

[DollWorld]

اگه گرافیکی هم نبود مهم نیست ! یه چیزی شبیهش هم باشه خوبه ! :wacko:

سلام
به
http://space_iq.persianblog.com
سر بزنيد
جواب همه مشکلات پروژه هاي درسي خود را مي يابيد