tetris (Mini Project) - Pascal Projects Source Code in Pascal

Special : Web Developer's Collection CD-ROM
50,000+ Web Templates, Logos, Cliparts, Scripts. Order Now!

Add to Favorites Make Home Page

2404 Online

Language Categories

Source Codes Home
Project Ideas New!
Interview Questions
FAQs Home
ASP Home: ASP Source Codes; ASP Script Directory New!; ASP .Net Script Directory New!; ASP Interview Questions; ASP FAQs; ASP How Tos
C Home: C Source Codes; C Script Directory New!; C Interview Questions; C FAQs; C How Tos
C++ Home: C++ Source Codes; C++ Script Directory New!; C++ Interview Questions; C++ FAQs; C++ How Tos
Java Home: Java Source Codes; Java Directory New!; Java Interview Questions; Java FAQs; Java How Tos
JavaScript Home: JavaScript Directory New!; JavaScript Source Codes; JavaScript FAQs; JavaScript How Tos
COBOL Home: COBOL Source Codes; COBOL FAQs; COBOL How Tos
Pascal Home: Pascal Source Codes; Pascal FAQs; Pascal How Tos
PHP Script Directory New!
Python Script Directory New!
Perl & CGI Script Directory New!
Flash Script Directory New!
CFML Script Directory New!
Remotely Hosted Scripts New!
Tools & Utilities Directory New!
XML Script Directory New!
Best Programmers: Amit Mathur; Vishal Bhardwaj; Deepesh Jain
Vyom NetWork

Our Services

Get 9,000 Interview Questions & Answers in an eBook.

9500+ Pages
9000 Question & Answers
All Tech. Categories

14 MB Content

Get it now !!

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

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

Title	tetris (Mini Project)
Author	mehdi farrokhzad
Author Email	mehdi426i [at] yahoo.com
Description
Category	Pascal » Pascal Projects
Hits	394013
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(ongo); 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.

Free Tutorials - HTML, Java, SQL, PHP, ASP, Perl, SQL Tutorials
Discuss Programming Problems and Freshers Jobs related issues here.
Discuss Final Year Project Ideas here.