Bi Kaç Pascal Kodu

[MaXXSoFT]

Güzel bir file ornegi .

program ajanda_binary_file_ile;
uses wincrt;
type
kayit= record
ad , okul , tel: string[15];
end;
var
dd: file of kayit;
rehber1, rehber2: kayit;
n, karar, i: integer;
sifre: string;
function adres(rehber1: kayit):integer;
var
chb, chs: char;
b,s,uz: integer;
begin
uz:= length(rehber1.ad);
chb:= rehber1.ad[1];
chs:= rehber1.ad[uz];
b:= ord(chb);
s:= ord(chs);
adres:= ( ( b+s) * uz ) mod (filesize(dd));
end;


procedure kaydet;
var
ch1: char;
begin
repeat
write('---- ad >>> '); readln(rehber1.ad);
write('---- okul >>> '); readln(rehber1.okul);
write('---- telefon >>> '); readln(rehber1.tel);
seek(dd, adres(rehber1));
read(dd,rehber2);
if (length(rehber2.ad) <> 0) then
begin
writeln('!!! UYARI !!! kayit yapilacak yerde zaten baska bir kayit var')
end
else
begin
seek(dd,adres(rehber1));
write(dd,rehber1);
writeln('-------------!!! kayit olusturuldu !!!------------------')
end;
writeln('devam etmek istiyormusunuz??? < e , h >');
ch1:= readkey;
until ch1 in ['h', 'H' ]
end;


procedure degistir;
var
ch: char;
begin
writeln(' degistirmek istediginiz kisinin adini giriniz... ');
write('ad >>> ');
readln(rehber1.ad);
seek(dd, adres(rehber1));
read(dd, rehber2);
writeln('aradiginiz kisinin yerinde bulunan bilgiler...');
writeln('----------------------------------------------------------');
writeln(rehber2.ad:20, rehber2.okul:20,rehber2.tel: 20);
writeln('-----------------------------------------------------------');
writeln('aradiginiz bilgiler bunlar mi??? < e , h > ');
ch:=readkey;
if ch in ['e', 'E' ] then
begin
write(' ad >>> ');readln(rehber2.ad);
write(' okul >>> '); readln(rehber2.okul);
write(' telefon >>> '); readln(rehber2.tel);
seek(dd,adres(rehber1));
write(dd, rehber2);
writeln('------------ !!!! bilgiler degistirildi !!!! --------------- ');
end
else
writeln(' aradiginiz kisi bulunamadi!!! tekrar deneyin!!! ');
end;
procedure oku;
begin
for i:=1 to (filesize (dd) - 1) do
begin
seek(dd, i);
read(dd,rehber1);
if (length( rehber1.ad)<>0) then
begin
writeln('-------------------------------------------------------');
writeln(rehber1.ad:20,rehber1.okul:20, rehber1.tel:20)
end
end;
writeln; writeln;
writeln('---------------------- !!! bilgiler yazdirildi !!! ------------------------');
end;
label
bas,son, yer1,yer2,yer3,yer4;
begin
writeln('------------------------------------------------------------------------------');
writeln;
writeln('---------------------- A --- J --- A --- N --- D --- A ---------------------' );
writeln;
writeln('-------------------------------------------------------------------------------');
assign(dd, 'rehber.dat');
reset(dd);
bas:
writeln(' 1 : dosya olusturacagim (kayitlar silinir)');
writeln(' 2 : yeni kayit ekleyecegim');
writeln(' 3 : varolan kaydi degistirecegim');
writeln(' 4 : ajandami gorecegim');
writeln(' 5 : isim bitti, ben kacar hocaaaa! ');
readln(karar);
case karar of
1: goto yer1;
2: goto yer2;
3: goto yer3;
4: goto yer4;
5: goto son
end;
yer1: writeln('sifre??? ))');
readln(sifre);
if (sifre='kopuk') then
begin
close(dd); rewrite(dd);
write(' kac tane kayit olusturulacak >>> '); readln;
for i:=1 to n do
begin
seek(dd,i);
rehber1.ad:='';rehber1.okul:=''; rehber1.tel:='';
write(dd,rehber1);
end;
writeln('--------------------------!!! dosya olusturuldu !!!----------------------------');
close(dd); reset(dd);
end
else
writeln(' !!!yanlis sifre!!!------------!!! yabanci!!!--------------');
goto bas;
yer2:writeln('sifre??? ))');
readln(sifre);
if (sifre='kopuk') then
begin
kaydet;
end
else
writeln(' !!!yanlis sifre!!!------------!!! yabanci!!!--------------');
goto bas;
yer3: writeln('sifre??? ))');
readln(sifre);
if (sifre='kopuk') then
begin
degistir;
end
else
writeln(' !!!yanlis sifre!!!------------!!! yabanci!!!--------------');
goto bas;
yer4: writeln('sifre??? ))');
readln(sifre);
if (sifre='kopuk') then
begin
oku;
end
else
writeln(' !!!yanlis sifre!!!------------!!! yabanci!!!--------------');
goto bas;
son:
writeln('--------- güle güle, iYi GüNLER ------------')
end.

 

[MaXXSoFT]

Güzel telefon defteri...


uses crt;
type
kayit=record
hesap,maas:longint;
adres:string[30];
tel:string[11];
isim,soy:string[30];
egit,hobi,fobi,meslek,web,mail:string[40];
f:char;
end;
var
dosya:file of kayit;
kay:kayit;
tus:char;
s,dongu,i,kod:integer;
ara:string[20];

procedure kutuciz(baslik:string; x1,y1,x2,y2:byte);
begin

for dongu:=x1 to x2 do
begin
gotoxy(dongu,y1);write('Í');
gotoxy(dongu,y2);write('Í');
end;
for dongu:=y1 to y2 do
begin
gotoxy(x1,dongu);writeln('º');
gotoxy(x2,dongu);writeln('º');
end;
gotoxy(x1,y1);writeln('É');
gotoxy(x2,y1);writeln('»');
gotoxy(x1,y2);writeln('È');
gotoxy(x2,y2);writeln('¼');
gotoxy(x1+1,y1);writeln('[ ]');
textcolor(lightgreen);
gotoxy(x1+2,y1);writeln('ş');
textcolor(white);
gotoxy(x1+5,y1);writeln(baslik);
end;
procedure ust_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

for dongu:=x1 to x2 do
begin
gotoxy(dongu,y1);write('Í');
gotoxy(dongu,y2);write('Í');
end;
for dongu:=y1 to y2 do
begin
gotoxy(x1,dongu);writeln('º');
gotoxy(x2,dongu);writeln('º');
end;
gotoxy(x1,y1);writeln('É');
gotoxy(x2,y1);writeln('»');
gotoxy(x1,y2);writeln('È');
gotoxy(x2,y2);writeln('¼');
end;


procedure alt_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

for dongu:=x1 to x2 do
begin
gotoxy(dongu,y1);write('Í');
gotoxy(dongu,y2);write('Í');
end;
for dongu:=y1 to y2 do
begin
gotoxy(x1,dongu);writeln('º');
gotoxy(x2,dongu);writeln('º');
end;
gotoxy(x1,y1);writeln('É');
gotoxy(x2,y1);writeln('»');
gotoxy(x1,y2);writeln('È');
gotoxy(x2,y2);writeln('¼');
end;
procedure sag_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

for dongu:=x1 to x2 do
begin
gotoxy(dongu,y1);write('Í');
gotoxy(dongu,y2);write('Í');
end;
for dongu:=y1 to y2 do
begin
gotoxy(x1,dongu);writeln('º');
gotoxy(x2,dongu);writeln('º');
end;
gotoxy(x1,y1);writeln('É');
gotoxy(x2,y1);writeln('»');
gotoxy(x1,y2);writeln('È');
gotoxy(x2,y2);writeln('¼');
end;
procedure yazi_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

for dongu:=x1 to x2 do
begin
gotoxy(dongu,y1);write('Í');
gotoxy(dongu,y2);write('Í');
end;
for dongu:=y1 to y2 do
begin
gotoxy(x1,dongu);writeln('º');
gotoxy(x2,dongu);writeln('º');
end;
gotoxy(x1,y1);writeln('É');
gotoxy(x2,y1);writeln('»');
gotoxy(x1,y2);writeln('È');
gotoxy(x2,y2);writeln('¼');
end;



procedure sol_kutu(baslik:string; x1,y1,x2,y2:byte);
begin

for dongu:=x1 to x2 do
begin
gotoxy(dongu,y1);write('Í');
gotoxy(dongu,y2);write('Í');
end;
for dongu:=y1 to y2 do
begin
gotoxy(x1,dongu);writeln('º');
gotoxy(x2,dongu);writeln('º');
end;
gotoxy(x1,y1);writeln('É');
gotoxy(x2,y1);writeln('»');
gotoxy(x1,y2);writeln('È');
gotoxy(x2,y2);writeln('¼');
GOTOXY(20,12);writeln('HAZIRLAYAN: UGUR GšVEN & OSMAN CiVELEK');
gotoxy(12,41);writeln('[email protected] [email protected]')
end;



{listeleme procedure si}

procedure listele;
begin
clrscr;
assign(dosya,'maas.dat');
{$i-} reset(dosya); kod:=ioresult; {$i+}
if kod<>0 then begin textcolor(red);
kutuciz('listele',15,15,60,5);
gotoxy(35,25);write('dosya yok');
tus:=readkey; halt;
end;
s:=11;
for i:=0 to filesize(dosya)-1 do
begin
textcolor(red);
seek(dosya,i);
read(dosya,kay);
if kay.f='*' then begin
s:=s+1;
kutuciz('listele',5,10,76,23);
gotoxy(6,s); write(i+1:3);
gotoxy(12,s); write('Isim..:',kay.isim);
gotoxy(34,s); write('Soyad..:',kay.soy);
gotoxy(56,s); write('Tel..:',kay.tel);
end;
if s>20 then begin
readkey;
tus:=readkey;
s:=11;
clrscr;
end;
end;
close(dosya);
readln;
end;

{kayit yapma procedur �}
procedure kayityap;
begin
assign(dosya,'maas.dat');
{$i-} reset(dosya); kod:=ioresult; {$i+};
if kod<>0 then rewrite(dosya);
repeat
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('MENU',20,18,60,33);
gotoxy(23,22); write('Isim......:');
gotoxy(23,24); write('Soyisim...:');
gotoxy(23,26); write('Adres.....:');
gotoxy(23,28); write('Telefon...:');
gotoxy(23,30); write('Mail......:');
gotoxy(35,22); readln(kay.isim);
gotoxy(35,24); readln(kay.soy);
gotoxy(35,26); readln(kay.adres);
gotoxy(35,28); readln(kay.tel);
gotoxy(35,30); readln(kay.mail);
gotoxy(24,36); write('Bilgi Dosyaya Yazilsinmi [E/H]');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then begin
clrscr;
kay.f:='*';
seek(dosya,filesize(dosya));
write(dosya,kay);
end;
until 3=3;
end;

{d�zelt me prodecure si}

procedure duzelt;
var
ara:string[30];
begin
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT DUZELT',20,18,60,33);
assign(dosya,'maas.dat');
{$i-} reset (dosya); kod:=ioresult; {$i+}
if kod<>0 then begin writeln('dosya yok.....');
tus:=readkey; exit;
end;
gotoxy(23,25);write('D�zeltilecek Isim...:'); readln(ara);
writeln;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);
read(dosya,kay);
if (ara=kay.isim) and (kay.f='*') then begin
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT DšZELT',20,18,60,33);
gotoxy(23,22); write('Isim......:',kay.isim);
gotoxy(23,24); write('Soyisim...:',kay.soy);
gotoxy(23,26); write('Adres.....:',kay.adres);
gotoxy(23,28); write('Telefon...:',kay.tel);
gotoxy(23,30); write('Mail......:',kay.mail);
gotoxy(24,36); writeln('d�zeltilecek kayit bu mu? [E/H]');

repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then begin
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT DšZELT',20,18,60,33);
textcolor(red);
GOTOXY(23,22); write('Yeni isim......:');
gotoxy(23,24); write('Yeni Soyisim...:');
gotoxy(23,26); write('Yeni adres.....:');
gotoxy(23,28); write('Yeni telefon...:');
gotoxy(23,30); write('Yeni Mail......:');
gotoxy(39,22); readln(kay.isim);
gotoxy(39,24); readln(kay.soy);
gotoxy(39,26); readln(kay.adres);
gotoxy(39,28); readln(kay.tel);
gotoxy(39,30); readln(kay.mail);
gotoxy(24,36); write('Bilgiler D�zeltiliyor.');
delay(1000);
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT DšZELT',20,18,60,33);
textcolor(red);
clrscr;
seek(dosya,i);
write(dosya,kay);
close(dosya);

exit;
end;
end;{if}
end;{for}
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT DšZELT',20,18,60,33);
textcolor(red);
gotoxy(35,36);writeln('kayit yok...');
close(dosya);
tus:=readkey;
end;


{arama procedure si}

procedure arama;
begin
assign(dosya,'maas.dat');
{$i-} reset(dosya); kod:=ioresult; {$i+}
if kod<>0 then begin writeln('Dosya yok'); tus:=readkey; halt; end;
repeat;
clrscr;
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('MENU',20,18,60,33);

GOTOXY(23,25);write('Aradiniz isim...:'); readln(ara);
if ara='' then exit;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);
read(dosya,kay);
if (kay.f='*') and (kay.isim=ara) then begin
clrscr;
gotoxy(43,32); write('Arama Tamamlandi.');
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT ARAMA',20,18,60,33);
GOTOXY(23,21); write('isim......:',kay.isim);
gotoxy(23,23); write('Soyisim...:',kay.soy);
gotoxy(23,25); write('Adres.....:',kay.adres);
gotoxy(23,27); write('Telefon...:',kay.tel);
gotoxy(23,29); write('Mail Adresiniz..:',kay.mail);
gotoxy(25,36); write('Aradiginiz Kayit Bu Mu ? [E/H]');

REPEAT
tus:=upcase(readkey);
until tus in ['E','H',#27];
if (tus='E') or (tus=#27) then exit;
end;
end;{for}
CLRSCR;
textcolor(red);

ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue);kutuciz('KAYIT ARAMA',20,18,60,33);
gotoxy(25,36);writeln('Aradiginiz kayit yok.....');
tus:=readkey;
until 1=2;
end;

{ana men� procedure si}
procedure menu;
begin
repeat
CLRSCR;
textcolor(darkgray);
textcolor(red);
ust_kutu('',5,9,75,15);
alt_kutu('',5,38,75,44);
sol_kutu('',5,16,17,36);
sag_kutu('',63,16,75,36);
textcolor(blue);yazi_kutu('',20,35,60,37);
textcolor(red);
textcolor(blue); kutuciz('KAYIT ARAMA',20,18,60,33);
GOTOXY(23,22);writeln('[ F1 ] KAYIT EKLE ');
GOTOXY(23,24);writeln('[ F2 ] KAYIT ARA');
GOTOXY(23,26);writeln('[ F3 ] KAYIT DšZELT');
GOTOXY(23,28);writeln('[ F4 ] KAYIT LiSTELE');
GOTOXY(23,30);writeln('[ ESC ] €IK');
tus:=readkey; case tus of
';':kayityap;
'<':arama;
'=':duzelt;
'>':listele;
#27:halt;
end;
until 1=2;
end;


begin {ana program}
menu;
kayityap;
arama;
close(dosya);
end.

 

[MaXXSoFT]

Girilen kelimeyi bütün renkler le yazan Güzel Bi Program !


uses crt;
var
i:byte;
ad:string;
begin
clrscr;
writeln('kelime gir:');readln(ad);
for i:=1 to 15 do begin
textcolor(i); writeln(ad);
end;
gotoxy(12,25);writeln(ahmet);
readln;
end;

 

[MaXXSoFT]

Bi Kaç Pascal Kodu daha

Rakamları büyükten küçüğe sıralar..


uses crt;
var
say:array [1..5] of real;
sec, a, b:byte;
c:real;

procedure verioku;
begin
for a:=1 to 5 do
begin

write(a,'. say�:'); readln(say[a]);
end;
end;

procedure verileriyaz;
begin
clrscr;

for a:=1 to 5 do
begin
for b:=a+1 to 5 do
begin
if say[a]<say then
begin
c:=say[a]; say[a]:=say; say:=c;
end;
end;
end;
writeln;

for a:=1 to 5 do writeln(say[a]:5:3);
readln;
end;

begin
repeat
clrscr;
textcolor(12); gotoxy(21,2); write('ABDUSSAMET PEKTAS----FATIH PEKTAS');
textcolor(10); gotoxy(23,3); write('NIKSAR ENDUSTRI MESLEK LISESI');
textcolor(6); gotoxy(29,4); write('TEKNIK LISE 2-B 12');
gotoxy(23,5); write('NIKSAR ILKOGRETIM OKULU 5-A 248');
textcolor(5); gotoxy(32,8); write('***MENU***');
gotoxy(30,10); write('1-Ver� g�r�s�');
gotoxy(30,11); write('2-S�ralama');
gotoxy(30,12); write('3-C�k�s');
gotoxy(30,14); write('Sec�m�n�z:'); readln(sec);
if sec=1 then verioku;
if sec=2 then verileriyaz;
until sec=3;
end.

 

[MaXXSoFT]

güzel bir sayı bulmaca oyunu ..

uses crt;
hak,tah,max,t,x:integer;
x:integer;
begin
clrscr;
write^('hak sayısını giriniz:');readln(hak);
write('maximum sınırı giriniz:');readln(max);
randomize;
t:=random(max);
for x:=1 to hak do begin
write(x,'.sayıyı giriniz:');readln(tah);
if t=tah then begin write('kazandınız...');readln;halt;end;
if t>tah then write('daha büyük sayı giriniz:');
if t<tah then write('daha küçük sayı giriniz:');
end;
readln;
end.

 

[MaXXSoFT]

Ezcane program tasarımı


ANA PROGRAM BU ANAPROG.PAS OLARAK KAYDET
Uses Crt,Secim,Yazi;
Const
M : Menutip = ( ' Bilgi Girisi ',
' Bilgi Listele ',
' Bilgi Arama ',
' Bilgi D�zeltme ',
' Bilgi Silme ',
' €iKiS ');
Var
X,i : Byte;
Begin
clrscr;
bas1;
renk(0,0);
Clrscr;
Renk(7,0);
Cerceve('T',2,2,80,48,2);
yazi1;yazi2;
Cerceve('T',32,21,49,28,15);
Sec('Y',M,22,33,6,1,x,true);
case X of
1 : ;
2 : ;
3 : ;
4 : ;
5 : ;
6 :exit;
end;


end.


UNİTİ HAZİRLA SECİM.PAS OLARAK KAYDET

Unit secim;
Interface
Uses crt;
Type
MenuTip = Array[1..6] of string[30];
procedure Sec(Sekil :Char;
Menu :Menutip;
Satir,Sutun,Elsay,Artis :Byte;
var X :Byte;
EscEvet :Boolean);
procedure Cerceve(Sek:Char; X1,Y1,X2,Y2,R :byte);
procedure Renk(Y,Z:byte);

Implementation

procedure Renk;
begin
Textcolor(Y);
Textbackground(Z);
end;

Procedure Sec;
var
Sat , Sut , i :byte;
Tus :char;
begin
Sekil :=Upcase(Sekil);
renk(4,7);Sat:=Satir;Sut:=Sutun;
for i:=1 to elsay do
begin
gotoxy(Sut,Sat);write(menu);
if Sekil='Y' then
Sat:=Sat+Artis Else Sut:=Sut+Artis;
end;
Sut:=Sutun;Sat:=Satir;gotoxy(Sut,Sat);
renk(8,3);write(menu[1]);X:=1;
repeat
Tus:=readkey;if Tus=#0 then Tus:=readkey;
Renk(4,7);
case Sekil of

'Y':
if (Tus=#80) or (Tus=#72) then
begin
gotoxy(Sut,Sat);write(menu[x]);
if Tus=#80 then {Asagi Ok}
if x>Elsay-1 then
begin x:=1;Sat:=Satir;end
else
begin x:=x+1;Sat:=Sat+Artis;end;
if Tus=#72 then {Yukari Ok}
if x<2 then
begin x:=Elsay;Sat:=Satir+(Elsay -1)*Artis;End
else
begin x:=x-1;Sat:=Sat-Artis;end;
gotoxy(Sut,Sat);renk(8,3);write(menu[x]);
end;
end;
Until Tus=#13;
end;

Procedure Cerceve;
Var
I:integer;
Cizgi:string[80];
Begin
Renk(r,7);Sek:=Upcase(Sek);
Case Sek of
'T':Begin
fillchar(Cizgi,x2-x1,#196);
Cizgi[0]:=chr(x2-x1-1);
gotoxy(X1,Y1);write( chr(218),Cizgi,Chr(191));
for I:=Y1+1 to Y2-1 do
begin
gotoxy(X1,I);write(Chr(179));
gotoxy(X2,I);write(Chr(179));
end;
gotoxy(X1,Y2);write(Chr(192),Cizgi,Chr(217));
end;
'C':Begin
fillchar(Cizgi,x2-x1,#205);
Cizgi[0]:=chr(x2-x1-1);
gotoxy(X1,Y1);write( chr(201),Cizgi,Chr(187));
for I:=Y1+1 to Y2-1 do
begin
gotoxy(X1,I);write(Chr(186));
gotoxy(X2,I);write(Chr(186));
end;
gotoxy(X1,Y2);write(Chr(200),Cizgi,Chr(188));
end;
end;
end;
end.

UNİTEDE YAZİ.PAS OLARAK KAYDET
unit yazi;

interface
Uses crt;
Procedure yazi1;
procedure yazi2;
Procedure bas1;
implementation
Procedure yazi1;
begin
textcolor(9);
gotoxy(8,3);
delay(24000);Write(' E');
delay(24000);Write(' z');
delay(24000);Write(' c');
delay(24000);Write(' a');
delay(24000);Write(' n');
delay(24000);Write(' E');
delay(24000);Write(' ');
delay(12000);Write(' I');
delay(12000);Write(' s');
delay(12000);Write(' l');
delay(12000);Write(' e');
delay(12000);Write(' M');
delay(24000);Write(' ');
delay(6000);Write(' O');
delay(6000);Write(' t');
delay(6000);Write(' a');
delay(6000);Write(' m');
delay(6000);Write(' a');
delay(6000);Write(' s');
delay(6000);Write(' y');
delay(6000);Write(' o');
delay(6000);Write(' N');
delay(24000);Write(' ');
delay(6000);Write(' P');
delay(6000);Write(' r');
delay(6000);Write(' o');
delay(6000);Write(' g');
delay(6000);Write(' r');
delay(6000);Write(' a');
delay(6000);Write(' m');
delay(6000);Write(' I');
end;
procedure yazi2;
begin
gotoxy(11,47);
textcolor(12);
delay(12000);Write(' T');
delay(12000);Write(' a');
delay(12000);Write(' s');
delay(12000);Write(' a');
delay(12000);Write(' r');
delay(12000);Write(' l');
delay(12000);Write(' a');
delay(12000);Write(' y');
delay(12000);Write(' a');
delay(12000);Write(' n');
delay(25000);Write('..');
delay(20000);Write('..');
delay(15000);Write('..');
delay(24000);Write(' ');
delay(6000);Write('Stacer');
delay(6000);Write(' ');
delay(6000);Write(' b');
delay(6000);Write('y');
delay(8000);Write(' ');
delay(6000);Write(' Sahin');
delay(6000);Write(' ');
delay(6000);Write(' Akin');
end;
procedure bas1;
begin
textcolor(4);textbackground(0);
gotoxy(41,23);write('Program A‡iliyor.... ');
gotoxy(23,20);write('L�tfeN BekleyiniZ');
delay(60000);
gotoxy(15,44);
textcolor(3);
write('ÎÎ');delay(50000);
write('ÎÎÎÎ');delay(50000);
write('ÎÎ');delay(50000);
write('ÎÎÎÎ');delay(50000);
write('ÎÎ');delay(50000);
write('ÎÎÎÎ');delay(50000);
write('ÎÎ');delay(50000);
write('ÎÎÎÎ');delay(50000);
write('ÎÎ');delay(50000);
write('ÎÎÎÎ');delay(50000);
write('ÎÎ');delay(50000);
write('ÎÎÎÎ');delay(50000);
write('ÎÎ');delay(50000);
write('ÎÎÎÎ');delay(50000);
write('ÎÎ');delay(50000);
write('ÎÎÎÎ');delay(50000);
end;


end.

 

[MaXXSoFT]

Bu Bölüm Pascal Bölümü Deil ama Umarım Bişi Olmaz !

 

[SevencLoves]

Konuların birleşti

Eline sağlık bu arada

 

[MaXXSoFT]

Thanx Dostum !

 

[berkneis]

çok saol ama kodlar yanlış

 

[cfrkr]

tsklr anlamıyorum ama bunlardan iyi bişeydir heralde

 

[kuzay]

saol dostum