2. dereceden denklem çözme

uses crt;

var

i,delta,a,b,c:integer;

sonuc1,sonuc2:real;

h,m,g,n,s,q:string;

begin

clrscr;

s:='birinci sonuc--->';

q:='ikinci  sonuc--->';

g:='NAZIM DEMiR Bilgisayar Teknolojileri ve Programlama';

writeln;

writeln;

textcolor(3);

writeln('   demirnazim@hotmail.com');

writeln;

textcolor(14);

writeln;

writeln;

writeln('                       2. DERECEDEN DENKLEM COZME');

writeln;

writeln;

writeln;

textcolor(white);

writeln('        ax^2 + bx + c = 0');

writeln;

textcolor(green);

writeln('        degerleri girin!!');

writeln;

writeln;

textcolor(white);

writeln('   a--->');

writeln;

writeln('   b--->');

writeln;

writeln('   c--->');

gotoxy(10,16);

readln(a);

gotoxy(10,18);

readln(b);

gotoxy(10,20);

readln(c);

writeln;

writeln;

delta:=(b*b)-(4*a*c);

sonuc1:=(-b-sqrt(delta))/(2*a);

sonuc2:=(

b+sqrt(delta))/(2*a);

for i:=1 to 17 do

begin

m:=copy(s,i,1);

write(m);

delay(150);

end;

writeln;

for i:=1 to 17 do

begin

n:=copy(q,i,1);

write(n);

delay(150);

end;

gotoxy(18,23);

writeln(sonuc1:3:3);

gotoxy(18,24);

writeln(sonuc2:3:3);

gotoxy(15,28);

for i:=1 to 51 do

begin

h:=copy(g,i,1);

write(h);

delay(150);

end;

readln;

end.

Devamını okuyun...>>

Kullanıcı adı ve şifre

uses crt;

var

t,s:array[1..6]of string;

tus:char;

padi,kadi:string;

i:integer;

procedure yeni;

begin

clrscr;textcolor(white);

textbackground(9);writeln;writeln;writeln;

gotoxy(30,4);writeln('YENI KAYIT');

writeln;writeln;gotoxy(5,7);

writeln('yeni kullanici adi ---> ');

writeln;writeln;gotoxy(5,10);

writeln('yeni sifre         ---> ');

writeln;writeln;writeln;textcolor(black);

writeln('    sifre 6 karakterden olusmalidir ! ! ');

gotoxy(29,7);readln(kadi);if kadi='' then exit;

i:=1;gotoxy(28,10);repeat gotoxy((28+i),10);

tus:=readkey;if tus='a' then begin

s[i]:='a';write('*');i:=i+1;

if i=7 then exit;end;if tus='b' then

begin s[i]:='b';write('*');i:=i+1;

if i=7 then exit;end;if tus='c' then

begin s[i]:='c';write('*');i:=i+1;

if i=7 then exit;end;if tus='d' then

begin s[i]:='d';write('*');i:=i+1;

if i=7 then exit;end;if tus='e' then

begin s[i]:='e';write('*');i:=i+1;

if i=7 then exit;end;if tus='f' then

begin s[i]:='f';write('*');i:=i+1;

if i=7 then exit;end;if tus='g' then

begin s[i]:='g';write('*');i:=i+1;

if i=7 then exit;end;if tus='i' then

begin s[i]:='i';write('*');i:=i+1;

if i=7 then exit;end;if tus='k' then

begin s[i]:='k';write('*');i:=i+1;

if i=7 then exit;end;if tus='l' then

begin s[i]:='l';write('*');i:=i+1;

if i=7 then exit;end;if tus='m' then

begin s[i]:='m';write('*');i:=i+1;

if i=7 then exit;end;if tus='n' then

begin s[i]:='n';write('*');i:=i+1;

if i=7 then exit;end;if tus='o' then

begin s[i]:='o';write('*');i:=i+1;

if i=7 then exit;end;if tus='p' then

begin s[i]:='p';write('*');i:=i+1;

if i=7 then exit;end;if tus='r' then

begin s[i]:='r';write('*');i:=i+1;

if i=7 then exit;end;if tus='s' then

begin s[i]:='s';write('*');i:=i+1;

if i=7 then exit;end;if tus='t' then

begin s[i]:='t';write('*');i:=i+1;

if i=7 then exit;end;if tus='u' then

begin s[i]:='u';write('*');i:=i+1;

if i=7 then exit;end;if tus='v' then

begin s[i]:='v';write('*');i:=i+1;

if i=7 then exit;end;if tus='y' then

begin s[i]:='y';write('*');i:=i+1;

if i=7 then exit;end;if tus='z' then

begin s[i]:='z';write('*');i:=i+1;

if i=7 then exit;end;until tus=#27;

end;procedure d;begin clrscr;

repeat textcolor(green);textbackground(black);

write(random(9));until 1=5 end;

procedure kontrol;begin clrscr;

textcolor(white);textbackground(9);

writeln;writeln;writeln;gotoxy(30,4);

writeln('SIFRE VE KULLANICI ADI GIRISI');

writeln;writeln;gotoxy(5,7);writeln('kullanici adi ---> ');

writeln;writeln;gotoxy(5,10);writeln('sifre         ---> ');

writeln;writeln;writeln;textcolor(black);

gotoxy(24,7);readln(padi);if padi='' then exit;

i:=1;gotoxy(24,10);repeat gotoxy((23+i),10);

tus:=readkey;if tus='a' then begin

t[i]:='a';write('*');i:=i+1;if i=7 then d;end;

if tus='b' then begin t[i]:='b';write('*');i:=i+1;

if i=7 then d;end;if tus='c' then begin

t[i]:='c';write('*');i:=i+1;if i=7 then d;end;

if tus='d' then begin t[i]:='d';write('*');i:=i+1;

if i=7 then d;end;if tus='e' then begin

t[i]:='e';write('*');i:=i+1;if i=7 then d;end;

if tus='f' then begin t[i]:='f';write('*');i:=i+1;

if i=7 then d;end;if tus='g' then begin

t[i]:='g';write('*');i:=i+1;if i=7 then d;end;

if tus='i' then begin t[i]:='i';write('*');i:=i+1;

if i=7 then d;end;if tus='k' then

begin t[i]:='k';write('*');i:=i+1;

if i=7 then d;end;if tus='l' then begin

t[i]:='l';write('*');i:=i+1;if i=7 then d;end;

if tus='m' then begin t[i]:='m';write('*');i:=i+1;

if i=7 then d;end;if tus='n' then begin

t[i]:='n';write('*');i:=i+1;if i=7 then d;end;

if tus='o' then begin t[i]:='o';write('*');i:=i+1;

if i=7 then d;end;if tus='p' then

begin t[i]:='p';write('*');i:=i+1;

if i=7 then d;end;if tus='r' then

begin t[i]:='r';write('*');i:=i+1;

if i=7 then d;end;if tus='s' then begin

t[i]:='s';write('*');i:=i+1;if i=7 then d;end;

if tus='t' then begin t[i]:='t';write('*');i:=i+1;

if i=7 then d;end;if tus='u' then begin

t[i]:='u';write('*');i:=i+1;if i=7 then d;end;

if tus='v' then begin t[i]:='v';write('*');i:=i+1;

if i=7 then d;end;if tus='y' then begin

t[i]:='y';write('*');i:=i+1;if i=7 then d;end;

if tus='z' then begin t[i]:='z';write('*');i:=i+1;

if i=7 then d;end; until tus=#27; end;begin clrscr;

repeat clrscr;writeln;writeln;writeln;writeln;writeln;

textcolor(red);textbackground(9);gotoxy(17,6);

writeln('yesil renkli karakterler ile programi yonetin');

writeln;textcolor(white);gotoxy(30,8);writeln('ILGILERI YENILEME');

writeln;writeln;writeln;gotoxy(32,12);writeln('ROGRAM GIRISI');

writeln;writeln;writeln;gotoxy(20,16);textcolor(red);

writeln('! ! ! cikis icin         tuslay�n ! ! !');

gotoxy(37,16);textcolor(green);write('<>');gotoxy(29,8);

textcolor(green);write('B');gotoxy(31,12);write('P');gotoxy(1,1);

tus:=readkey;if tus='b' then yeni;if tus='p' then kontrol;

if tus='w' then begin clrscr;for i:=1 to 6 do

write(s[i]);

readln;

end;

until tus=#27;

end.

Devamını okuyun...>>

Alan ve çevre hesaplama

Var

r,s:integer;

Begin

write ('YARI ÇAP GİRİNİZ'); readln (r);

writeln ('MENÜ');

writeln ('1-ALAN');

writeln ('2-ÇEVRE);

write ('seçiminizi giriniz='); readln (s);

if s=1 then write ('Alan=',3.14*r*r);

if s=2 then write ('Çevre=',3.14*2*r);

readln;

End.

Devamını okuyun...>>

Case..of komutları ile dört işlem

Var

x,y:integer;

s:char;

Begin

write ('Birinci Sayıyı Giriniz='); readln (x);

write ('İkinci Sayıyı Giriniz='); readln (y);

writeln ('MENÜ');

writeln ('A-TOPLA');

writeln ('B-ÇIKAR');

writeln ('C-ÇARP');

writeln ('D-BÖL');

writeln ('X-ÇIKIŞ');

write ('Seçiminizi Giriniz='); readln (s);

case s of

'A': write (x+y);

'B': write (x-y);

'C': write (x*y);

'D': write (x/y);

'X':

else write ('Yanlış Giriş');

end;

readln;

end.

Devamını okuyun...>>

Pascalda sürekli renk değiştiren yaz

uses crt;

var

a:integer;

begin

clrscr;

for a:=1 to 500 do begin

gotoxy(30,8);

textcolor(a);

writeln('Yazmak İstediginiz Yazi');

delay(500);

(*Delay Degerini KAfanıza Göre DeğiştirebiLirsiniz*)

end;

readln;

end.

Devamını okuyun...>>

Şifreleme.

uses crt;

var a:string[10]; b:integer;

begin

while a<>"mydesign" do

begin

b:=b+1;

write("Şifre Giriniz >"); readln(a);

end;

writeln(b," incide Şifreyi Bildiniz"); readln end.

Devamını okuyun...>>

Not ortalaması bulma

Program uc_notun_ortalamasini_bulur;

uses crt;

Var {degisken tanimlama blogu}



    not1,not2,not3 : integer;

    ortalama       : real;

Begin {Ana Program Bloğu}

  textcolor(1);

  write('notlari girmek icin enter a basin  ***********(en fazla 10 basamak)************');

  ReadLn;

  textcolor(3);

  write('1. notu giriniz (rakamla)---------------->:');ReadLn(not1);

  textcolor(3);

  write('2. notu giriniz (rakamla)---------------->:');ReadLn(not2);

  textcolor(3);

  write('3. notu giriniz (rakamla)---------------->:');ReadLn(not3);

  ortalama:=(not1+not2+not3)/3;

  WriteLn('******************************************************************************');

  textcolor(9);

  WriteLn('Ortalama Bulundu gormek icin enter a basin');

  WriteLn('******************************************************************************');

  ReadLn;

  textcolor(3);

  WriteLn('uc notun ortalamasi  =',ortalama:5:2);

  textcolor(12);

  WriteLn('------------------------------------------------------------------------------');

  textcolor(9);

  WriteLn('programi kullandiginiz icin tesekkurler.............................. Fatih Ok');

  textcolor(12);

  WriteLn('------------------------------------------------------------------------------');

  WriteLn('scientist.fatih@gmail.com                                                     ');

  WriteLn('------------------------------------------------------------------------------');

  textcolor(3);

  WriteLn('uc notun ortalamasi  =',ortalama:5:2);

  textcolor(90);

  WriteLn('***************bu program pascal dili ile yazilmistir*************************');

  textcolor(12);

  WriteLn('programi sonlandirmak icin Entera basin---------------FATIH OK-------P@SCAL---');

  WriteLn('******************************************************************************');

  WriteLn('programi sonlandirmak icin Entera basin---------------FATIH OK-------P@SCAL---');

  WriteLn('******************************************************************************');

  ReadLn;

end.

Devamını okuyun...>>

Hastane takip

uses crt;

type

kayit=record

isim:string;

soyad:string;

sinif:string;

no:string;

y1,y2,y3:integer;

evno:longint;

f:char;

end;

var

dosya:file of kayit;

kay:kayit;

tus,t:char;

i,kod:integer;

Procedure kayityap;

begin

assign(dosya,'ogr.dat');

{$i-} Reset (dosya);kod:=ioresult;{$i+}

if kod<>0 then rewrite(dosya);

repeat

clrscr;

gotoxy(15,5); write('Hastann;');

gotoxy(15,7); write('Adi Girin...'); Readln(kay.isim);

if kay.isim='' then

begin

close(dosya);exit;end;

gotoxy(15,9);write('Soyadi Girin...');readln(kay.soyad);

gotoxy(15,11);write('Gelis Nedeni Girin...'); readln(kay.sinif);

gotoxy(15,13);write('Hangi B”l�me G”nderildi Girin... ');readln(kay.no);

gotoxy(15,15);write('Teshis Girin...');readln(kay.evno);

gotoxy(15,17);write('Yatirilacak Mi? [e/h]');readln(kay.y1);

gotoxy(15,19);write('Kat No Girin ');readln(kay.y2);

gotoxy(15,21);write('Oda No Girin');readln(kay.y3);

gotoxy(16,23);write('Bilgiler Dosyaya yazilsin 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;

Procedure listeleme;

var

s:integer;

begin

assign(dosya,'ogr.dat');

{$i-} reset (dosya); i:=ioresult; {$i+}

if i<>0 then

begin

gotoxy(33,40); writeln('... Kayit yok ...');

tus:=readkey; halt;

end;

clrscr;

gotoxy(3,3);

writeln('                            KAYITLI HASTALARIN LISTESI');

writeln('                           ****************************');

s:=0;

for i:=0 to filesize(dosya)-1 do

begin

seek(dosya,i); read(dosya,kay);

if kay.f='*' then

begin

s:=s+7;

writeln;

writeln('* Adi          :',kay.isim);

writeln('* Soyadi       :',kay.soyad);

writeln('* Sinifi       :',kay.sinif);

writeln('* Numarasi     :',kay.no);

end;

if s>18 then

begin

gotoxy(25,60);

write('... Diger kayitlar i‡in bir tusa bas ...');

tus:=readkey;

s:=0;

clrscr;

end;

end;

gotoxy(25,40);

write('... Listelenecek Kayitlar Bitti ...');

tus:=readkey;

close(dosya);

end;

procedure arama;

var

ara:string;

begin

assign(dosya,'ogr.dat');

{$i-} reset(dosya); kod:=ioresult; {$i+}

if kod<>0 then

begin

gotoxy(33,40); writeln('... kayit yok ...');

tus:=readkey; exit;

end;

repeat

clrscr;

gotoxy(22,4); write('Aradiginiz isim...:'); 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.isim=ara) then

begin

clrscr;

gotoxy(15,7); write('Adi...:',kay.isim);

gotoxy(15,9); write('Soyadi...:',kay.soyad);

gotoxy(15,11); write('Sinifi...:',kay.sinif);

gotoxy(15,13); write('Numarasi...:',kay.no);

gotoxy(15,15); write('Ev Numarasi...:',kay.evno);

gotoxy(15,17); write('1.Yazili...:',kay.y1);

gotoxy(15,19); write('2.Yazili...:',kay.y2);

gotoxy(15,21); write('3.Yazili...:',kay.y3);

gotoxy(25,23); 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;

gotoxy(15,25);

write('Aradiginiz Kayit Yok. Devam etmek i‡in bir tusa bas');

tus:=readkey;

until 1=2;

end;

procedure duzeltme;

var

ara:string;

begin

assign(dosya,'ogr.dat');

{$i-} reset (dosya); kod:=ioresult; {$i+}

if kod<>0 then

begin

gotoxy(33,40); write('... Kayit yok ...');

tus:=readkey; exit;

end;

clrscr;

gotoxy(15,4); write('D�zeltilecek isim...:'); 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 (ara=kay.isim) and (kay.f='*') then

begin

clrscr;

gotoxy(15,7); write('Adi...:',kay.isim);

gotoxy(15,9); write('Soyadi...:',kay.soyad);

gotoxy(15,11); write('Sinifi...:',kay.sinif);

gotoxy(15,13); write('Numarasi...:',kay.no);

gotoxy(15,15); write('Ev Numarasi...:',kay.evno);

gotoxy(15,17); write('1.Yazili...:',kay.y1);

gotoxy(15,19); write('2.Yazili...:',kay.y2);

gotoxy(15,21); write('3.Yazili...:',kay.y3);

gotoxy(20,23); write('D�zeltilecek Kayit Bu Mu? [E/H]...:');

repeat

tus:=upcase(readkey);

until tus in ['E','H'];

if tus='E' then

repeat

clrscr;

gotoxy(15,7); write('1) Adi...:',kay.isim);

gotoxy(15,9); write('2) Soyadi...:',kay.soyad);

gotoxy(15,11); write('3) Sinifi...:',kay.sinif);

gotoxy(15,13); write('4) Numarasi...:',kay.no);

gotoxy(15,15); write('5) Ev Numarasi...:',kay.evno);

gotoxy(15,17); write('6) 1.Yazili...:',kay.y1);

gotoxy(15,19); write('7) 2.Yazili...:',kay.y2);

gotoxy(15,21); write('8) 3.Yazili...:',kay.y3);

gotoxy(15,23); write('9) Islem Sonu');

gotoxy(20,25); write('Se‡iminiz (1 . . 9) ...:');

repeat

tus:=readkey;

until tus in ['1'..'9'];

case tus of

'1':begin

gotoxy(15,30);

write('Adi...:'); readln(kay.isim);

end;

'2':begin

gotoxy(15,30);

write('Soyadi...:'); readln(kay.soyad);

end;

'3':begin

gotoxy(15,30);

write('Sinifi...:'); readln(kay.sinif);

end;

'4':begin

gotoxy(15,30);

write('Numarasi...:'); readln(kay.no);

end;

'5':begin

gotoxy(15,30);

write('Ev Numarasi...:'); readln(kay.evno);

end;

'6':begin

gotoxy(15,30);

write('1.Yazili...:'); readln(kay.y1);

end;

'7':begin

gotoxy(15,30);

write('2.Yazili...:'); readln(kay.y2);

end;

'8':begin

gotoxy(15,30);

write('3.Yazili...:'); readln(kay.y3);

end;

'9':begin

seek(dosya,i);

write(dosya,kay);

gotoxy(30,28); write('... Islem Tamamlandi ...');

close (dosya);

tus:=readkey; exit;

end;

#27:exit;

end;

until 1=2;

end;

end;

gotoxy(33,40); write('... Kayit Yok ...');

close(dosya);

tus:=readkey;

end;

procedure silme;

var

ara:string;

begin

assign(dosya,'ogr.dat');

{$i-} reset(dosya); kod:=ioresult; {$i+}

if kod<>0 then

begin

gotoxy(33,40); writeln('... kayit yok ...');

tus:=readkey;

exit;

end;

clrscr;

gotoxy(15,4); write('Silinecek isim...:'); 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 (ara=kay.isim) and (kay.f='*') then

begin

clrscr;

gotoxy(15,7); write('Adi...:',kay.isim);

gotoxy(15,9); write('Soyadi...:',kay.soyad);

gotoxy(15,11); write('Sinifi...:',kay.sinif);

gotoxy(15,13); write('Numarasi...:',kay.no);

gotoxy(15,15); write('Ev Numarasi...:',kay.evno);

gotoxy(15,17); write('1.Yazili...:',kay.y1);

gotoxy(15,19); write('2.Yazili...:',kay.y2);

gotoxy(15,21); write('3.Yazili...:',kay.y3);

gotoxy(25,23); 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);

gotoxy(33,40); write('... Kayit Silindi ...');

close(dosya);

tus:=readkey;

exit;

end;

end;

end;

gotoxy(33,40); write('... kayit yok ...');

close(dosya);

tus:=readkey;

end;

procedure menu;

begin

repeat

clrscr;

writeln(''); writeln(''); writeln(''); writeln('');

writeln(''); writeln(''); writeln(''); writeln('');

writeln(''); writeln(''); writeln(''); writeln('');

writeln(''); writeln(''); writeln(''); writeln('');

textcolor(9);

writeln('                              OGRENCI KAYIT PROGRAMI');

writeln('');writeln(''); writeln('');

writeln('              ***************************************************');

writeln('              * *********************************************** *');

writeln('              * *                                             * *');

writeln('              * *               ****** MENU ******            * *');

writeln('              * *              1- KAYIT GIRISI                * *');

writeln('              * *              2- KAYIT LISTELEME             * *');

writeln('              * *              3- KAYIT ARAMA                 * *');

writeln('              * *              4- KAYIT DUZELTME              * *');

writeln('              * *              5- KAYIT SILME                 * *');

writeln('              * *              6- CIKIS=ESC                   * *');

writeln('              * *                                             * *');

writeln('              * *********************************************** *');

writeln('              ***************************************************');

textcolor(2); gotoxy(100,100);

writeln('');

writeln('');

writeln('');

writeln('');

write('                                             Se‡iminiz...:');

textcolor(15); gotoxy(100,100);

repeat

tus:=readkey;

until tus in ['1'..'6',#27];

if tus<>#27 then

case tus of

'1':kayityap;

'2':listeleme;

'3':arama;

'4':duzeltme;

'5':silme;

'6':exit;

end;

until tus=#27;

end;

begin

menu;

end.

Devamını okuyun...>>

İki sayıyı toplayan program

program hesap makinası;

uses crt;

var

a,b,top:integer;

begin

writeln('lütfen birinci sayıyı giriniz');

readln(a);

writeln('lütfen ikinci sayıyı giriniz');

readln(b);

top:=a+b;

writeln('iki sayının toplamı  ',top,'  dur');

readln;

end.

Devamını okuyun...>>