Pascal Karışık Sayılar

CorsaiR · 11 Ağu 2007

Karışık Sayılar Karışık olarak girdi üretme programı...
Ayrıca pascal programlamaya yeni başlıyanlara iyi örnek...program Karisik_sayilar;
uses crt;

var
i,j,artis,n,n1,n2,k,p:integer;
ilkdeger,sondeger:longint;
deger,a:array[1..300] of longint;
key,cikis,secim,x,sec:char;

label
bas,bitti;

procedure sabit_deger_girme;

label
son,bas;

begin
bas: clrscr;
writeln(' ***** SABİT ARALIKLI DEĞER GİRME *****':53);
writeln;

write(' ');for p:=1 to 24 do write(#205);writeln;

cikis:='h';
write(' Başlangıç değeri : ');readln(ilkDeger);

if ilkdeger=0 then
begin
cikis:='e';
goto son;
end;

write(' Bitiş değeri : ');readln(sonDeger);

if sondeger=0 then
begin
cikis:='e';
goto son;
end;

write(' Artış değeri : ');readln(artis);

if artis=0 then
begin
cikis:='e';
goto son;
end;

write(' ');for p:=1 to 24 do write(#205);writeln;
writeln;

if ((sondeger<ilkdeger) or (sondeger=ilkdeger) or (artis>sondeger) or (artis=sondeger)) then
begin
writeln;
writeln(' Yanlış şekilde De§er Girdiniz...Lütfen Tekrar Giriniz...');
key:=readkey;
goto bas;
end;

i:=1;
deger:=ilkdeger;

while ilkdeger<sondeger do
begin
i:=i+1;
ilkdeger:=ilkdeger+artis;
deger:=ilkdeger;
end;
n:=i;

write(' ',#201);for p:=1 to 17 do write(#205);writeln(#187);

for j:=1 to i do
begin

write(' ',#186);

if (j mod 20=0) then key:=readkey;

if j<10 then
begin
write(' [',j,']',' - ',' ',deger[j]);
gotoxy(21,9+j);writeln(#186);
end;

if ((j>9) and (j<100)) then
begin
write(' [',j,']',' - ',' ',deger[j]);
gotoxy(21,9+j);writeln(#186);
end;

if j>99 then
begin
write(' [',j,']',' - ',' ',deger[j]);
gotoxy(21,9+j);writeln(#186);
end;

end;

write(' ',#200);for p:=1 to 17 do write(#205);writeln(#188);

writeln;

write(' Veriler doğru mu?(E/H) ');readln(secim);
if ((secim<>'e') and (secim<>'E')) then goto bas;

son:
end;

procedure elle_deger_girme;

label
bas,son;

begin
bas: clrscr;
writeln(' ***** ELLE DEĞİŞİK DEĞER GİRME *****':53);
writeln;
write(' Girilecek değer sayısını giriniz: ');readln;
writeln;

cikis:='h';
if n=0 then
begin
cikis:='e';
goto son;
end;

write(' ',#201);for p:=1 to 17 do write(#205);writeln(#187);

for i:=1 to n do
begin
write(' ',#186);
write(' ','[',i,']',' - ');read(deger);
gotoxy(21,5+i);writeln(#186);
if deger=0 then goto bas;
end;

write(' ',#200);for p:=1 to 17 do write(#205);writeln(#188);

writeln;

write(' Veriler doğru mu?(E/H) ');readln(secim);
if ((secim<>'e') or (secim<>'E')) then goto son;

son:
end;

procedure secenek;

label
dongu,yine,son;

begin
if cikis='e' then goto son;
clrscr;
writeln(' ***** SEÇENEKLER *****':50);
writeln;
write(' Tahmindeki de§er sayısını giriniz: ');readln(n1);
if n1=0 then goto son;
write(' Yapılacak tahmin sayısını giriniz: ');readln(n2);
if n2=0 then goto son;

writeln;

write(' Tahminler yapıldı... Görüntülemek için bir tuşa basınız...');
key:=readkey;

clrscr;
writeln(' ***** SONUÇLAR *****':50);
writeln;

for i:=1 to n2 do
begin
textcolor(12);
write(' [',i,'] =>');
textcolor(10);
if (i mod 20=0) then key:=readkey;
for j:=1 to n1 do
begin
dongu: a[j]:=random(n+1);
if a[j]=0 then goto dongu;
for k:=1 to j do
begin
if k=j then goto yine;
if a[k]=a[j] then goto dongu;
yine: end;
if odd(j) then textcolor(15);
if j=1 then write(' ',deger[a[j]],' - ');
if j=n1 then write(deger[a[j]]);
if ((j>1) and (j<n1)) then write(deger[a[j]],' - ');
textcolor(10);
end;
writeln;
writeln;
end;

key:=readkey;
son:
end;

begin
bas: textbackground(8);textcolor(10);clrscr;

writeln(' ***** DEĞER GİRİŞİ *****':50);
writeln;
write(' ',#201);for i:=1 to 36 do write(#205);writeln(#187);
write(' ',#186);write(' [1] - Sabit artan de§er girece§im. ');writeln(#186);
write(' ',#186);write(' [2] - De§erleri elimle girece§im. ');writeln(#186);
write(' ',#186);write(' [0] - Programdan çıkmak istiyorum. ');writeln(#186);
write(' ',#200);for i:=1 to 36 do write(#205);writeln(#188);
writeln;
write(' Seçiminiz => ');readln(sec);
case sec of
'1': begin
sabit_deger_girme;
secenek;
end;

'2': begin
elle_deger_girme;
secenek;
end;

'0': goto bitti;
end;

if ((sec<>'1') and (sec<>'2') and (sec<>'0')) then
begin
writeln;
write(' Lütfen Yukarıdaki şıklardan Birini Seçiniz...');
key:=readkey;
end;

goto bas;

bitti:

end.

Pascal Karışık Sayılar

CorsaiR

Emektar

Sosyal medya sayfalarımız