Pascal Sorular?
Ö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.
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.
Yorumunuzu Ekleyin