Pascal Sorular?

Pascal

Ödev 1:
Soru 1:
program Biliyomu;
uses wincrt;
var
bilgi1,bilgi2 : char ;
durum : integer ;
Begin
   durum := 1;
   While durum=1 do begin
       Write('Biliyor mu?[E/H]: ');
        Readln(Bilgi1);
           if Bilgi1='E' then
             begin
              Write('Bildigini Biliyor mu? [E/H]: ');
              Readln(Bilgi2);
              if Bilgi2='E' then
                Writeln('Onun pe?inden gidin! ')
            else
               Writeln('Onu uyandirin!');
          end;
   if Bilgi1='H' then
        Begin
            Write('Bilmedigini biliyor mu? [E/H]: ');
            Readln(Bilgi2);
         if bilgi2='E' then
                Writeln('Ona Ogretin!')
             else
                Writeln('Ondan Kacinin!');
        end;
      Durum:=0;
     Writeln;
     end;
   End.

Soru 2:
program dizidizidiziler;
uses wincrt;
var
d: Array [1..10,1..10] of integer ;
i,j,n : integer;
Begin
for i:=1 to 5 do begin
    D[i,1]:=1;
       for j:=2 to i+1 do
         D[i,j]:=D[i-1,j-1]+D[i-1,j];
         D[i,i+1]:=1;
     end;
Writeln(D[1,1]:5);
   For i:=1 to 5 do begin
      For j:=1 to i+1 do
        Write(D[i,j]:5);
    Writeln;
   end;
End.

Soru 3:
program regres;
uses wincrt;
type
    Tdizi1 = Array [1..100] of real;
    Tdizi2 = Array [1..10,1..10] of real;
var
           a,b: real;
           i,n:integer ;
Function dTopla (A:Tdizi1; n:integer):real;
var
          i : integer ;
         top : real ;
begin


top:=0;
     for i:=1 to n do    top:=top+A[i];
                                  dTopla:=top;
end;

Function dOrtalama(A:Tdizi1; n:integer):real;
var
          i:integer;
begin
     dOrtalama:=dTopla(a,n)/n;
end;

Function dStdSapma(A:Tdizi1; n:integer):real;
var
         i : integer ;
        ort,varyans : real ;
    begin
         ort:=dOrtalama(a,n);
    for i:=1 to n do
          varyans:=varyans+sqr(A[i]-ort);
         dStdSapma:=sqrt(varyans);
end;
var
         s,m:tdizi1;
         q,p:tdizi1;
begin
      Write('Eleman Sayisi: ');
       readln(n);
for i:=1 to n do    begin
         write( i,'.',' (Xi,Yi): ' );
          readln(s[i],m[i]);
     end;
begin
      q[i]:=s[i]*m[i];
      p[i]:=s[i]*s[i];
for i:=1 to n do
     begin
       b:=(dTopla(q,n)-((dTopla(s,n)*dTopla(m,n)/n)))/(dTopla(p,n)-                                                                        ((dTopla(s,n)*dTopla(s,n)/n)));
       a:=dOrtalama(m,n)-(b*dOrtalama(s,n));
   writeln('a: ',a:7:5);
   writeln('b: ',b:7:5);
   writeln('y = ',a:6:4,'+',b:6:4,' x');
   readln;
        end;
    end;
end.

Soru 2:
Program DostSayi;
uses wincrt;
type
        Dizi = array [1..100] of integer ;
var
       dost : integer ;
Procedure Carpanlar( n : integer ; var x : Dizi ; var i : integer) ;
var
        j : integer ;
begin
     i := 1 ;
     for j := 1 to (n-1) do
        if n mod j = 0 then begin
              x[i] := j ;
                   i := i+1 ;
End;
End;
Function Toplamlar(n : integer) : integer ;
var
       i,j,top : integer ;
               x : dizi ;
begin
      carpanlar(n,x,j) ;
            top := 0;
             for i := 1 to j-1 do
                    top := top + X[i] ;
      Toplamlar := top ;
end;
Begin
        for dost := 100 to 999 do
               if dost = Toplamlar( Toplamlar(dost) ) then
                   writeln( dost,' ve ',Toplamlar(dost),' dost sayilardir.')
End.

Ç?kt? Soru 2:

Soru 3:
Program Korelasyon;
uses wincrt;
type
          Tdizi=Array [1..100] of real;
var
              i,n : integer;
                r : real;
     x,y,a,b,c:Tdizi;
Function Topla ( M:Tdizi ; n:integer ) : real;
Var
                i : integer ;
            top : real ;
begin
       top:=0;
           for i:=1 to n do    top:=top+M[i];
                     Topla:=top;
end;
begin
        writeln('Eleman Sayisi: ');
        readln(n);
            for i:=1 to n do begin
                   write (i,'. [Xi,Yi] : ');
                   readln (X[i],Y[i]);
end;
        for i:=1 to n do
            a[i]:=sqr(x[i]*y[i]);
            b[i]:=sqr(x[i]);
            c[i]:=sqr(y[i]);
                r:=sqrt(topla(a,n)/(topla(b,n)*topla(c,n)));
    writeln('r= ',r:3:3);
                if r=0 then writeln('Degiskenler Arasinda Iliski Yoktur.')
                                 else writeln('Degiskenler Birbiriyle Iliskilidir.');
End.

Ç?kt? Soru 3:


                             Ödev 3:
Program Sihirlikare;
Uses wincrt;
Const
        Maxsayi = 11 ;
Type
        Karetipi = Array [1..maxsayi,1..maxsayi] of integer ;
Var
        Tkare : karetipi ;
        Sayi , sat , top , t : integer ;
Procedure Sihirlikareyap(Var kare : karetipi ; say : integer) ;
Var
        Num , r , c : integer ;
Begin
      for r := 1 to say do
        for c := 1 to say do
               kare[r,c] := 0 ;
        if Odd(say) then begin
               c := (say+1) div 2 ;
               r := 1 ;
           for num := 1 to sqr(say) do begin
                 if kare[r,c] <> 0 then begin
                          c := c-1 ;
                 if c<1 then c := c+say ;
                          r := r+2 ;
                 if r > say then r := r-say ;
           End ;
kare[r,c] := num ;
c := c+1 ;
          if c > say then c := c-say ;
                     r := r-1 ;
          if r < 1 then r := say ;
       End ;
   End ;
End ;
Procedure SihirliKareYaz(Var kare : karetipi ; say : integer ) ;
Var
        Sat , sut : integer ;
Begin
      for sat := 1 to say do begin
          for sut := 1 to say do
             Write( kare[sat,sut] : 4 ) ;
             Writeln ;
         End ;
    End ;
Begin
     Writeln ( 'Sihirli kare icin' ) ;
     Write( '3 ile 11 arasinda bir sayi girin: ' ) ;
      readln( sayi ) ;
      t := sayi ;
while ( sayi <= maxsayi ) and odd( sayi ) do begin

       Writeln( 'Matris boyutu = ' , sayi , ' x ' , sayi ) ;
       Writeln ;
    SihirliKareYap( tkare , sayi ) ;
    SihirliKareYaz( tkare , sayi ) ;
    Writeln ;
       Top := 0 ;
          for sat := 1 to sayi do
                top := top + tkare[ sat , 1] ;
    Writeln ( ' Satir Toplami : ' , top : 7 ) ;
    Writeln ( ' Sutun Toplami : ' , top : 7 ) ;
    Writeln ( 'Kosegen Toplami : ' , top : 7 ) ;
    Sayi := 2 ;
    Readln ;
End ;
     if ( t < 3 ) or ( t < 11 ) or ( not Odd( sayi ) ) then begin
           writeln ;
           writeln( 'Girilen sayidan sihirli kare uretilemez!!' ) ;
    End ;
End .

Program Ç?kt?s?:

Ödev 4

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ToolWin, ComCtrls, Menus, ImgList, ActnList, StdCtrls, Spin,
StdActns;

type
TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    MainMenu1: TMainMenu;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    FontDialog1: TFontDialog;
    PrintDialog1: TPrintDialog;
    ToolBar1: TToolBar;

    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    ToolButton20: TToolButton;
    ToolButton22: TToolButton;
    ImageList1: TImageList;
    Dosya1: TMenuItem;
    Yeni1: TMenuItem;
    A1: TMenuItem;
    Kaydet1: TMenuItem;
    FarklKaydet1: TMenuItem;
    N1: TMenuItem;
    Yazdr1: TMenuItem;
    N2: TMenuItem;
    k1: TMenuItem;
    Dzenle1: TMenuItem;
    GeriAl1: TMenuItem;
    N3: TMenuItem;
    Kes1: TMenuItem;
    Kopyala1: TMenuItem;
    Yaptr1: TMenuItem;
    N4: TMenuItem;
    YazTipi1: TMenuItem;
    Yardm1: TMenuItem;
    NotepadHakknda1: TMenuItem;
    procedure SelectionChange(Sender: TObject);
    procedure Yeni1Click(Sender: TObject);
    procedure k1Click(Sender: TObject);
    procedure A1Click(Sender: TObject);
    procedure FarklKaydet1Click(Sender: TObject);
    procedure Kaydet1Click(Sender: TObject);
    procedure GeriAl1Click(Sender: TObject);
    procedure Kes1Click(Sender: TObject);
    procedure Kopyala1Click(Sender: TObject);
    procedure Yaptr1Click(Sender: TObject);
    procedure YazTipi1Click(Sender: TObject);
    procedure ToolButton22Click(Sender: TObject);
    procedure Yazdr1Click(Sender: TObject);
    procedure ToolButton13Click(Sender: TObject);
    procedure ToolButton14Click(Sender: TObject);
    procedure ToolButton17Click(Sender: TObject);
    procedure ToolButton19Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure NotepadHakknda1Click(Sender: TObject);

private
   Dosya: string;
   function CurrText: TTextAttributes;

public
    { Public declarations }
end;

var
Form1: TForm1;
FUpdating: Boolean;

implementation

uses Unit2;

{$R *.dfm}
procedure TForm1.SelectionChange(Sender: TObject);
begin
with RichEdit1.Paragraph do
try
    FUpdating := True;

    ToolButton22.Down := fsBold in RichEdit1.SelAttributes.Style;
    toolButton13.Down := fsItalic in RichEdit1.SelAttributes.Style;
    toolButton14.Down := fsUnderline in RichEdit1.SelAttributes.Style;
    ToolButton19.Down := Boolean(Numbering);

    case Ord(Alignment) of
      0: toolbutton15.Down := True;
      1: toolbutton18.Down := True;
      2: toolbutton17.Down := True;
    end;

finally
    FUpdating := False;
end;
end;
function TForm1.CurrText: TTextAttributes;
begin
if RichEdit1.SelLength > 0 then Result := RichEdit1.SelAttributes
else Result := RichEdit1.DefAttributes;
end;
procedure TForm1.Yeni1Click(Sender: TObject);
var
dosya:TextFile;

begin
if Opendialog1.Execute then begin
AssignFile(Dosya,OpenDialog1.FileName);

end;

end;

procedure TForm1.k1Click(Sender: TObject);
begin
if messageDlg('De?i?iklikler Kaydedilsin mi?',
       mtConfirmation, [mbYes, mbNo],0) =
       mrYes then kaydet1click(sender); halt;
end;

procedure TForm1.A1Click(Sender: TObject);
begin
    If Opendialog1.Execute then
       RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.FarklKaydet1Click(Sender: TObject);
begin
   If SaveDialog1.Execute then
      RichEdit1.Lines.SaveToFile(Savedialog1.FileName);
end;

procedure TForm1.Kaydet1Click(Sender: TObject);
begin
     If SaveDialog1.Execute then
     richedit1.Lines.SaveToFile(Savedialog1.FileName);
end;

procedure TForm1.GeriAl1Click(Sender: TObject);
begin
with RichEdit1 do
    if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0)
end;

procedure TForm1.Kes1Click(Sender: TObject);
begin
    RichEdit1.CutToClipboard;
end;

procedure TForm1.Kopyala1Click(Sender: TObject);
begin
     RichEdit1.CopyToClipboard;
end;

procedure TForm1.Yaptr1Click(Sender: TObject);
begin
     RichEdit1.PasteFromClipboard;
end;

procedure TForm1.YazTipi1Click(Sender: TObject);
begin
      FontDialog1.Font.Assign(RichEdit1.SelAttributes);
      if FontDialog1.Execute then
    richedit1.Assign(FontDialog1.Font);

end;
procedure TForm1.ToolButton22Click(Sender: TObject);
begin
if FUpdating then Exit;
if ToolButton22.Down then
      CurrText.Style := CurrText.Style + [fsBold]
else
    CurrText.Style := CurrText.Style - [fsBold];
end;

procedure TForm1.Yazdr1Click(Sender: TObject);
begin
     if PrintDialog1.Execute then
    RichEdit1.Print(Dosya);
end;

procedure TForm1.ToolButton13Click(Sender: TObject);
begin
if FUpdating then Exit;
if ToolButton13.Down then
    CurrText.Style := CurrText.Style + [fsItalic]
else
    CurrText.Style := CurrText.Style - [fsItalic];
end;

procedure TForm1.ToolButton14Click(Sender: TObject);
begin
if FUpdating then Exit;
if ToolButton14.Down then
    CurrText.Style := CurrText.Style + [fsUnderline]
else
    CurrText.Style := CurrText.Style - [fsUnderline];
end;

procedure TForm1.ToolButton17Click(Sender: TObject);
begin
if FUpdating then Exit;
RichEdit1.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
end;

procedure TForm1.ToolButton19Click(Sender: TObject);
begin
if FUpdating then Exit;
RichEdit1.Paragraph.Numbering := TNumberingStyle(Toolbutton19.Down);
end;

procedure TForm1.ToolButton6Click(Sender: TObject);
begin
   If Opendialog1.Execute then
       RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);
end;

procedure TForm1.NotepadHakknda1Click(Sender: TObject);
begin
     Form2.show;
end;

end.

ÖDEV-2

SORU 1:
program Sifre_Turet;
uses wincrt;
var
       satir :string;
       ogrenci,sifre :text;
Function kkodturet(satir:string):string;
var
       a,b,c,d: string;
begin
    a:=copy(satir,14,1);
    b:=copy(satir,25,3);
    c:=copy(satir,7,2);
    d:=copy(satir,11,2);
       satir:=concat(a,b,c,d);
            kkodturet:=satir;
    end;
Function sifreturet(satir:string):string;
var
       s1,s2,s3,s4,s5,s6,s7,s8 :string;
Begin
      s1:=copy(satir,14,1);
      s2:=copy(satir,25,1);
      s3:= chr (random (26) + 65);
      s4:= chr (random (26) + 65);
      s5:= chr (random (26) + 65);
           str (random (10) ,s6);
           str (random (10) ,s7);
           str (random (10) ,s8);
                satir:=concat(s1,s2,s3,s4,s5,s6,s7,s8);
                sifreturet:=satir;
   end;
Begin
    assign(ogrenci,'ogrenci.txt');
    assign(sifre,'sifreler.txt');
       rewrite(sifre);
       reset(ogrenci);
          writeln(sifre,'Ögrenci No   Kullanici Sifre');
         while not Eof(ogrenci) do begin
                  readln(ogrenci,satir);
                  write(sifre,copy(satir,1,12),' ');
                  writeln(sifre,kkodturet(satir),'   ',sifreturet(satir));
         end;
   close(sifre);
   close(ogrenci);
   writeln('...');
End.

Pascal Sorular?

Ara Notlar

Anket

İlgili Web Siteleri