Pascal Uygulamaları

**bereday21** · 02-02-2007, 01:10 PM

Kullanıcı Adı ve Şifre Programı

Kullanıcı adı doğru girilene kadar kullanıcı adını soruyor. Kullanıcı adı doğru bilindiğinde şifreyi soruyor. Şifre de doğru bilindikten sonra, kaç denemede kullanıcı adını ve kaç denemede şifreyi bildiğinizi söylüyor. ,

Uses Wincrt;

Var
KAdi,Sifre:String;
k,s:Integer;
Secim:Char;

Begin

Repeat
ClrScr;
k:=k+1;
WriteLn('Kullanıcı Adınızı giriniz');
ReadLn(KAdi);
If KAdi='kullanici_adi' Then
Begin
Repeat
ClrScr;
s:=s+1;
WriteLn('Şifrenizi giriniz');
ReadLn(Sifre);
If Sifre='huzur islamda' Then WriteLn(k,'. denemede kullanıcı adını ',s,'. denemede şifreyi doğru bildiniz');
Until Sifre='sifre'
End;

Until (Secim='5') or (sifre='sifre');

End.

**bereday21** · 02-02-2007, 01:13 PM

Geometrik Şekillerin Alan Çevre Hesabı

Pascal'da klavyeden üçgen için 1'e kare için 2'ye seçildiğinde seçilen cismin alanını veya çevresini kullanıcının menüden alan için 1'e çevre için 2'ye basmasıyla gerekli işlemin yaptırılması

uses crt;
var
karealan , karecevre , ucgenalan , ucgencevre : real;
kerea , ucgena , ucgenh , ucgen1 , ucgen2 , ucgen3 : byte;
secim1 , secim2 , secim3 , secim4 , secim5 : char;
label a;
label aa;
label ab;
label b;
label ba;
label bb;
label baslangic;
label bitis;
begin
clrscr;
baslangic :
writeln(�bu program kare ve üçgenin çevresini ve alanını hesaplar.�);
writeln(�menü�);
writeln(�1........kare�);
writeln(�2.......üçgen�);
writeln(�3.......çıkış�);
write(�seçiminiz: �);
readln(secim1);
if secim1 = 1 then goto a ;
if secim1 = 2 then goto b ;
if secim1 = 3 then goto bitis ; else write(�yalnış secim yaptınız.�) ; readln ; goto baslangic ;
a:
writeln(�kare alanı veya kare çevresi için seçiniz.�) ;
writeln(�1..............alan�);
writeln(�2.............çevre�);
writeln(�3.............çıkış�);
write(�seçiminiz: �);
readln(�secim2�);
if secim2 = 1 then goto aa;
if secim2 = 2 then goto ab;
if secim2 = 3 then goto bitis ;else write(�yanlış seçim yaptınız.�) ; readln ; goto a ;
aa:
writeln(�kare alanı için giriniz: �);
write(�kare kenarı = �);
readln(karea);
karealan:=a*a ;
write(�kare alanı = �);
writeln(karealan);
readln;
goto baslangic;
ab:
writeln(�kare çevresi için giriniz: �);
write(�kare kenarı = �);
readln(karea);
karecevre:=a*4
write(�kare çevresi = �);
writeln(karecevre);
goto baslangic;
b:
writeln(�üçgen alanı veya üçgen çevresi için seçiniz.�) ;
writeln(�1..............alan�);
writeln(�2.............çevre�);
writeln(�3.............çıkış�);
write(�seçiminiz: �);
readln(�secim3�);
if secim3 = 1 then goto ba;
if secim3 = 2 then goto bb;
if secim3 = 3 then goto bitis ;else write(�yanlış seçim yaptınız.�) ; readln ; goto b ;
ba:
writeln(�üçgen alanı için giriniz: �);
write(�üçgen yüksekliği = �);
readln(ucgenh);
write(�üçgen alt kenarı = �);
readln(ucgena);
ucgenalan:=a*h/2 ;
write(�üçgen alanı = �);
writeln(ucgenalan);
readln;
goto baslangic;
bb:
writeln(�üçgen çevresi için giriniz: �);
write(�üçgenin 1. kenarı = �);
readln(ucgen1);
write(�üçgenin 2. kenarı = �);
readln(ucgen2);
write(�üçgenin 3. kenarı = �);
readln(ucgen3);
ucgencevre:=ucgen1+ucgen2+ucgen3 ;
write(�üçgen çevresi = �);
writeln(ucgencevre);
goto baslangic;
bitis:
end.

**bereday21** · 02-02-2007, 01:15 PM

Alarm Saat

Pascal'da hazırlanan alarm saat programı

uses crt;
var
a,b,c,i,e,f,d,g:integer;
begin
clrscr;
textcolor(red);
textbackground(yellow);
writeln('alarm satini gir');readln(e);
writeln('alrm �alacak dakikay� gir');readln(f);
writeln('alar�m �alacak saniyeyi gir');readln(g);
for a:=0 to 23 do
begin
for b:=0 to 59 do
begin
for c:=0 to 59 do
begin
for d:=0 to 60 do
begin
gotoxy(37,15);writeln(a,':',b,':',c,':',d);
delay(1900);
clrscr;
textbackground(c);
if (a=e)and (b=f)and(c=g) then
begin
repeat
for i:=400 to 700 do
begin
sound(i);
delay(3);
end;
nosound;
delay(1000);
until keypressed;
end;end;end; end;end;
readln;
end.

**bereday21** · 02-02-2007, 04:34 PM

Eczane Stok Programı

Pascalda hazırlanmış çok güzel ve kullanışlı bir stok programı

uses crt,graph;
type
kayit=record
adi:string[20];
sn:string[30];
firma:string[20];
af:string[20];
sf:string[20];
eadi:string[15];
f:char;
end;
var
dosya:file of kayit;
kay:kayit;
tus,t:char;
i,kod:integer;
{-----------------------cerceve------------------------------------}
procedure cerceve;
var
i,k:byte;
begin
textcolor(green);
{----st cerceve---- }
gotoxy(0,0); write(#201);
for i:=1 to 77 do begin
k:=k+1; write(#205);
end;
write(#187);
k:=0;
for i:=1 to 3 do begin
k:=k+1; gotoxy(79,1+k); writeln(#186);
end;
gotoxy(79,4); write(#188);
k:=0;
for i:=1 to 77 do begin
k:=k+1; gotoxy(1+k,4); write(#205);
end;
gotoxy(1,4); write(#200);
k:=0;
for i:=1 to 2 do begin
k:=k+1; gotoxy(1,1+k); write(#186);
end;
{----sol cerceve---- }
gotoxy(1,5); write(#201);
k:=0;
for i:=1 to 18 do begin
k:=k+1;
gotoxy(1,5+k); writeln(#186);
end;
write(#200);
k:=0;
for i:=0 to 13 do begin
k:=k+1; write(#205);
end;
write(#188);
k:=0;
for i:=1 to 18 do begin
k:=k+1;
gotoxy(16,5+k); write(#186);
end;
gotoxy(16,5); write(#187);
k:=0;
for i:=1 to 14 do begin
k:=k+1;
gotoxy(1+k,5); write(#205);
end;
{----orta ‡er‡eve----}
gotoxy(20,5); write(#201);
k:=0;
for i:=1 to 18 do begin
k:=k+1;
gotoxy(20,5+k); write(#186);
end;
gotoxy(20,24); write(#200);
k:=0;
for i:=1 to 32 do begin
k:=k+1;
gotoxy(20+k,5); write(#205);
end;
write(#187);
k:=0;
for i:=1 to 18 do begin
k:=k+1;
gotoxy(53,5+k); write(#186);
end;
gotoxy(53,24); write(#188);
k:=0;
for i:=1 to 32 do begin
k:=k+1;
gotoxy(20+k,24); write(#205);
end;
gotoxy(30,3); write(' ECZANES˜ ');
{----sa§ ‡er‡eve----}
gotoxy(58,5); write(#201);
k:=0;
for i:=1 to 18 do begin
k:=k+1;
gotoxy(58,5+k); write(#186);
end;
gotoxy(58,24); write(#200);
k:=0;
for i:=1 to 18 do begin
k:=k+1;
gotoxy(58+k,24); write(#205);
end;
write(#188);
k:=0;
for i:=1 to 18 do begin
k:=k+1;
gotoxy(77,5+k); write(#186);
end;
gotoxy(77,5); write(#187);
k:=0;
for i:=1 to 18 do begin
k:=k+1;
gotoxy(58+k,5); write(#205);
end;
{----se‡im----}
k:=0;
for i:=1 to 32 do begin
k:=k+1;
gotoxy(20+k,21); write(#205);
end;
end;

procedure bilgigirisi;
var
k:byte;
begin
assign(dosya,'tarik.dat');
{$i-} reset(dosya);kod:=ioresult;{$i+};
if kod<>0 then rewrite(dosya);
repeat
clrscr;
gotoxy(0,0); write(#201);
for i:=1 to 77 do begin
k:=k+1; write(#205);
end;
write(#187);
k:=0;
for i:=1 to 3 do begin
k:=k+1; gotoxy(79,1+k); writeln(#186);
end;
gotoxy(79,4); write(#188);
k:=0;
for i:=1 to 77 do begin
k:=k+1; gotoxy(1+k,4); write(#205);
end;
gotoxy(1,4); write(#200);
k:=0;
for i:=1 to 2 do begin
k:=k+1; gotoxy(1,1+k); write(#186);
end;
gotoxy(30,3); write(' ECZANES˜');
gotoxy(10,8);write('ilacin adini giriniz=================>');readln(kay.adi);
if kay.adi=" then
begin
close(dosya);
exit;
end;

gotoxy(10,10);write('ilacin seri numarasi=================>');readln(kay.sn);
gotoxy(10,12);write('ilacin hangi firmadan alindigi=======>');readln(kay.firma);
gotoxy(10,14);write('ilacin alis fiyatini giriniz=========>');readln(kay.af);
gotoxy(10,16);write('ilacin satis fiyatini giriniz========>');readln(kay.sf);

gotoxy(25,20);write('bilgi kaydedilsin mi? [e/h]');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E'then
begin
kay.f:='*';
seek(dosya,filesize(dosya));
write(dosya,kay);
end;
until 1=2;
end;
{----------------------------------bilgi listeleme--------------------------}
procedure bilgilisteleme;
var
s,k:integer;
begin
assign(dosya,'tarik.dat');
{$i-} reset(dosya);kod:=ioresult;{$i+}
if i<>0 then
begin clrscr;
gotoxy(35,20);
writeln('dosya yok.....');
tus:=readkey;exit;
end;
clrscr;
gotoxy(0,0); write(#201);
for i:=1 to 77 do begin
k:=k+1; write(#205);
end;
write(#187);
k:=0;
for i:=1 to 3 do begin
k:=k+1; gotoxy(79,1+k); writeln(#186);
end;
gotoxy(79,4); write(#188);
k:=0;
for i:=1 to 77 do begin
k:=k+1; gotoxy(1+k,4); write(#205);
end;
gotoxy(1,4); write(#200);
k:=0;
for i:=1 to 2 do begin
k:=k+1; gotoxy(1,1+k); write(#186);
end;
gotoxy(1,6);
write('ilacn ad seri no alnan firma adi ');
writeln('alŸ fiyat satŸ fiyat '); ;
write('------------ ---------- ----------------- ');
writeln('------------- ------------- ');
s:=7;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);read(dosya,kay);
if kay.f='*'then
begin
s:=s+1;
gotoxy(1,s);write(kay.adi);
gotoxy(15,s);write(' ',kay.sn);
gotoxy(30,s);write(' ',kay.firma);
gotoxy(50,s);write(' ',kay.af);
gotoxy(65,s);write(' ',kay.sf);
gotoxy(30,3); write(' ECZANES˜ ');
end;
if s>48 then
begin
gotoxy(20,50);
write('diger sayfa icin bir tusa basiniz............');
tus:=readkey;
s:=0;
clrscr;
end;
end;
gotoxy(20,21);write('listelenecek kayitlar bitti............');
gotoxy(20,23);write('devam etmek icin bir tusa basiniz......');
tus:=readkey;
close(dosya);
end;
{-------------------------------silme---------------------------------}
procedure bilgisilme;
var
ara :string[30];
begin
assign(dosya,'tarik.dat');
{$i-} reset (dosya); kod:=ioresult;{$i+}
if kod <> 0 then
begin
gotoxy(30,20); write('dosya yok.................');
tus:=readkey; exit;
end;
clrscr;

gotoxy(5,23);write('silmek istediginiz ilacin adini giriniz======>');readln(ara);
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i); read(dosya,kay);
if (ara=kay.adi) and (kay.f='*') then
begin
clrscr;

gotoxy(10,9);write('ilacin adini giriniz====================>',kay.adi);
gotoxy(10,11);write('ilacin seri numarasini giriniz==========>',kay.sn);
gotoxy(10,13);write('ilacin hangi firmadan alindigi==================>',kay.firma);
gotoxy(10,15);write('ilacin alis fiyati ============>',kay.af);
gotoxy(10,17);write('ilacin satis fiyati===========>',kay.sf);
gotoxy(10,19);write('eczane adini giriniz===========>',kay.eadi);

gotoxy(25,31); write('silinecek kayit bu mu ? [e/h]');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then
begin
kay.f:='s';
seek(dosya,i);write(dosya,kay);
clrscr;
gotoxy(30,25);write('kayit silindi...........');
close(dosya);
tus:=readkey;
exit;
end;
end; {if}
end; {for}
clrscr;
gotoxy(30,25);write('kayit yok...............');
close(dosya);tus:=readkey;
end;
{-----------------------------------arama-----------------------------}
procedure bilgiarama;
var
ara :string[30];
begin
assign(dosya,'tarik.dat');
{$i-} reset(dosya); kod:=ioresult; {$i+}
if kod<>0 then
begin
clrscr;
gotoxy(20,20);writeln('dosya yok....');
tus:=readkey; exit;
end;
repeat
clrscr;

gotoxy(5,23);write('aramak istediginiz ilacin adini giriniz==>');readln(ara);
if ara =" then
begin
close(dosya); exit;
end;
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i);read(dosya,kay);
if (kay.f='*') and (kay.adi=ara) then
begin
clrscr;

gotoxy(10,9);write('ilacin adini giriniz ====================>',kay.adi);
gotoxy(10,11);write('ilacin seri numarasini giriniz ==========>',kay.sn);
gotoxy(10,13);write('ilacin hangi firmadan alindigi==================>',kay.firma);
gotoxy(10,15);write('ilacin alis fiyati============>',kay.af);
gotoxy(10,17);write('ilacin satis fiyati===========>',kay.sf);
gotoxy(10,19);write('eczane adini giriniz===========>',kay.eadi);

gotoxy(20,35); write('aradiginiz kayit bu mu ? [e/h]');
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then
begin
close(dosya); exit;
end;
end;
end;
writeln;
clrscr;

gotoxy(20,27);write('aradiginiz kayit yok..................');
gotoxy(20,29);write('devam etmek icin bir tusa basiniz.....');
tus:=readkey;
until 1=2;
end;
{---------------------------bilgi duzeltme------------------------}
procedure bilgiduzeltme;
var
k:byte;
ara:string[30];
begin
assign(dosya,'tarik.dat');
{i-} reset (dosya); kod:=ioresult; {i+}
if kod <>0 then
begin
gotoxy(20,20); write('dosya yok.....');
tus:=readkey;
exit;
end;
clrscr;

gotoxy(5,23);write('duzeltmek istediginiz malin adini giriniz==>');readln(ara);
for i:=0 to filesize(dosya)-1 do
begin
seek(dosya,i); read(dosya,kay);
if (ara=kay.adi) and (kay.f='*') then
begin
clrscr;
gotoxy(0,0); write(#201);
for i:=1 to 77 do begin
k:=k+1; write(#205);
end;
write(#187);
k:=0;
for i:=1 to 3 do begin
k:=k+1; gotoxy(79,1+k); writeln(#186);
end;
gotoxy(79,4); write(#188);
k:=0;
for i:=1 to 77 do begin
k:=k+1; gotoxy(1+k,4); write(#205);
end;
gotoxy(1,4); write(#200);
k:=0;
for i:=1 to 2 do begin
k:=k+1; gotoxy(1,1+k); write(#186);
end;
gotoxy(30,3); write(' ECZANES˜');
gotoxy(10,9);write('ilacin adini giriniz==============>',kay.adi);
gotoxy(10,11);write('ilacin seri numarasi==============>',kay.sn);
gotoxy(10,13);write('ilacin hangi firmadan alindigi====>',kay.firma);
gotoxy(10,15);write('ilacin alis fiyati================>',kay.af);
gotoxy(10,17);write('ilacin satis fiyati===============>',kay.sf);
gotoxy(10,19);write('eczane adini giriniz==============>',kay.eadi);
begin
textcolor(4);
gotoxy(30,24); write('duzeltilecek kayit bu mu ? [e/h]');
end;
repeat
tus:=upcase(readkey);
until tus in ['E','H'];
if tus='E' then
repeat
clrscr;

gotoxy(10,5);write('[1]- ilacin adini giriniz====================>',kay.adi);
gotoxy(10,7);write('[2]-ilacin seri numarasi==========>',kay.sn);
gotoxy(10,9);write('[3]-ilacin hangi firmadan alindigi==================>',kay.firma);
gotoxy(10,11);write('[4]-ilacin alis fiyati============>',kay.af);
gotoxy(10,13);write('[5]-ilacin satis fiyati===========>',kay.sf);
gotoxy(10,15);write('[6]- islem sonu--------------------');
gotoxy(10,17);write('[1/6]=seciminiz-------------------');

gotoxy(45,33);
repeat
tus:=readkey;
until tus in ['1'..'6', #27];
if tus<>#27 then
case tus of
'1':begin
clrscr;
gotoxy(14,10);write('ilacin adini giriniz===================>');readln(kay.adi);
end;
'2':begin
clrscr;
gotoxy(14,10);write('ilacin seri numarasi=========>');readln(kay.sn);
end;
'3':begin
clrscr;
gotoxy(14,10);write('ilacin hangi firmadan alindigi==================>');readln(kay.firma);
end;
'4':begin
clrscr;
gotoxy(14,10);write('ilacin alis fiyati============>');readln(kay.af);
end;
'5':begin
clrscr;
gotoxy(14,10);write('ilacin satis fiyati===========>');readln(kay.sf);
end;
'6':begin
seek(dosya,i);
write(dosya,kay);
clrscr;
gotoxy(20,22);
write('islem tamamlandi...............');
close(dosya);
tus:=readkey;
exit;
end;
end;
until 1=2;
end;
end;
clrscr;
gotoxy(25,23);write('kayit yok....................');
close(dosya);
tus:=readkey;
end;

{--------------------ana program-------------------}
begin
textbackground(0);
repeat
clrscr;
cerceve;
textcolor(15);
gotoxy(63,9); write('2005-2006');
gotoxy(61,11); writeln('E§itim-™§retim');
gotoxy(65,13); write('Yl');
gotoxy(61,15); write('Proje ™devi');
textcolor(green);
gotoxy(26,8); write('....::::MENš::::....');
gotoxy(23,10);write('-----1-bilgi girisi--------');
gotoxy(23,12);write('-----2-bilgi listeleme-----');
gotoxy(23,14);write('-----3-bilgi duzeltme------');
gotoxy(23,16);write('-----4-bilgi silme---------');
gotoxy(23,18);write('-----5-bilgi arama---------');
gotoxy(25,22);write('seciminiz (esc=cikis)');

repeat
t:=readkey;
if t=#27 then halt;
until t in ['1'..'5',#27];
case t of
'1' :bilgigirisi;
'2' :bilgilisteleme;
'3' :bilgiduzeltme;
'4' :bilgisilme;
'5' :bilgiarama;
end;
until false;
end.

**bereday21** · 02-02-2007, 04:38 PM

Sihirli kutular

Bu program n,n elemanli bir diziye; satir, sutun ve kosegendeki elemanlarinin toplamlari ayni olacak sekilde 1'den n*n'e kadar olan rakamlari yerlestirir.

uses crt;
const
MAX=15;

procedure hesapla(n:integer);
var
tablo:array[1..MAX,1..MAX] of integer;
i,j: integer;
x,y: integer;
begin
for i:=1 to n do
for j:=1 to n do tablo[i,j]:=0;

x:=n;
y:=trunc((n+1)/2);
tablo[x,y]:=1;
for i:= 2 to n*n do
begin
x:=x+1;
y:=y+1;
if (x>n) and (y>n) then
begin
x:=n-1;
y:=n;
end;
if x>n then x:=1;
if y>n then y:=1;
if tablo[x,y]<>0 then
begin
x:=x-2;
y:=y-1;
end;
tablo[x,y]:=i;
end;

for i:=1 to n do
for j:=1 to n do
begin
gotoxy(i*5,j+3);writeln(tablo[i,j]);
end;
end;

procedure giris;
var
s: integer;
tek: boolean;
begin
tek:=false;

repeat
write('tablo[n,n] icin n degerini giriniz /* n<=',MAX,' ve tek sayi olmalidir */: ');readln(s);
if s<=MAX then
begin
if s<0 then s:=s*-1;
if (s mod 2)=1 then
tek:=true
else
begin
clrscr;
writeln('Girmis oldugunuz deger tek sayi degil!');
end;
end
else
begin
clrscr;
writeln('Girmis oldugunuz sayi >',MAX,' !');
end;
until tek;

hesapla(s);
end;

begin
clrscr;
giris;
readln;
clrscr;
end.

Konu Araçları
Yazıcı Çıktısını Göster Sayfayı E-posta ile Yolla
Mod Seç
Düzenli Mod Karışık Moda Geç Konu Moduna Geç

Popüler Konular: Bydigi Forum'un En Popüler Konuları
Sizin İçin Seçtiklerimiz-1: Norton AntiVirus 2008 Panda Antivirus & Firewall 2008 AVG Anti-Virus Free Edition 8.0.100 McAfee VirusScan Enterprise 8.5i Avast! 4 Professional Edition 4.8.1169 Kaspersky Internet Security 7.0.1.325 Anti-Porn 10.4.11.15 BitDefender Internet Security 11.0.9 (2008) Eset Smart Security 3.0.642 Ad-Aware 2008	Sizin İçin Seçtiklerimiz-2: Şeftali Yetiştiriciliği Ekolojik Tarım ve Hayvancılık Süt Verimini Etkileyen Faktörler Dört barajda su bitmek üzere Karbondioksit salımı yüzde 50’den çok artacak VAN (Wan) Tarihi Amed (Diyarbakır) Tarihi İç Anadolu Hakkında Genel Bilgi Kültür ve Turizm Bakanlığı müfettiş yardımcılığı 2008 yılı icra müdür ve yardımcılığı sınav ilanı	Sizin İçin Seçtiklerimiz-3: Siz Hangi Yemeksiniz ? Doğum gününüze göre hangi hayvansınız? Doğum Tarihinize Göre Renginiz! Bebeklerde Gaz Çıkarma Virüs taşıyan keneler dehşet saçıyor Şiddetin genlerle ilişkisi olabilir Karpuz Viagra Etkisi Yapıyor Panasonic Sony'yi tahtından etti! Mehmet Atlı - Wenda 2008 grup seyran - 2008

Benzer Konular
Konu	Konuyu Başlatan	Forum	Yanıt	Son Mesaj
Turbo Pascal Menüsünün Kullanımı	bereday21	Pascal - Delphi	1	13-06-2008 07:19 PM
Object Pascal	bereday21	Pascal - Delphi	2	13-06-2008 07:18 PM
Pascal Programlama Dili	bereday21	Pascal - Delphi	3	08-02-2007 02:17 PM
Pascal Nouma	Roj73	Biyografi	3	26-11-2006 08:15 PM

Pascal Uygulamaları

Benzer Konular