Pascal program örnekleri

+ Yorum Gönder
Webmaster ve Diğer Kodlama Dilleri Bölümünden Pascal program örnekleri ile ilgili Kısaca Bilgi
  1. 1
    aslan-67
    Üye
    Reklam

    Pascal program örnekleri

    Reklam



    Pascal program örnekleri

    Forum Alev
    {Matematiksel 2 boyutluların alanı ve çevresi 3 boyutluların ise alanı ve hacmini bulan pascak programını yazınız.}

    uses crt;
    var
    bescevre, karecev,uccevre, dikcevre:integer;
    yamukcev,kupalan, aaaa, dalan,dikprizmahacim,dikprizma,h,kalan,ualan, a,b,c,z,d,e:integer;
    silinhac,konihac,kurelan,kuphac,kurehacim:real;
    ch,zh,dc,esc,cikis,kl:char;
    label
    bas,son;
    procedure menuler;
    begin clrscr;


    Gotoxy(13,2);textcolor(2);writeln('---ALAN HESAPLAMALARI---');
    Gotoxy (10,3);textcolor(8); write ('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
    Gotoxy (10,4);textcolor(8); write ('º º');
    Gotoxy (10,5);textcolor(8); write ('º º');
    Gotoxy (10,6);textcolor(8); write ('º º');
    Gotoxy (10,7);textcolor(8); write ('º º');
    Gotoxy (10,8);textcolor(8); write ('º º');
    Gotoxy (10,9);textcolor(8); write ('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
    Gotoxy (11,4); write (' 1 - Kare Alan ');
    Gotoxy (11,5); write (' 2 - Ücgen Alan ');
    Gotoxy (11,6); write (' 3 - Dikdortgen Alan ');
    Gotoxy (11,7); write (' 4 - Kapin Alanı ');
    Gotoxy (11,8); write (' 5 - KArenin Alan� ');

    Gotoxy(43,2);textcolor(2);writeln('---€EVRE HESAPLAMALARI---');
    Gotoxy (40,3);textcolor(8);write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ ÍÍÍÍÍ»');
    Gotoxy (40,4);textcolor(8); write ('º º');
    Gotoxy (40,5);textcolor(8); write ('º º');
    Gotoxy (40,6);textcolor(8); write ('º º');
    Gotoxy (40,7);textcolor(8); write ('º º');
    Gotoxy (40,8);textcolor(8); write ('º º');
    Gotoxy (40,9);textcolor(8); write ('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
    Gotoxy (41,4); write (' k - Kare Cevre ');
    Gotoxy (41,5); write (' l - ücgen Cevresi ');
    Gotoxy (41,6); write (' m - Dikdortgen çevresi ');
    Gotoxy (41,7); write (' n - Besgenin çevresi ');
    Gotoxy (41,8); write (' o - Yamuğun çevresi ');

    Gotoxy(29,10);textcolor(2);writeln('---HACIM HESAPLAMALARI---');
    Gotoxy (26,11);textcolor(8); write ('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
    Gotoxy (26,12);textcolor(8); write ('º º');
    Gotoxy (26,13);textcolor(8); write ('º º');
    Gotoxy (26,14);textcolor(8); write ('º º');
    Gotoxy (26,15);textcolor(8); write ('º º');
    Gotoxy (26,16);textcolor(8); write ('º º');
    Gotoxy (26,17);textcolor(8); write ('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
    Gotoxy (26,12); write ('º a - Silindir Hacim');
    Gotoxy (26,13); write ('º b - Küp hacim ');
    Gotoxy (26,14); write ('º c - Koninin hacmi ');
    Gotoxy (26,15); write ('º d - Kare hacmi ');
    Gotoxy (26,16); write ('º e - Dikdorgenler Prizması ');

    gotoxy(2,18);textcolor(12);Write('Q)uit Se‡iminizi Yap�n�z=');Readln(ch);
    textcolor(7)
    end;
    Procedure yamuk;
    Begin
    Write('Yamuğun a,b,c,d Kenarlarını Giriniz:');Readln(a,b,c,d);
    yamukcev:=a+b+c+d;
    Writeln('Yamu§un €evresi=>',yamukcev);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler
    else halt;
    end;

    Procedure kup;
    Begin
    Write('K�p�n Bir Kenar ™l‡�s�n� Giriniz:');Readln(a);
    kuphac:=a*(a*a);
    Writeln('K�p�n Hacmi=>',kuphac:0:2);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler
    else halt;
    end;
    Procedure silindire;
    Begin
    Write('Silindirin Yarı çapını Giriniz(r):');Readln(a);
    Write('Y�ksekligi Giriniz(h):');Readln(b);
    silinhac:=(2*pi*sqr(a)*b);
    Writeln('Silindirin hacmi=>',silinhac:2:0);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler
    else halt;
    end;
    Procedure koni;
    Begin
    write('Koninin Yar�‡ap�n� Giriniz(r) :');Readln(a);
    Write('Koninin Y�ksekligi Giriniz(h):');Readln(b);
    konihac:=1/3*pi*a*a*b;
    Writeln('Koninin Hacmi=>',konihac:2:0);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure Besgen;
    Begin
    Write('Duzgun Besgenin bir kenar uzunlugunu giriniz:');Readln(a);
    bescevre:=a*5;
    Writeln('Besgenin €evresi=>',bescevre);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure ucgen;
    Begin
    Write('š‡genin a kenar�n� giriniz:');Readln(a);
    Write('š‡genin b kenar�n� giriniz:');Readln(b);
    Write('š‡genin c kanar�n� giriniz:');Readln(c);
    uccevre:=a+b+c;
    Writeln('š‡genin €evresi=>',uccevre);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure dikdortprizma;
    Begin
    Write('Dikdorgenler Prizmasının A ve B Kenarını Giriniz:');Readln(a,b);
    Write('Y�ksekli§i Giriniz(h):');Readln(h);
    dikprizma:=a*b;
    dikprizmahacim:=dikprizma*h;
    Writeln('Dikdorgenler Prizmasının Hacmi=>',dikprizmahacim);
    write('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure ender1;
    Begin
    write('Karenin Kenar�n� Giriniz:');
    readln(b);
    kalan:=b*b;
    writeln('Karenin Alanı=>',kalan);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure ender5;
    Begin
    write('Karenin Yarı çapını Giriniz(r):');
    readln(b);
    kurelan:=4*Pi*sqr(b);
    writeln('K�renin Alan�=>',kurelan:2:0);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    End;
    Procedure dikdort;
    Begin
    Write('Dikdortgenin a Kenar�n� Giriniz:');Readln(a);
    Write('Dikdotgenin b Kenar�n� Giriniz:');Readln(b);
    Dikcevre:=2*(a+b);
    Writeln('Dikdortgenin €evresi=>',dikcevre);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure karelan;
    Begin
    write('Karenin Bir Kenar�:');Readln(a);
    karecev:=a+a+a+a;
    writeln('Karenin €evresi=>',karecev);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure ucalan;
    Begin
    write('ücgenin a Kenaıını Giriniz:'); Readln(a) ;
    write('üçgenin b Kenarını Giriniz:');readln(b);
    write('üçgenin c Kenarını Giriniz:');readln(c);
    ualan:=a*b*c div 2;
    writeln('š‡genin Alan�=>',ualan);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure Dikalan;
    Begin
    write('Dikdortgenin a Kenarını Giriniz:'); readln(a);
    write('Dikdorgenin b Kenarını Giriniz:'); readln(b);
    dalan:=a*b;
    Writeln('Dikdortgenin Alan�=>',dalan);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure kupunalan;
    Begin
    write('Küpün Kenarını Giriniz:');readln(a);
    kupalan:=a*a*6;
    Writeln('K�p�n Alan�=>',kupalan);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Procedure kurhacim;
    Begin
    Write('Karenin Yarıçapını Giriniz:');Readln(a);
    kurehacim:=1.3*pi*a*a*a;
    Writeln('K�renin Hacmi=>',kurehacim:0:0);
    writeln('Devam etmek istiyormusunuz E\H?');readln(dc);
    if dc in ['e','E'] then menuler else halt;
    end;
    Begin

    bas:

    menuler;


    if ch in ['a','A'] then silindire;
    if ch in ['B','b'] then kup;
    if ch in ['c','C'] then koni;
    if ch in ['d','D'] then kurhacim;
    if ch in ['e','E'] then dikdortprizma;
    if ch in ['k','K'] then karelan;
    if ch in ['l','L'] then ucgen;
    if ch in ['M','m'] then dikdort;
    if ch in ['n','N'] then Besgen ;
    if ch in ['o','O'] then yamuk ;
    if ch in ['1'] then ender1;
    if ch in ['2'] then ucalan;
    if ch in ['3'] then dikalan;
    if ch in ['4'] then kupunalan;
    if ch in ['5'] then ender5;
    if ch in ['q','Q'] then Halt;
    goto bas;
    readln;
    son:
    end.

    *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

    4 işlem yapan menülü

    Uses crt;
    Var
    a,b,sonuc : Longint;
    Ch : Char;
    Secim : Byte ;

    Procedure Menuzeminiciz;
    begin
    Textcolor (Blue) ;
    Textbackground (Green) ;
    Gotoxy (31,7); write ('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
    Gotoxy (31,8); write ('º º');
    Gotoxy (31,9); write ('º º');
    Gotoxy (31,10); write ('º º');
    Gotoxy (31,11); write ('º º');
    Gotoxy (31,12); write ('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');

    Gotoxy (32,24); write (' €IKI� ESC ');

    Gotoxy (33,8); write (' 1 - Toplama ');
    Gotoxy (33,9); write (' 2 - €�karma ');
    Gotoxy (33,10); write (' 3 - €arpma ');
    Gotoxy (33,11); write (' 4 - B”lme ');

    End;

    Procedure Secimyaz ;
    begin
    Textcolor (black);
    Textbackground (red) ;
    Gotoxy (32, 7+Secim) ;
    Case Secim of
    1: write (' 1 - Toplama ');
    2: write (' 2 - €�karma ');
    3: write (' 3 - €arpma ');
    4: write (' 4 - B”lme ');
    End;
    End ;

    Procedure tusoku;
    begin
    Repeat
    Repeat
    Ch:=readkey ;
    Until ch in [#0, #13, #27] ;

    If ch = #0 then ch := readkey ;
    Until ch in [#13, #27, #72, #80] ;
    End;

    begin
    Repeat

    Secim:= 1 ;
    Clrscr ;
    Gotoxy(29,4); Writeln ;
    Gotoxy(29,5); Writeln (' --ANA MENü-- ');
    Gotoxy(29,6); Writeln ;



    Repeat
    Menuzeminiciz;
    Secimyaz;
    Tusoku;
    Case ch of
    #13 : ;
    #27 : ;
    #72 : if secim >1 then Dec(secim) else secim := 4 ;
    #80 : if secim <4 then Inc(secim) else secim := 1 ;
    End;
    Until ch in [#13,#27];

    If ch <> #27 Then
    begin
    Clrscr ;
    Gotoxy(15,5);Write ('Birinci Sayı >') ; Readln(a) ;
    Gotoxy(15,7);Write ('˜kinci Sayı >') ; Readln(b) ;
    Case secim of
    1 : Sonuc := a+b ;
    2 : Sonuc := a-b ;
    3 : Sonuc := a*b ;
    4 : If b<>0 then Sonuc := a Div 2 Else Sonuc := 0 ;
    End;
    Gotoxy (31,24); write (' €IKI� ESC ');
    Writeln ;
    Gotoxy(15,10);Write ('Sonuc=', Sonuc) ;
    Writeln ;
    Writeln ;
    Gotoxy(15,13);Write ('Devam etmek için bir tuşa basınız ...') ;
    Ch := Readkey;
    If Ch =#0 then Ch := Readkey;
    End;
    Until ch=#27 ;
    Clrscr ;
    Writeln ('HoŸ‡akal�n ...');
    readln;
    End.


    *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
    Girilen 10 sayıyı büyükten küçüğe sıraya dizen program

    uses crt;
    var

    sayi:array[1..10] of integer;
    i,j,sepet:integer;
    begin
    for i:=1 to 10 do begin
    Write(i,' . say�yi girin');Readln(sayi[i]);
    end;
    for i:=1 to 9 do Begin
    for j:=i+1 to 10 do
    Begin
    sepet:=sayi[i];
    sayi[i]:=sayi[j];
    sayi[j]:=sepet;
    end;
    end;
    for i:=1 to 10 do
    Begin
    Writeln(sayi[i]);
    end;
    readln;
    end.



    *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
    devam prosedürü

    unit devam;
    interface
    uses crt;
    Procedure devam1(var ch:char);
    implementation
    procedure devam1(var ch:char);
    Begin
    Writeln('Devam Etmek istiyormusunuz?(E\H)');
    ch:=Readkey;
    Repeat
    until ch in ['E','e','H','h'];
    if (ch='e') or (ch='E') then exit
    else halt;
    End;
    Begin
    end.


    *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

    telefon defteri dosyaya kayıtlı

    uses crt;
    procedure yesno;forward;
    procedure fAra;forward;
    procedure menu;forward;
    procedure listele;forward;
    procedure sil;forward;
    procedure duzelt;forward;
    type
    kayit=record
    isim,adr,tel:string;
    end;
    var
    dosya:file of kayit;
    dos:file of kayit;
    kay:kayit;
    tus:char;
    i:integer;
    bul:boolean;
    procedure ekle;
    begin
    {$I-} reset(dosya); {$I+}
    if IOResult<>0 then rewrite(dosya);
    repeat
    clrscr;
    write('Isim Giriniz......:');readln(kay.isim);
    write('Adres Giriniz.....:');readln(kay.adr);
    write('Telefon Giriniz...:');readln(kay.tel);
    gotoxy(40,49);write('Dosyaya Yazilsin mi?[E\H]:');
    yesno;
    if tus='E' then
    begin
    seek(dosya,filesize(dosya));
    write(dosya,kay);
    end;
    gotoxy(40,50);write('Yeni Kayit Yapacak misiniz?[E\H]:');
    yesno;
    until tus='H';
    close(dosya);
    menu;
    end;
    procedure yesno;
    begin
    repeat
    tus:=upcase(readkey);
    until tus in ['E','H'];
    end;
    procedure fAra;
    var
    aranan:string;
    begin
    {$I-} reset(dosya); {$I+}
    if IOResult<>0 then
    begin
    write('Dosya Bulunamadi');
    menu;
    end;
    clrscr;
    write('Arama yapılacak isim...:');readln(aranan);
    if aranan=" then menu;
    i:=0;
    bul:=False;
    repeat
    seek(dosya,i);
    read(dosya,kay);
    if aranan=kay.isim then
    begin
    clrscr;
    bul:=True;
    writeln('Isim...:',kay.isim);
    writeln('Adres...:',kay.adr);
    writeln('Telefon..:',kay.tel);
    writeln('Aradiginiz kayit bu mu?[E\H]:');
    yesno;
    if tus='E' then
    begin
    write('Baska Arama Yapacak misiniz?[E\H]:');
    yesno;
    if tus='H' then menu;
    end else
    begin
    write('Baska Kayit Bulunamadi.ENTER a Basin.');readln;menu;
    end;
    end;
    i:=i+1;
    until (tus='H') or (i=filesize(dosya)-1);
    if bul=False then write('Aradiginiz Kayit Bulunamadi!!!.ENTER a basin.');readln;
    close(dosya);
    menu;
    end;
    procedure menu;
    begin
    clrscr;
    gotoxy(30,23);textcolor(3);write('B');textcolor(15 );write('ilgi Girisi');
    gotoxy(30,24);textcolor(3);write('K');textcolor(15 );write('ayit Ara');
    gotoxy(30,25);textcolor(3);write('L');textcolor(15 );write('istele');
    gotoxy(30,26);textcolor(3);write('S');textcolor(15 );write('il');
    gotoxy(30,27);textcolor(3);write('D');textcolor(15 );write('�zelt');
    gotoxy(30,28);textcolor(3);write('C');textcolor(15 );write('ikis');
    gotoxy(30,29);write('Se‡iminiz...:[ ]');gotoxy(44,29);
    repeat
    tus:=upcase(readkey);
    until tus in ['B','K','C','L','S','D'];
    case tus of
    'B':ekle;
    'K':fAra;
    'L':listele;
    'S':sil;
    'D':duzelt;
    'C':Halt;
    end;
    end;
    procedure listele;
    begin
    {$I-} reset(dosya); {$I+}
    if IOResult<>0 then
    begin
    write('Dosya Bulunamadi!!!');
    readkey;
    menu;
    end;
    clrscr;
    gotoxy(10,1);write('ADI');
    gotoxy(36,1);write('ADRESI');
    gotoxy(55,1);writeln('TELEFON');
    for i:=0 to filesize(dosya)-1 do
    begin
    seek(dosya,i);
    read(dosya,kay);
    writeln(kay.isim:15,' ',kay.adr:30,' ',kay.tel:20,' ');
    end;
    gotoxy(40,49);write('Men� icin ESC');
    if readkey=#27 then
    begin
    close(dosya);
    menu;
    end;
    end;
    procedure sil;
    var
    ind:integer;
    stsil:string;
    begin
    clrscr;
    {$I-} reset(dosya); {$I+}
    if IOResult<>0 then
    begin
    write('Dosya Bulunamadi');
    menu;
    end;
    write('Silinecek kayit...:');readln(stsil);
    i:=0;
    bul:=False;
    repeat
    seek(dosya,i);
    read(dosya,kay);
    if stsil=kay.isim then
    begin
    writeln('Adi...:',kay.isim);
    writeln('Adresi..:',kay.adr);
    writeln('Telefonu..:',kay.tel);
    write('Silinecek Kayit Bu mu?[E\H]:');
    yesno;
    if tus='E' then
    begin
    bul:=True;
    assign(dos,'c:\windows\tp7\bin\telreh1.dat');
    {$I-} reset(dos); {$I+}
    if IOResult<>0 then rewrite(dos);
    for ind:=0 to filesize(dosya)-1 do
    begin
    seek(dosya,ind);
    read(dosya,kay);
    seek(dos,filesize(dos));
    if ind<>i then write(dos,kay);
    end;
    erase(dosya);
    {$I-} reset(dosya); {$I+}
    if IOResult<>0 then rewrite(dosya);
    for ind:=0 to filesize(dos)-1 do
    begin
    seek(dos,ind);
    read(dos,kay);
    seek(dosya,filesize(dosya));
    write(dosya,kay);
    end;
    write('Kayit Silindi');
    erase(dos);
    end;
    end else begin clrscr; i:=i+1; end;
    until (i=filesize(dosya)) or (bul=True);
    if bul=False then write('Silinecek Kayit Bulunamadi.!!');
    close(dosya);
    menu;
    end;
    procedure duzelt;
    var
    duz:string;
    begin
    clrscr;
    {$I-}reset(dosya);{$I+}
    if IOResult<>0 then
    begin
    write('Dosya Bulunamadi!!.');readln;menu;
    end;
    write('D�zeltilecek Ismi Girin....:');readln(duz);
    if duz=" then menu;
    i:=0;
    repeat
    seek(dosya,i);
    read(dosya,kay);
    if duz=kay.isim then
    begin
    writeln('Isim...:',kay.isim);
    writeln('Adres...:',kay.adr);
    writeln('Telefon..:',kay.tel);
    writeln('Duzeltilecek Kayit Bu mu [E\H]:');
    yesno;
    writeln;
    if tus='E' then
    begin
    write('Yeni isim...:');readln(duz);
    if duz<>" then kay.isim:=duz else menu;
    write('Yeni Adres..:');readln(duz);
    if duz<>" then kay.adr:=duz;
    write('Yeni Telefon..:');readln(duz);
    if duz<>" then kay.tel:=duz;
    write(dosya,kay);
    bul:=True;
    end else i:=i+1;
    end;
    until (bul=True) or (i=Filesize(dosya)-1);
    if bul=False then write('Kayit Bulunamadi');
    close(dosya);
    menu;
    end;
    begin
    assign(dosya,'c:\windows\tp7\bin\telreh.dat');
    menu;
    end.


    *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
    final notu hesaplama

    var
    vize1,vize2,final:integer;
    ort:real;
    ad,soyad:string;
    Begin
    Writeln('1.vizeyi giriniz:');Readln(vize1);
    Writeln('2.vizeyi giriniz:');Readln(vize2);
    Writeln('Finali giriniz:');Readln(final);
    Writeln('adı giriniz:');Readln(ad);
    Writeln('soyadı giriniz:');Readln(soy);
    ort:=vize1+vize2+final\3;
    Writeln(ad, soy,' nun ortalaması=', ort,' dır');
    readln;end;


    *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
    faktoryel bulma fonksiyon olarak

    uses crt;
    var faktor:integer;
    function fakto(a:integer):integer;
    var
    i,fak:integer;
    begin
    fak:=1;
    for i:=1 to a do
    fak:=fak*i;
    end;
    begin
    writeln('sayiyi giriniz:');
    readln(faktor);
    writeln(fakto(faktor));
    readln;
    end.



    *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
    pascal üçgeni

    Uses crt;
    VAR
    Dizi : Array[1..100,1..100] of integer;
    toplam , n : integer;
    i , j , a ,b: byte;
    BEGIN
    clrscr;
    write('Pascal üçgeninin kac satirini yazdirmak istersiniz?:');
    readln(n);
    writeln;
    FOR i:=1 TO n DO
    FOR j:=1 TO n DO
    BEGIN
    IF i=j THEN dizi[i,j]:=1;
    Dizi[i,1]:=1;
    END;
    FOR i:=1 TO n DO
    FOR j:=1 TO n DO
    IF i>=3 THEN
    IF (j>1) AND (i>j) THEN
    Dizi[i,j]:=Dizi[i-1,j]+Dizi[i-1,j-1];
    a:=25;
    b:=4;
    FOR i:=1 TO n DO
    BEGIN
    gotoxy(a,b);
    FOR j:=1 TO n DO
    BEGIN
    IF dizi[i,j]=0 THEN continue;
    write(Dizi[i,j]:2);
    END;
    b:=b+1;
    a:=a-1;
    writeln;
    END;
    readln;
    END.



    *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
    binom açılımı

    uses crt;
    var
    dizi:array[1..100,1..100] of integer;
    toplam,n,i,j,a,b:longint;
    begin
    clrscr;
    write('Binom atılımının kat sırası yazılacak>>>');
    readln(n);
    writeln;
    for i:=1 to n do
    for j:=1 to n do begin
    if i=j then dizi[i,j]:=1;
    dizi[i,1]:=1;
    end;
    for i:=1 to n do
    for j:=1 to n do
    if i>=3 then
    if (j>1) and (i>j) then
    dizi[i,j]:=dizi[i-1,j]+dizi[i-1,j-1];
    a:=40;
    b:=4;
    for i:=1 to n do begin
    gotoxy(a,b);
    for j:=1 to n do begin
    if dizi[i,j]=0 then continue;
    write(dizi[i,j]:2,' ');
    end;
    b:=b+2;
    a:=a-3;
    end;
    readln;
    end.

    *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*


    dosyaya kayıt

    var
    dosya:text;
    adi:string;
    soyadi:string;
    telefon:string;
    label aa,son;
    Begin
    clrscr;
    assign(dosya,'c:\telefon.txt');
    rewrite(doaya);
    aa:
    Writeln('Müşterinin adını giriniz');Readln(adi);
    id adi='' then goto son;
    Writeln('Müşterinin Soyadını giriniz');Readln(soyadi);
    Writeln('Müşterinin telefon numarasını giriniz');Readln(telefon
    Writeln(dosya,adi,''15-length(adi)),soyadi,''15-length(soyadi)),telefon:16);
    goto aa;
    son:
    close(dosya);
    end.



  2. Alev
    Özel Üye

    Pascal program örnekleri Makalesine henüz yorum yazılmamış. ilk yorumu siz yapın


Sponsor Bağlantılar
+ Yorum Gönder
pascal programı örnekleri,  pascal program örnekleri
5 üzerinden | Toplam : 0 kişi