Geri git   Van.GEN.TR Forum | Yerel Van Forumu > Bilgisayar > Programlama > Pascal

Cevapla
 
Konu Araçları Stil
Alt 24/04/07, 00:57   #1
gokhanaygun
Tuğgeneral
 
gokhanaygun - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Apr 2007
Bulunduğu yer: VAN
Yaş: 36
Mesajlar: 925
Tecrübe Puanı: 26 gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold gokhanaygun is a splendid one to behold
Standart 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.
gokhanaygun isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayısı: 187
Alt 20/06/08, 15:23   #2
firari
Mareşal
 
firari - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Sep 2007
Mesajlar: 5.839
Tecrübe Puanı: 104 firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute firari has a reputation beyond repute
Standart

Paylaşım için tşkler…
__________________



firari isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayısı: 613
Takımınız:
Alt 30/06/08, 01:55   #3
Mattet
Cumhurbaşkanı
 
Mattet - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: May 2008
Bulunduğu yer: van
Mesajlar: 7.116
Tecrübe Puanı: 48 Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute Mattet has a reputation beyond repute
Standart

teŞekkÜrler PaylaŞim İİÇİn
__________________





Düşmeden Bulutlarda Koşmam GereK !
Mattet isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayısı: 866
Alt 31/07/08, 15:40   #4
Neutralizer
Yasaklı kullanıcı
 
Neutralizer - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Jan 2008
Bulunduğu yer: İstediğin yerden
Mesajlar: 1.890
Tecrübe Puanı: 0 Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute Neutralizer has a reputation beyond repute
Standart

paylaşım için tşkrlr
Neutralizer isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayısı: 317
Takımınız:
Alt 05/11/08, 19:39   #5
wolf_valley21
Acemi Er
 
wolf_valley21 - ait Kullanıcı Resmi (Avatar)
 
Üyelik tarihi: Nov 2008
Mesajlar: 3
Tecrübe Puanı: 0 wolf_valley21 will become famous soon enough
Standart

teşekkürler
wolf_valley21 isimli Üye şimdilik offline konumundadır   Alıntı ile Cevapla
Konu Sayısı: 0
Takımınız:
Cevapla


Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 
Konu Araçları
Stil

Yetkileriniz
Yeni Mesaj yazma yetkiniz Aktif değil dir.
Mesajlara Cevap verme yetkiniz aktif değil dir.
Eklenti ekleme yetkiniz Aktif değil dir.
Kendi Mesajınızı değiştirme yetkiniz Aktif değildir dir.

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-KodlarıKapalı
Gitmek istediğiniz klasörü seçiniz


Bütün Zaman Ayarları WEZ +3 olarak düzenlenmiştir. Şu Anki Saat: 12:58 .


Powered by vBulletin
Copyright © 2000-2007 Jelsoft Enterprises Limited.
Sitemap
6, 5, 3, 7, 8, 9, 10, 11, 12, 13, 14, 15, 113, 16, 17, 18, 19, 81, 20, 27, 22, 23, 24, 25, 26, 48, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 43, 136, 40, 58, 45, 42, 44, 46, 47, 53, 54, 55, 56, 57, 59, 60, 70, 61, 62, 63, 64, 65, 66, 68, 69, 71, 72, 74, 75, 76, 77, 78, 79, 80, 82, 83, 96, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 98, 97, 100, 101, 102, 103, 106, 104, 105, 112, 109, 108, 107, 110, 111, 114, 115, 118, 116, 117, 119, 148, 154, 124, 165, 122, 120, 123, 121, 150, 153, 125, 128, 129, 131, 132, 133, 134, 135, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 151, 149, 202, 175, 164, 152, 167, 155, 156, 157, 158, 159, 160, 161, 162, 163, 195, 169, 166, 168, 170, 171, 172, 199, 174, 173, 196, 200, 176, 177, 180, 178, 179, 182, 189, 187, 184, 186, 191, 192, 193, 194, 197, 198, 201, 203, 229, 204, 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 236, 231, 232, 233, 234, 235, 237, 240, 239, 241, 243, 242, 244,