sözlük
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[s]<kez[s+1] then 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. |
Paylaşım için tşkler…
|
teŞekkÜrler PaylaŞim İİÇİn
|
paylaşım için tşkrlr
|
teşekkürler
|
Bütün Zaman Ayarları WEZ +3 olarak düzenlenmiştir. Şu Anki Saat: 16:33 . |
Powered by vBulletin® Version 3.7.0
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.