Kezdőoldal » Számítástechnika » Programozás » Pascal repeat until használata...

Pascal repeat until használata alprogramokban?

Figyelt kérdés

Sziasztok!


A minap az oldalon sokan segítettetek nekem egy feladat megoldásában, ami elég jól sikerült!

Ugyan ezt a programot kellene kicsit továbbfejleszteni, úgy hogy procedúrákat használjon.


program absz;

uses crt;

var

maganhangzo, massalhangzo, kulonlegeskarakter, szoveg, z : string;

maganhangzos:array[1..14] of byte;

massalhangzos:array[1..21] of byte;

specialiskarakter:array[1..19] of byte;

i,j,k,l : byte;

betu,x : char;

betus : byte;


procedure karakterek;

begin

betus := 0;

for j := 1 to 14 do

maganhangzos[j]:=0;

for k := 1 to 21 do

massalhangzos[k]:=0;

for l := 1 to 19 do

specialiskarakter[l]:=0;

maganhangzo:='áéöőüűúóíaeiou';

massalhangzo:='bcdfghjklmnpqrstvwxyz';

kulonlegeskarakter:=',;?.:-_@#/\+"!%=()*';

end;


procedure beolvasas;

begin

textcolor(12);

write('Irjon be egy szoveget! ');

readln(szoveg);

delay(1400);

Write('Kerem a megszamolando betut : ');

readln(betu);

textcolor(6);

for i := 1 to length(szoveg) do

begin

for l:=1 to 19 do

if (lowercase(szoveg[i])=kulonlegeskarakter[l]) then inc(specialiskarakter[l]);

for j:=1 to 14 do

if (lowercase(szoveg[i])=maganhangzo[j]) then inc(maganhangzos[j]);

for k:=1 to 21 do

if (lowercase(szoveg[i])=massalhangzo[k]) then inc(massalhangzos[k]);

if (lowercase(szoveg[i])=lowercase(betu)) then inc(betus);

end;

WriteLn;

end;


procedure kiir1;

begin

WriteLn('A szovegben a(z) ',betu,' betu ',betus,' alkalommal fordult elo.');

writeln;

end;


procedure kiir2;

begin

textcolor(5);

writeln('Megmutassam a maganhangzokat es massalhangzokat?');

textcolor(6);


repeat

writeln('I/N');

x:=(upcase(readkey));

until(x <> 'I') or (x <> 'N');

if x='I' then begin

writeln('Maganhangzok: ');

for j:=1 to 14 do

if maganhangzos[j]>0 then writeln(maganhangzo[j],' betu: ',maganhangzos[j],' alkalommal fordult elo.');

writeln('Massalhangzok:');

for k:=1 to 21 do

if massalhangzos[k]>0 then writeln(massalhangzo[k],' betu: ',massalhangzos[k],' alkalommal fordult elo.');

end;

end;


procedure kiir3;

begin

textcolor(5);

writeln('Megmutassam a kulonleges karaktereket?');

textcolor(6);


repeat

writeln('I/N');

x:=(upcase(readkey));

until(x <> 'I') or (x <> 'N');

if x='I' then begin

writeln('Kulonleges karakterek: ');

for l:=1 to 19 do

if specialiskarakter[l]>0 then writeln(kulonlegeskarakter[l],' karakter: ',specialiskarakter[l],' alkalommal fordult elo.');

end;

end;


procedure kiir4;

begin

textcolor(5);

writeln('Erdekli hogy hany karaktert gepelt be?');

textcolor(6);


repeat

writeln('I/N');

x:=(upcase(readkey));

until(x <> 'I') or (x <> 'N');

if x='I' then begin

writeln('Ennyi karakter talaltam osszesen: ',length(szoveg));

end;

end;


procedure restart;

begin

repeat

textcolor(5);

writeln('Futtassam meg egyszer a programot?');

textcolor(6);

writeln('Igen/Nem');

readln(z)

until z='nem';

end;


begin

clrscr;

karakterek;

beolvasas;

kiir1;

kiir2;

kiir3;

kiir4;

restart;


readln;

end.



Így néz ki a program most. Jelenleg a 'restart' procedure csak saját magát indítja újra, tudom. Ezt kellene úgy megoldani hogy az egész programot újraindítsa.



2016. jan. 5. 20:30
1 2
 11/18 A kérdező kommentje:
Readkeyyel meglehet oldani a végén a repeat cilust? ReadLn-al működik, de sajnos tényleg elég undorítóan néz ki hogy a végén be kell pötyögni azt hogy 'igen' vagy 'nem'.
2016. jan. 6. 18:41
 12/18 tabaki ***** válasza:

Meg hát, én is úgy csináltam...


@SimkoL:

El is kezdtem ám, mert sejtettem, hogy számon kéred, de aztán az éjjeli torpor-állapotban belezavarodtam, hogy hogyan kéne a karakterenkénti nyilvántartást intézni, inkább nem hagytam el a kitaposott ösvényt.

2016. jan. 6. 18:54
Hasznos számodra ez a válasz?
 13/18 SimkoL ***** válasza:

Az elv:


program Project1;


type TCharSet = set of Char;


var

magan : TCharSet = ['a','e','i','o','u'];

massal : TCharSet = ['b','c','d','f','g','h','j','k','l','m','n','p','q','r','s','t','v','w','x','y','z'];

spec : TCharSet = ['<','>','[',']',',',';','?','.',':','-','_','@','#','/','\','+','"','!','%','=','(',')','*'];

darab : array[0..255] of byte;

s: string;

i : integer;

begin

s := 'a zsiroskenyeret nagyon szeretem nyaron, friss gyenge hagymaval, hagymaszarral';

for i := 1 to Length(s) do Inc(darab[Ord(s[i])]);

WriteLn('maganhangzok: ');

for i := 0 to Length(darab) - 1 do if (Chr(i) in magan) and (darab[i] > 0) then WriteLn(Chr(i), darab[i]:3);

WriteLn('massalhangzok: ');

for i := 0 to Length(darab) - 1 do if (Chr(i) in massal) and (darab[i] > 0) then WriteLn(Chr(i), darab[i]:3);

WriteLn('specialis: ');

for i := 0 to Length(darab) - 1 do if (Chr(i) in spec) and (darab[i] > 0) then WriteLn(Chr(i), darab[i]:3);

ReadLn;

end.


A többit rád bízom.

2016. jan. 6. 19:35
Hasznos számodra ez a válasz?
 14/18 tabaki ***** válasza:
Jó, valami hasonlóval indultam neki, akkor újra próbálkozom.
2016. jan. 6. 20:05
Hasznos számodra ez a válasz?
 15/18 tabaki ***** válasza:

Újabb kísérlet, halmazokkal:

[link]

A type-ot elhagytam, nem mintha sok értelme lenne, csak így a „set of char”-t mindegyiknél kiírva egyelőre talán jobban érthető.

2016. jan. 6. 21:59
Hasznos számodra ez a válasz?
 16/18 tabaki ***** válasza:

Még annyit: Megmaradtam a linuxban működő, 127-nél kisebb karakterek tartományában, és csak a szóköztől indul a tömb, mert a kisebb különleges karaktereket úgysem tudtam billentyűzetről bevinni -- lehet, hogy ez is a linux miatt van, mindenesetre a határok könnyen megváltoztathatók.

Utólag látom, hogy a ClrScr-t nem kellett volna a programtörzsben hagynom, jó lett volna az a beolvasás elején is, de mindegy.

2016. jan. 7. 02:43
Hasznos számodra ez a válasz?
 17/18 tabaki ***** válasza:

Másik verzió, helyenként karikaturisztikus elemekkel:

[link]

2016. jan. 7. 10:36
Hasznos számodra ez a válasz?
 18/18 tabaki ***** válasza:

Function-válaszbeolvasással és egyéb cifrákkal:

[link]

2016. jan. 8. 00:54
Hasznos számodra ez a válasz?
1 2

További kérdések:




Minden jog fenntartva © 2024, www.gyakorikerdesek.hu
GYIK | Szabályzat | Jogi nyilatkozat | Adatvédelem | Cookie beállítások | WebMinute Kft. | Facebook | Kapcsolat: info(kukac)gyakorikerdesek.hu

A weboldalon megjelenő anyagok nem minősülnek szerkesztői tartalomnak, előzetes ellenőrzésen nem esnek át, az üzemeltető véleményét nem tükrözik.
Ha kifogással szeretne élni valamely tartalommal kapcsolatban, kérjük jelezze e-mailes elérhetőségünkön!