Add to Favorites    Make Home Page 7817 Online  
 Language Categories  
 Our Services  

Home » Pascal Home » Pascal Projects Home » tetris (Mini Project)

A D V E R T I S E M E N T

Search Projects & Source Codes:

Title tetris (Mini Project)
Author mehdi farrokhzad
Author Email mehdi426i [at] yahoo.com
Description
Category Pascal » Pascal Projects
Hits 376500
Code Select and Copy the Code
Code : program tetris;{tetris game, writen by 'mehdi farrokhzad',project term 1} uses crt,graph; {started at 83/9/22 to 83/ / time in work(12) hours} type {this game is programmed for pascal project in term 1 '83'} matris=array[1..15,1..20]of boolean;{teacher:dr ebrahimi} var driver,mode,i,j,shekl,rd,xstart,ystart,xend,yend,rd2,x,lpixel:integer; leftchannel,rightchannel,rpixel ,downchannel1,downchannel2,downchannel3:integer; tetrix:boolean; key,keyup,keydown,keyleft,keyright,space,keyy:char; matrix:matris; procedure logo; begin{logo} bar(50,100,80,200);{darw t} bar(20,100,110,100); bar(150,100,180,200);{draw e} bar(180,100,210,120); bar(180,140,210,160); bar(180,180,210,200); bar(280,100,310,200);{draw t} bar(250,100,340,100); bar(380,100,410,200);{draw r} arc(410,125,270,90,25); line(410,150,435,200); bar(480,100,510,200);{draw i} circle(495,75,25); floodfill(495,77,white); arc(600,125,0,180,35);{draw s} line(565,125,635,125); line(565,125,635,165); arc(600,165,180,0,35); line(565,165,635,165); floodfill(600,110,white); floodfill(600,170,white); outtextxy(200,getmaxy-50,'please enter to load game...'); end;{logo} {---------------------------------------------------} procedure music; {music attached from hangman} var o,go, z2,z4,z8,z16,k : integer; d,dd,r,rd,m,f,fd,c,cd,l,ld,si : integer; {**************************************************} procedure s(n,z:integer); var k,k2 : integer; begin sound(o*n*go); delay(z); nosound; end; {***************************************************} begin d := 65; dd := 69; r := 73; rd := 78; go:=3; m := 82; f := 87; fd := 93; c := 98; cd := 104; l := 110; ld := 117; si := 123; {********************************************************} z2 := 800; z4 := round(z2/2); z8 := round(z2/4); z16 := round(z2/8); o := 1; s(l,z8); s(si,z8); o := 2; s(d,z8); o := 1; s(si,z8); o := 2; s(r,z8); s(d,z8); o := 1; s(si,z8); s(l,z8); s(si,z4); s(si,z4); s(si,z4); end;{end of music of logo} {------------------------------------------------------} procedure rectangl; begin{draw rectangle} rectangle(149,49,451,451); outtextxy(460,100,'score:'); outtextxy(180,40,'T E T R I S') end;{rectangl} {------------------------------------------------------} procedure shekl1; {*} begin {draw shekl1} {***} SetFillStyle(SolidFill, rd); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); bar(xstart+10,ystart+20,xstart+30,ystart+40); bar(xstart-30,ystart+20,xstart+10,ystart+40); leftchannel:=xstart-31; rightchannel:=xstart+31; end;{shekl1} {-------------------------------------------------} procedure shekl2; {*} begin {darw shekl2} {***} SetFillStyle(SolidFill, rd); bar(xstart+10,ystart,xstart+30,ystart+20); bar(xstart+10,ystart+20,xstart+30,ystart+40); bar(xstart-10,ystart+20,xstart+10,ystart+40); bar(xstart-30,ystart+20,xstart-10,ystart+40); leftchannel:=xstart-31; rightchannel:=xstart+31; end; {------------------------------------------------} procedure shekl3; {***} begin {draw shekl3} SetFillStyle(SolidFill, rd); bar(xstart+10,ystart,xstart+30,ystart+20); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart-30,ystart,xstart-10,ystart+20); leftchannel:=xstart-31; rightchannel:=xstart+31; end; {------------------------------------------------} procedure shekl4; {**} begin {draw shekl4} {**} SetFillStyle(SolidFill, rd); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart+10,ystart,xstart+30,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); bar(xstart-30,ystart+20,xstart-10,ystart+40); leftchannel:=xstart-31; rightchannel:=xstart+31; end; {-------------------------------------------------} procedure shekl5; {**} begin {draw shekl5} {**} SetFillStyle(SolidFill, rd); bar(xstart+10,ystart,xstart+30,ystart+20); bar(xstart+10,ystart+20,xstart+30,ystart+40); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); leftchannel:=xstart-11; rightchannel:=xstart+31; end; {-----------------------------------------------------} procedure ypayan; begin if shekl=4 then yend:=390 else yend:=410; end; {------------------------------------------------------} procedure shekl1__2; begin {shekl1__2} SetFillStyle(SolidFill, rd); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); bar(xstart-10,ystart+40,xstart+10,ystart+60); bar(xstart-30,ystart+20,xstart-10,ystart+40); leftchannel:=xstart-31; rightchannel:=xstart+11; end; {-------------------------------------------------} procedure shekl1__3; begin {shekl1__3} SetFillStyle(SolidFill, rd); bar(xstart-30,ystart,xstart-10,ystart+20); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart+10,ystart,xstart+30,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); leftchannel:=xstart-31; rightchannel:=xstart+31; end; {--------------------------------------------------} procedure shekl1__4; begin {shekl1__4} SetFillStyle(SolidFill, rd); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); bar(xstart+10,ystart+40,xstart+30,ystart+60); bar(xstart+10,ystart+20,xstart+30,ystart+40); leftchannel:=xstart-11; rightchannel:=xstart+31; end; {---------------------------------------------------------} procedure shekl2__1; begin {begin shekl2__1} SetFillStyle(SolidFill, rd); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart+10,ystart,xstart+30,ystart+20); bar(xstart+10,ystart+20,xstart+30,ystart+40); bar(xstart+10,ystart+40,xstart+30,ystart+60); leftchannel:=xstart-11; rightchannel:=xstart+31; end; {-----------------------------------------------------} procedure shekl2__2; begin SetFillStyle(SolidFill, rd); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); bar(xstart+10,ystart,xstart+30,ystart+20); bar(xstart+30,ystart,xstart+50,ystart+20); leftchannel:=xstart-11; rightchannel:=xstart+51; end; {-----------------------------------------------------} procedure shekl2__3; begin SetFillStyle(SolidFill, rd); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); bar(xstart-10,ystart+40,xstart+10,ystart+60); bar(xstart+10,ystart+20,xstart+30,ystart+40); leftchannel:=xstart-11; rightchannel:=xstart+31; end; {------------------------------------------------------} procedure shekl3__1; begin SetFillStyle(SolidFill, rd); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); bar(xstart-10,ystart+40,xstart+10,ystart+60); leftchannel:=xstart-11; rightchannel:=xstart+11; end; {------------------------------------------------------} procedure shekl4__1; begin SetFillStyle(SolidFill, rd); bar(xstart-10,ystart,xstart+10,ystart+20); bar(xstart-10,ystart+20,xstart+10,ystart+40); bar(xstart-10,ystart+40,xstart+10,ystart+60); bar(xstart+10,ystart+20,xstart+30,ystart+40); leftchannel:=xstart-11; rightchannel:=xstart+31; end; {------------------------------------------------------} procedure ashkal; begin if shekl = 1 then begin case x of 0 : shekl1; 1 : shekl1__2; 2 : shekl1__3; 3 : shekl1__4; end; end; if shekl = 2 then begin case x of 0 : shekl2; 1 : shekl2__1; 2 : shekl2__2; 3 : shekl2__3; end; if shekl = 3 then begin case x of 0,2 : shekl3; 1,3 : shekl3__1; end; end; if shekl = 4 then begin case x of 0,2 : shekl4; 1,3 : shekl4__1; end; end; end; end; {------------------------------------------------------} procedure pspace; begin x:=x+1; if x = 4 then x:=0; ashkal; end; procedure arrow; begin key:=upcase(key); keyup:=chr(80); keydown:=chr(72); keyleft:=chr(75); keyright:=chr(77); space:=chr(32); if key = keyup then SetViewPort(470,400, GetMaxX - 20, GetMaxY - 20, ClipOn); while not keypressed do begin outtextxy(470,400,'p a u s e'); end; if keypressed then outtextxy(470,400,' '); if key = keyleft then begin lpixel:=getpixel(leftchannel,ystart); if lpixel <>0 then xstart:=xstart-20 { i:=i-1; if i > 1 then xstart:=xstart-20; if i <= 1 then i:=1;} end;{end key left} if key = keyright then begin rpixel:=getpixel(rightchannel,ystart); {i:=i+1; if i<=14 then xstart:=xstart+20 else if i >=15 then i:=15;} if key =space then pspace; end; end; {------------------------------------------------------} procedure rising; begin while not keypressed do begin delay(1000); rd:=0; ashkal; ystart:=ystart+10; ypayan; rd:=rd2; if keypressed then begin key:=readkey; delay(150); arrow; end;{end if } ashkal; if keypressed then key:=readkey; end; end;{end rising} {------------------------------------------------------} begin {main} driver:= Detect; initgraph(driver,mode,'..\bgi'); randomize; { logo; music; readln; } cleardevice; rectangl; tetrix:=true; for i:=1 to 15 do for j:=1 to 20 do matrix[i,j]:=false; i:=7; j:=1; while tetrix = true do begin{while main} xstart:=300; ystart:=50; rd:=(Random(GetMaxColor)+1); rd2:=rd; x:=0; shekl:=random(5)+1; delay(600); rising; tetrix:=false; end; readln; end.{main}

Related Source Codes

Script Name Author
Calendar date to day number and back Nicky McLean
Matrix Multiple Cirruse Salehnasab
Function Power Recursive Cirruse Salehnasab
swim brian colston
Macsi - space fighting game. Macsi PÚter
Recursive Monkey Puzzle Solution - Project Maxim C.L. Wrne
Maze Game Project In Pascal Mahmood
Excellent Rat in a Maze Program. VyomWorld
A car game. You have to drive the car in such a way that you dont strike a barrier on the road. VyomWorld
Student Database Information System. VyomWorld
Tic Tac Toe Game implemented in Pascal. VyomWorld
Game to Gain more blocks by drawing appropriate lines from correct places(dots). VyomWorld
To Find The Coinage Of The Amount Entered. VyomWorld
Randomizes two 3x3 arrays and indicates the numbers whih are common in both the arrays otherwise an cross 'x' is shown instead. VyomWorld
Program that checks the space on drive a: and also gives a graphical representation of memory. VyomWorld

A D V E R T I S E M E N T




Google Groups Subscribe to SourceCodesWorld - Techies Talk
Email:

Free eBook - Interview Questions: Get over 1,000 Interview Questions in an eBook for free when you join JobsAssist. Just click on the button below to join JobsAssist and you will immediately receive the Free eBook with thousands of Interview Questions in an ebook when you join.

New! Click here to Add your Code!


ASP Home | C Home | C++ Home | COBOL Home | Java Home | Pascal Home
Source Codes Home Page

 Advertisements  

Google Search

Google

Source Codes World.com is a part of Vyom Network.

Vyom Network : Web Hosting | Dedicated Server | Free SMS, GRE, GMAT, MBA | Online Exams | Freshers Jobs | Software Downloads | Interview Questions | Jobs, Discussions | Placement Papers | Free eBooks | Free eBooks | Free Business Info | Interview Questions | Free Tutorials | Arabic, French, German | IAS Preparation | Jokes, Songs, Fun | Free Classifieds | Free Recipes | Free Downloads | Bangalore Info | Tech Solutions | Project Outsourcing, Web Hosting | GATE Preparation | MBA Preparation | SAP Info | Software Testing | Google Logo Maker | Freshers Jobs

Sitemap | Privacy Policy | Terms and Conditions | Important Websites
Copyright ©2003-2024 SourceCodesWorld.com, All Rights Reserved.
Page URL: http://www.sourcecodesworld.com/source/show.asp?ScriptID=864


Download Yahoo Messenger | Placement Papers | Free SMS | C Interview Questions | C++ Interview Questions | Quick2Host Review