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

3333

Emektar
27 Ara 2005
3,212
45
Little Town.


" 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 <enter> 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<kez[s+1] then
begin
gecici:=kez;
kez:=kez[s+1];
kez[s+1]:=gecici;

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

gecici3:=anlamlar;
anlamlar:=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,' ':21-length(sozcukler),
kez,' ',anlamlar);
writeln;
writeln('Min Sorgulanan 10 Kelime');
writeln('* - * - * - * - * - * - * - * - * - * - * - * - * - * - * - *');
for s:=kelime_Say-10 to kelime_say do writeln(sozcukler,
' ':21-length(sozcukler),kez,' ',anlamlar);
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.
 

THT SON MESAJLAR

Üst

Turkhackteam.org internet sitesi 5651 sayılı kanun’un 2. maddesinin 1. fıkrasının m) bendi ile aynı kanunun 5. maddesi kapsamında "Yer Sağlayıcı" konumundadır. İçerikler ön onay olmaksızın tamamen kullanıcılar tarafından oluşturulmaktadır. Turkhackteam.org; Yer sağlayıcı olarak, kullanıcılar tarafından oluşturulan içeriği ya da hukuka aykırı paylaşımı kontrol etmekle ya da araştırmakla yükümlü değildir. Türkhackteam saldırı timleri Türk sitelerine hiçbir zararlı faaliyette bulunmaz. Türkhackteam üyelerinin yaptığı bireysel hack faaliyetlerinden Türkhackteam sorumlu değildir. Sitelerinize Türkhackteam ismi kullanılarak hack faaliyetinde bulunulursa, site-sunucu erişim loglarından bu faaliyeti gerçekleştiren ip adresini tespit edip diğer kanıtlarla birlikte savcılığa suç duyurusunda bulununuz.