Geri git   Van.GEN.TR Forum | Yerel Van Forumu > Bilgisayar > Programlama > Pascal

Cevapla
 
Konu Araçları Stil
Alt 24/04/07, 01:06   #1
gokhanaygun
Tuğgeneral
 
gokhanaygun - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Apr 2007
Bulunduğu yer: VAN
Yaş: 36
Mesajlar: 924
Tecrübe Puanı: 26 gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold
Standart yılan

uses crt,dos;

var
yilanx:array[1..3500] of integer;
yilany:array[1..3500] of integer;
doy:array[1..6] of string;
dpu:array[1..6] of integer;
duv,yemsay,c,n,i,j,yemx,yemy:byte;
R:REGISTERS;
kytsay,puan,hiz:integer;
tus,tus1:char;
ses,d,k,yem,yanma,a:boolean;
d1:text;
eyoy:string[20]; eypuan:integer; isim:string[20];
mesaj:string;

function sor:boolean;
var
tus:char;
begin
write(mesaj);
repeat tus:=readkey; until tus in ['E','e','H','h'];
if tus in ['e','E'] then sor:=true
else sor:=false
end;

procedure cerceve(x1,y1,x2,y2:byte);
var
i:byte;
begin
gotoxy(x1,y1); write(#201);
for i:=x1+1 to x2-1 do write(#205);
write(#187);
for i:=y1+1 to y2-1 do
begin
gotoxy(x1,i); write(#186);
gotoxy(x2,i); write(#186);
end;
gotoxy(x1,y2); write(#200);
for i:=x1+1 to x2-1 do write(#205);
write(#188);
end;

procedure renk(x,y:byte);
begin
textcolor(x); textbackground(y);
end;



procedure duv2;
begin
gotoxy(22,13); write(#201); {sol ?st}
gotoxy(57,13); write(#187); {sag ?st}
gotoxy(22,35); write(#200); {sol alt}
for i:=23 to 56 do
begin
gotoxy(i,13); write(#205); {?st x}
gotoxy(i,35); write(#205); {alt x}
end;
write(#188); {sag alt}
for i:=14 to 21 do
begin
gotoxy(22,i); write(#186);
gotoxy(57,i); write(#186);
gotoxy(22,i+13); write(#186);
gotoxy(57,i+13); write(#186);
end;
end;

procedure duv3;
begin
j:=0;
repeat
j:=j+10;
for i:=9 to 38 do
begin
gotoxy(j+6,i);
write(#186);
end;
until j=60;
end;

procedure duv4;
begin
gotoxy(1,1); write(#201);
j:=0;
for i:=2 to 79 do
begin
gotoxy(i,1); write(#205);
gotoxy(i,49); write(#205);
j:=j+1;
if j in [1..21,60..79] then
begin
gotoxy(i,18); write(#205);
gotoxy(i,33); write(#205);
end;
end;
write(#187);
for i:=2 to 49 do
if i in [2..17,34..48] then
begin
gotoxy(1,i); write(#186);
gotoxy(80,i); write(#186);
end;
write(#200);
gotoxy(80,1); write(#187);
gotoxy(80,49); write(#188);
gotoxy(1,18); write(#200);
gotoxy(80,18); write(#188);
gotoxy(1,33); write(#201);
end;



procedure skortablosu;
var
skoy:string[20];
satir,skpu:integer;
begin
R.CH:=31;
R.CL:=0;
R.Ah:=1;
R.Al:=0;
INTR($10,R);

kytsay:=0; satir:=0; clrscr;
assign(d1,'skor.dat'); reset(d1);
while not eof(d1) do
begin
kytsay:=kytsay+1;
readln(d1); readln(d1);
end; close(d1); reset(d1);
cerceve(20,20,48,23+kytsay);
gotoxy(28,20); write('SKOR TABLOSU');
gotoxy(21,21); write('Isim'); gotoxy(42,21); write('Puan');
gotoxy(21,22); write('----'); gotoxy(42,22); write('----');
while not eof(d1) do
begin
satir:=satir+1;
readln(d1,skoy); readln(d1,skpu);
gotoxy(21,22+satir); write(satir,'-',skoy);
gotoxy(42,22+satir); write(skpu);
end;
readln;
end;



procedure skor(ppuan:integer);
var
durum:boolean;
sayac,tutpu:integer;
tutoy,adi:string[20];
doy:array[1..6] of string;
dpu:array[1..6] of integer;
begin
assign(d1,'skor.dat');
reset(d1);
sayac:=0; kytsay:=0; durum:=false;
while not eof(d1) do
begin
kytsay:=kytsay+1;
readln(d1); readln(d1);
end;
if kytsay<6 then kytsay:=kytsay+1;
close(d1); reset(d1);
if not(ppuan=0) then
begin
for i:=1 to kytsay do
begin
sayac:=sayac+1; tutpu:=0;
if (kytsay>1) then
readln(d1,tutoy,tutpu);
if (ppuan>tutpu) and (durum=false) then
begin
clrscr; gotoxy(20,20); write('Skor tablosuna girmeye hak kazandiniz.');
gotoxy(33,21); write('Isminiz:'); readln(adi);
doy[sayac]:=adi; dpu[sayac]:=ppuan;
if (kytsay>1) and (not(kytsay=sayac)) then
begin
sayac:=sayac+1;
doy[sayac]:=tutoy; dpu[sayac]:=tutpu;
end;
durum:=true;
end
else if ppuan>0 then begin doy[sayac]:=tutoy; dpu[sayac]:=tutpu; end;
if sayac=kytsay then break;
end;
close(d1);
rewrite(d1);
for i:=1 to kytsay do
begin
writeln(d1,doy[i]); writeln(d1,dpu[i]);
end;
close(d1);
skortablosu;
end;

end;

procedure yemcikar;
begin
repeat
yem:=true;
yemx:=random(79); yemy:=random(48);
for i:=1 to n do
if (yemx=yilanx[i]) and (yemy=yilany[i]) then yem:=false;

if (yemx in [0,1]) or (yemy in [0,1]) then yem:=false; {duv2 yem engel}

if (duv=3) then if (yemy in [13,35]) and (yemx in [22..57])
or (yemx in [22,57]) and (yemy in [14..21]) {duv3 yem engel}
or (yemx in [22,57]) and (yemy in [27..34]) then yem:=false;

if (duv=4) and (yemy in [9..38]) then
if (yemx in [16,26,36,46,56,66]) then yem:=false; {duv4 yem engel}

if (yemy in [1,80]) or (yemx in [1..22,61..79])
and (yemy in [18,33]) or (yemy in [1..17,34..48])
and (yemx in [1,80]) then yem:=false; {duv5 yem engel}

until yem=true;
gotoxy(yemx,yemy); write('*');
end;

procedure puanlama;
begin
gotoxy(70,49);
write('PUAN=',puan);
puan:=puan+10;
end;

procedure harmenu(adet:byte; m1,m2,m3,m4,m5,m6:string);
var
x,y:byte;
tus:char;
b:boolean;
procedure giris;
begin
repeat
tus:=readkey;
b:=false;
if tus=#27 then halt;
if tus=#13 then b:=true;
if tus=#0 then
begin
tus:=readkey;
if tus=#80 then begin if c=adet then c:=1 else c:=c+1; end;
if tus=#72 then begin if c=1 then c:=adet else c:=c-1; end;
end;
until tus in [#72,#80,#13];
end;

procedure menu;
begin
renk(white,black);
gotoxy(32,15); write(m1);
gotoxy(32,16); write(m2);
gotoxy(32,17); write(m3);
gotoxy(32,18); write(m4);
gotoxy(32,19); write(m5);
gotoxy(32,20); write(m6);
end;

begin
menu; c:=1;
repeat
if c=1 then begin gotoxy(32,15); renk(1,7); write(m1);
giris; menu; continue; end;
if c=2 then begin gotoxy(32,16); renk(1,7); write(m2);
giris; menu; continue; end;
if c=3 then begin gotoxy(32,17); renk(1,7); write(m3);
giris; menu; continue; end;
if c=4 then begin gotoxy(32,18); renk(1,7); write(m4);
giris; menu; continue; end;
if c=5 then begin gotoxy(32,19); renk(1,7); write(m5);
giris; menu; continue; end;
if c=6 then begin gotoxy(32,20); renk(1,7); write(m6);
giris; menu; continue; end;

until b;

end; {harmenu}

begin {ana program}
randomize;
duv:=1;
repeat {sona}
R.CH:=31;
R.CL:=0;
R.Ah:=1;
R.Al:=0;
INTR($10,R);

clrscr;
puan:=0; yanma:=false;
repeat
clrscr;
cerceve(28,12,48,22);
harmenu(5,'Yeni oyun..','Seviye..','Ses..','Duvarlar','Skor tablasi','');
if c=1 then break;
if c=2 then
begin
clrscr;
cerceve(28,12,48,24);
harmenu(6,'Seviye 1','Seviye 2','Seviye 3','Seviye 4','Seviye 5','Seviye 6');
d:=true;
case c of
1 : hiz:=8500;
2 : hiz:=7000;
3 : hiz:=5500;
4 : hiz:=4000;
5 : hiz:=2400;
6 : hiz:=1750;
end;
c:=2;
end;
if c=3 then
begin
clrscr;
cerceve(28,12,48,20);
harmenu(2,'A?ik','Kapali','','','','');
if c=1 then ses:=false;
if c=2 then ses:=True;
end;
if c=4 then
begin
clrscr;
cerceve(28,12,48,22);
harmenu(5,'Duvar yok','Duvar1','Duvar2','Duvar3','Duvar4','');
duv:=c;
end;
if c=5 then skortablosu;
until 1=2;

if d=false then hiz:=3500;
clrscr;
if duv=2 then cerceve(1,1,80,49);
if duv=3 then duv2;
if duv=4 then duv3;
if duv=5 then duv4;

puanlama;
gotoxy(2,22);
write(#9#9#9#9#9);
n:=5; yemsay:=5;

yemcikar;
for i:=2 to n+1 do
begin yilanx[i-1]:=i; yilany[i-1]:=22; end; {baslangi? yilani}

repeat tus:=readkey;
if tus=#0 then tus:=readkey;
until ord(tus) in [72,77,80];

repeat {d?ng? basi}

if ord(tus) in [72,75,77,80] then
begin

gotoxy(yilanx[1],yilany[1]); write(' '); {silme}

for i:=1 to n-1 do
begin
yilanx[i]:=yilanx[i+1]; {kuyruk degeri artirma}
yilany[i]:=yilany[i+1];
end;

if tus=#77 then yilanx[n]:=yilanx[n]+1;
if tus=#75 then yilanx[n]:=yilanx[n]-1; {bas degeri artirma}
if tus=#72 then yilany[n]:=yilany[n]-1;
if tus=#80 then yilany[n]:=yilany[n]+1;

if duv in [1,3,4] then
begin
if yilanx[n]=1 then yilanx[n]:=79;
if yilanx[n]=80 then yilanx[n]:=2;
if yilany[n]=1 then yilany[n]:=48; {duvar yok}
if yilany[n]=49 then yilany[n]:=2;
end;
if (duv=2) and (yilanx[n] in [1,80]) or (yilany[n] in [1,49]) then
yanma:=true; {yanma kenarlara}
if (duv=3) then if (yilany[n] in [13,35]) and (yilanx[n] in [22..57])
or (yilanx[n] in [22,57]) and (yilany[n] in [14..21])
or (yilanx[n] in [22,57]) and (yilany[n] in [27..34]) then
yanma:=true; {duvar2 yanma}
if (duv=4) and (yilany[n] in [9..38]) then
if (yilanx[n] in [16,26,36,46,56,66]) then
yanma:=true; {duvar3 yanma}

if duv=5 then
begin
if (yilanx[n]=1) and (yilany[n] in [19..32]) then
yilanx[n]:=79;
if (yilanx[n]=80) and (yilany[n] in [19..32]) then
yilanx[n]:=2; {duvar4 ge?is}

if (yilany[n] in [1,80]) or (yilanx[n] in [1..22,61..79])
and (yilany[n] in [18,33]) or (yilany[n] in [1..17,34..48])
and (yilanx[n] in [1,80]) then yanma:=true; {duvar4 yanma}
end;

for i:=1 to n-1 do
if (yilanx[n]=yilanx[i]) and (yilany[n]=yilany[i]) then
yanma:=true; {yanma kuyruga}
if yanma then break;

for i:=1 to n do
begin
gotoxy(yilanx[i],yilany[i]);
if i=n then write(' ')
else write(#9);

end; {ilerletme}

if k=true then begin yemcikar; k:=false end;

if (yilanx[n]=yemx) and (yilany[n]=yemy) then
begin
n:=n+1; k:=true; yilanx[n]:=yilanx[n-1]; yilany[n]:=yilany[n-1];
yemsay:=yemsay+1;
if ses=false then
begin
sound(180); delay(2000); nosound;
end;
puanlama;
end; {yem yeme}

{if (k=true) and (yemsay mod 10=0) then hiz:=hiz-500; hiz artirma
if hiz<1000 then hiz:=1000;}
delay(100); {yilan hizi}

if keypressed then
begin
tus1:=readkey;
if tus1=#0 then tus1:=readkey;
if ord(tus1) in [72,75,77,80,27] then a:=true
else a:=false;
if (ord(tus) in [72,80]) and (ord(tus1) in [72,80]) then a:=false;
if (ord(tus) in [75,77]) and (ord(tus1) in [75,77]) then a:=false;
end;
end;
if a=true then begin tus:=tus1; a:=false end;

until tus=#27;

if (yanma=true) and (ses=false) then begin sound(50); delay(5000); nosound; end;
clrscr;
cerceve(33,19,47,22);
gotoxy(34,20); write('OYUN BITTI');
gotoxy(34,21); write('Puaniniz:',puan-10); readln;
R.CH:=31;
R.CL:=31;
R.Ah:=1;
R.Al:=0;
INTR($10,R);
skor(puan-10);
until 1=2; {bastan}

end.
gokhanaygun isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayısı: 187
Alt 20/06/08, 15:20   #2
firari
Mareşal
 
firari - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Sep 2007
Mesajlar: 5.835
Tecrübe Puanı: 104 firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute
Standart

Paylaşım için tşkler…
__________________



firari isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayısı: 613
Takımınız:
Alt 30/06/08, 01:53   #3
Mattet
Cumhurbaşkanı
 
Mattet - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: May 2008
Bulunduğu yer: van
Mesajlar: 7.027
Tecrübe Puanı: 48 Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute
Standart

teŞekkÜrler PaylaŞim İİÇİn
__________________





Düşmeden Bulutlarda Koşmam GereK !
Mattet isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayısı: 866
Alt 31/07/08, 15:42   #4
Neutralizer
Yasaklı kullanıcı
 
Neutralizer - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Jan 2008
Bulunduğu yer: İstediğin yerden
Mesajlar: 1.883
Tecrübe Puanı: 0 Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute
Standart

Paylaşım İçin Teşekkürler
Neutralizer isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayısı: 316
Takımınız:
Cevapla


Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 

Yetkileriniz
Yeni Mesaj yazma yetkiniz Aktif değil dir.
Mesajlara Cevap verme yetkiniz aktif değil dir.
Eklenti ekleme yetkiniz Aktif değil dir.
Kendi Mesajınızı değiştirme yetkiniz Aktif değildir dir.

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-KodlarıKapalı
Gitmek istediğiniz klasörü seçiniz


Bütün Zaman Ayarları WEZ +3 olarak düzenlenmiştir. Şu Anki Saat: 20:05 .


Powered by vBulletin
Copyright © 2000-2007 Jelsoft Enterprises Limited.
Sitemap
6, 5, 3, 7, 8, 9, 10, 11, 12, 13, 14, 15, 113, 16, 17, 18, 19, 81, 20, 27, 22, 23, 24, 25, 26, 48, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 43, 136, 40, 58, 45, 42, 44, 46, 47, 53, 54, 55, 56, 57, 59, 60, 70, 61, 62, 63, 64, 65, 66, 68, 69, 71, 72, 74, 75, 76, 77, 78, 79, 80, 82, 83, 96, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 98, 97, 100, 101, 102, 103, 106, 104, 105, 112, 109, 108, 107, 110, 111, 114, 115, 118, 116, 117, 119, 148, 154, 124, 165, 122, 120, 123, 121, 150, 153, 125, 128, 129, 131, 132, 133, 134, 135, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 151, 149, 202, 175, 164, 152, 167, 155, 156, 157, 158, 159, 160, 161, 162, 163, 195, 169, 166, 168, 170, 171, 172, 199, 174, 173, 196, 200, 176, 177, 180, 178, 179, 182, 189, 187, 184, 186, 191, 192, 193, 194, 197, 198, 201, 203, 229, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 236, 231, 232, 233, 234, 235, 237, 240, 239, 241, 243, 242, 244,