Pascalda ingilizce - türkçe sözlük

" Programda yanlış çalışan yerler var! ancak size yol gösterici olacağına inanıyorum. dosyadan okuma ve dosyaya yazdırma işlemleriyle yaptım. iyi çalışmalar! ..."

kod :

program sozluk;
uses crt;
const
alfabe='ABC€DEFG¦HI˜JKLMNO™PRSžTUšVYZ';
alfabe2='abc‡defg§h?ijklmno”prsŸtu?vyz';
kelime_say:word=0;
i:byte=0;

type
st20=string[21];{proc. i‡ine sozcuk u koyabilmel i‡in bu tan?mlamay? yapamak
zorunday?m.}

var
dosya:TEXT;
dosyayeri:string[50];
secim:char;
sozcuk:st20;
anlam:string[40];
sozcukler:array[1..100]of st20;
anlamlar:array[1..100]of string[40];
kez:array[1..100]of integer ;
bosluk,h:string[1];
bulundu,buyuk_harf_mi:boolean;
m,j,f,y:byte;
melis,orta:word;
UZ:byte;
harf:array[1..29,1..20] of word;

procedure siralama;
var
kar1,kar2:char;
w,x,L:word;
gecici:string[20];
gecici2:string[40];
gecici3:integer;

begin
for w:=2 to kelime_Say do begin
for x:=kelime_say downto w do
begin
for L:=1 to length(sozcukler[w]) do
begin
kar1:=sozcukler[x,L];
kar2:=sozcukler[x-1,L];
if (pos(kar1,alfabe))<(pos(kar2,alfabe))
then
begin
gecici:=sozcukler[x-1];
sozcukler[x-1]:=sozcukler[x];
sozcukler[x]:=gecici;

gecici2:=anlamlar[x-1];
anlamlar[x-1]:=anlamlar[x];
anlamlar[x]:=gecici2;

gecici3:=kez[x-1];
kez[x-1]:=kez[x];
kez[x]:=gecici3;
break;
end;
if (pos(kar1,alfabe))>(pos(kar2,alfabe)) then break;
end;
end;
end;
end;

procedure arama(var sozcuk:ST20;var bulundu:boolean;var orta:word);
var
g:word;
begin
for g:=1 to kelime_say do
begin
if sozcuk=sozcukler[g] then
begin bulundu:=true; orta:=g; break; end;
end;
end;

procedure buyutme(var sozcuk:ST20;var i,UZ:byte);
var
L:byte;
sozcuk2:string[21];
begin
UZ:=length(sozcuk);
for L:=1 to UZ do
begin
h:=copy(sozcuk,L,1);
if (pos(h,alfabe)<>0)or(pos(h,alfabe2)<>0) then
begin
i:=i+1;
if pos(h,alfabe)<>0 then sozcuk2:=sozcuk;
if pos(h,alfabe2)<>0 then
begin
y:=pos(h,alfabe2);
h:=copy(alfabe,y,1);
insert(h,sozcuk2,L);
end;
end;
end;
delete(sozcuk,1,i);
sozcuk:=sozcuk2;
sozcuk:=copy(sozcuk,1,i);
end;


procedure ekleme(var kelime_say:word);

var
flag:boolean;
L:byte;
Begin
clrscr;
repeat
repeat
i:=0;
bulundu:=false;
writeln('Eklemek istediginiz Turkce kelimeyi girin: ');
readln(sozcuk);
buyutme(sozcuk,i,UZ);
arama(sozcuk,bulundu,orta);
if (bulundu=true) then writeln('Bu sozcuk, sozlukte zaten var!');
until bulundu=false;

flag:=true;
if UZ-i>0 then
begin
writeln;
writeln('Lutfen harften baska bir karakter girmeyiniz!');
flag:=false;
end;

if UZ>20 then
begin
writeln;
writeln('Lutfen 20 harften uzun kelime girmeyiniz!');
flag:=false;
end;

if sozcuk='' then
begin
writeln;
writeln('Lutfen bosluk girmeyiniz!');
flag:=false;
end;
until flag=true;
kelime_say:=kelime_say+1;
sozcukler[kelime_say]:=sozcuk;
writeln('Sozcugun Ingilizce anlamini yaziniz: ');
readln(anlam);
anlamlar[kelime_say]:=anlam;
kez[kelime_say]:=0;
siralama;
end;

procedure silme(var kelime_say:word);
var
L:word;
begin
if kelime_say=0 then
begin
writeln('Sozlukte hic kelime yok!');
readln; exit;
end;
repeat
bulundu:=false;
writeln('Silinecek sozcugu girin: ');
readln(sozcuk);
for L:=1 to length(sozcuk) do
begin
if pos(copy(sozcuk,L,1),alfabe2)<> 0 then buyutme(sozcuk,i,UZ);
end;
arama(sozcuk,bulundu,orta);
if bulundu=false then writeln('Silmek istediginiz sozcuk,sozlukte yok!');
until bulundu=true;
for L:=orta to kelime_say-1 do
begin
sozcukler[L]:=sozcukler[L+1];
anlamlar[L]:=anlamlar[L+1];
kez[L]:=kez[L+1];
end;
kelime_say:=kelime_say-1;
writeln('Silindi!');
readln;
end;

procedure guncelleme;
var
L:byte;
begin
if kelime_say=0 then
begin
writeln('Sozlukte hic kelime yok!');
readln; exit;
end;
repeat
bulundu:=false;
writeln('Anlamini g?ncellemek istediginiz sozcugu giriniz: ');
readln(sozcuk);
for L:=1 to length(sozcuk) do
begin
if pos(copy(sozcuk,L,1),alfabe2)<> 0 then buyutme(sozcuk,i,UZ);
end;
arama(sozcuk,bulundu,orta);
if bulundu=false then
writeln('Guncellemek istediginiz sozcuk,sozlukte yok!');
until bulundu=true;
writeln('Yeni anlami giriniz: ');
readln(anlam);
anlamlar[orta]:=anlam;
writeln('Kelimenin Anlami Guncellendi!');
readln;
end;

procedure sorgulama;
var
L:byte;
begin
if kelime_say=0 then
begin
writeln('Sozlukte hic kelime yok!');
readln; exit;
end;

repeat
bulundu:=false;
writeln('Sorgulamak istediginiz sozcugu girin: ');
readln(sozcuk);
for L:=1 to length(sozcuk) do
if pos(copy(sozcuk,L,1),alfabe2)<> 0 then buyutme(sozcuk,i,UZ);
arama(sozcuk,bulundu,orta);
if bulundu=false then
writeln('Sorgulamak istediginiz sozcuk,sozlukte yok!');
until bulundu=true;
kez[orta]:=kez[orta]+1;
writeln;
writeln(sozcukler[orta],' ':21-length(sozcukler[orta])
,kez[orta],' ',anlamlar[orta]);
readln;
end;

procedure listeleme;
var
L:word;
s:byte;
begin
if kelime_say=0 then writeln('Sozlukte hic kelime yok!');
for L:=1 to kelime_say do
begin
writeln(sozcukler[L],' ':20-length(sozcukler[L]),
kez[L],' ',anlamlar[L]);
s:=s+1;
if s=50 then
begin
writeln;
writeln('diger sayfa icin tusuna basin!');
readln;
s:=0;
end;
end;
readln;
end;

procedure max_min10;
var
s:word;
nerde:boolean;
gecici:integer;
gecici2:st20;
gecici3:string[40];
begin
clrscr;;
nerde:=true;
while nerde do
begin
nerde:=false;
for s:=1 to (kelime_say-1) do
begin
if kez[s]begin
gecici:=kez[s];
kez[s]:=kez[s+1];
kez[s+1]:=gecici;

gecici2:=sozcukler[s];
sozcukler[s]:=sozcukler[s+1];
sozcukler[s+1]:=gecici2;

gecici3:=anlamlar[s];
anlamlar[s]:=anlamlar[s+1];
anlamlar[s+1]:=gecici3;
nerde:=true;
end;
end;
end;
writeln('Max Sorgulanan 10 Kelime');
writeln('* - * - * - * - * - * - * - * - * - * - * - * - * - * - * - *');
for s:=1 to 10 do writeln(sozcukler[s],' ':21-length(sozcukler[s]),
kez[s],' ',anlamlar[s]);
writeln;
writeln('Min Sorgulanan 10 Kelime');
writeln('* - * - * - * - * - * - * - * - * - * - * - * - * - * - * - *');
for s:=kelime_Say-10 to kelime_say do writeln(sozcukler[s],
' ':21-length(sozcukler[s]),kez[s],' ',anlamlar[s]);
readln;
end;

procedure tablo;
var
w,x:word;
kar:string;
yer:byte;
begin
for w:=1 to kelime_say do
for x:=1 to length(sozcukler[w]) do
begin
kar:=copy(sozcukler[w],x,1);
yer:=pos(kar,alfabe);
harf[yer,x]:=harf[yer,x]+1;
end;
for w:=1 to 29 do
begin
write(copy(alfabe,w,1),' ');
for x:=1 to 20 do write(' ',harf[w,x]);
writeln;
end;
readln;
end;

procedure cikis;
var
L:word;
begin
assign(dosya,dosyayeri);
rewrite(dosya);
for L:= 1 to kelime_say do
writeln(dosya,sozcukler[L],' ':21-length(sozcukler[L]),
kez[L],' ',anlamlar[L]);
close(dosya);
end;

BEGIN{ ANA PROGRAM}
clrscr;
repeat
repeat
writeln('dosyan?n yerini giriniz:');
readln(dosyayeri);
assign(dosya,dosyayeri);
{$I-}
reset(dosya);
{$I+}
if IOresult<>0 then writeln('Dosya Bulunamadi!!!');
until IOresult=0;

while not(EOF(dosya)) do
begin
kelime_say:=kelime_say+1;
readln(dosya,sozcukler[kelime_say],kez[kelime_say],
bosluk,anlamlar[kelime_say]);
end;
close(dosya);
for melis:=1 to kelime_say do{t?k‡e soz.un icindeki bosluklar cikdi.}
begin
for f:=1 to length(sozcukler[melis]) do
if copy(sozcukler[melis],f,1)=' 'then
begin
sozcukler[melis]:=copy(sozcukler[melis],1,f-1);
break;
end;
end;

for melis:=1 to kelime_say do
for f:=1 to length(sozcuk) do
begin
if pos(copy(sozcuk,f,1),alfabe2)<> 0 then buyutme(sozcuk,i,UZ);
end;
siralama;

if kelime_say>500 then
begin
writeln('dosyada 500 den fazla kelime var.');
writeln('Dosyadaki kelime sayisi 500 u gecmemeli!');
end;
until kelime_say<501;
repeat
clrscr;
repeat
writeln;
writeln('*************** MENU ***************');
writeln('Yeni kelime eklemek : 1');
writeln('Kelime silmek i‡in : 2');
writeln('Ingilizce anlam g?ncellemek i‡in : 3');
writeln('T?rk‡e bir kelimenin ˜ngilizce anlam? i‡in : 4');
writeln('S”zl?kteki t?m kelimeleri listelemek i‡in : 5');
writeln('En ‡ok ve en az sorgulanan kelimeleri g”rmek i‡in: 6');
writeln('Kelimelerin konumlanma tablosu i‡in : 7');
writeln('€ikmak icin : 8');
readln(secim);
until secim in['1','2','3','4','5','6','7','8'];

case secim of
'1':ekleme(kelime_say);
'2':silme(kelime_say);
'3':guncelleme;
'4':sorgulama;
'5':listeleme;
'6':max_min10;
'7':tablo;
'8':cikis;
end;
until secim='8';
END.