Karaktere-kateak lantzen
Programa bakar batek eginkizun desberdinak bildu behar dituenean menu bat erabil daiteke. Adibide honetan hiru aukerako menu bat erakusten da, non hirugarren aukerari esker programa bukaraziko da.
{
Menuaren aukerak hautatzeko funtzio bat.
Aukera bakoitzaren eginkizuna burutzeko prozedura bana.
}
program MenuaAzpiprogramaz;
uses
crt;
{ Menuaren aukera erakutsi eta hautapena aukeratu }
function fncMenua: char;
var
cHautapena: char;
begin
writeln('===============MENUA================');
writeln(' A) alfabeto zatia diagonalean');
writeln(' B) biderkatzeko taula pantailaratu');
writeln;
writeln(' I) irten');
writeln('====================================');
repeat
write(' Zure aukera: ');
cHautapena := readkey;
writeln(cHautapena);
cHautapena := upcase(cHautapena);
until (cHautapena = 'A') or (cHautapena = 'B') or (cHautapena = 'I');
fncMenua := cHautapena;
end;
{ A-tik hasita alfabetoa diagonalki pantailaratu }
procedure DiagonalaPantailanIdatzi(cLetra: char);
var
cKont: char;
iNon: integer;
begin
writeln;
iNon := 5;
for cKont:='A' to cLetra do
begin
writeln(cKont:iNon);
iNon := iNon + 2;
end;
end;
procedure TaulaPantailaratu(iZbk: integer);
var
k: integer;
begin
writeln(iZbk,' zenbakiaren biderkatzeko taula:');
for k:=1 to 10 do
begin
writeln(k:10, ' x ', iZbk:2, ' = ', k*iZbk:3);
end;
writeln;
end;
{ ----------------------PROGRAMA NAGUSIA---------------------- }
var
cAukera, cLetra, cItxoin: char;
iZbk: integer;
begin
repeat
clrscr;
cAukera := fncMenua;
writeln;
case cAukera of
'A': begin
repeat
write('Azken letra eman: ');
cLetra := readkey;
writeln(cLetra);
cLetra := upcase(cLetra);
until (cLetra >= 'A') and (cLetra <= 'Z');
DiagonalaPantailanIdatzi(cLetra);
end;
'B': begin
repeat
write('1 eta 10 arteko zenbaki osoa eman: ');
readln(iZbk);
until (iZbk >= 1) and (iZbk <= 10);
TaulaPantailaratu(iZbk);
end;
'I': begin
writeln('Programa amaitzera doa.');
end ;
end; (* case-rena *)
writeln;
write('Edozein tekla sakatu aurrera egiteko...');
cItxoin := readkey; (* emaitzak ikusi ahal izateko itxaron *)
writeln(cItxoin); (* konpilazio abisua kentzeko *)
until cAukera='I';
end.
{ KateakLantzekoBaliabideak programan delete(), insert(), copy() }
{ eta pos() azpiprogramen alternatibak kodetu dira. }
program KateakLantzekoBaliabideak;
uses
crt;
function fncAukeraHautatu: char;
var
cHautapena: char;
begin
writeln('===========================Menua============================');
writeln(' A delete() prozeduraren bezalako fnsEzabatu() funtzioa');
writeln(' B insert() prozeduraren bezalako fnsTxertatu() funtzioa');
writeln(' C copy() funtzioaren bezalako kopiatu() prozedura');
writeln(' D pos() funtzioaren bezalako kokatu() prozedura');
writeln;
writeln(' I Programatik irten');
writeln('============================================================');
write(' Zure aukera: ');
repeat
cHautapena := readkey;
cHautapena := upcase(cHautapena);
writeln(cHautapena);
if (cHautapena < 'A') or (cHautapena > 'D') and (cHautapena <> 'I') then
begin
write('Aukera ez da ondo hautatu. Berriro aukeratu: ');
end;
until (cHautapena >= 'A') and (cHautapena <= 'D') or (cHautapena = 'I');
fncAukeraHautatu := cHautapena;
end;
function fnsEzabatu(sDatua: string; iNondik, iZenbat: integer): string;
var
sEmaitza: string;
iKont: integer;
begin
sEmaitza := '';
for iKont:=1 to iNondik-1 do
begin
sEmaitza := sEmaitza + sDatua[iKont];
writeln(iKont:10, sDatua[iKont]:10);
end;
for iKont:=iNondik+iZenbat to length(sDatua) do
begin
sEmaitza := sEmaitza + sDatua[iKont];
writeln(iKont:14, sDatua[iKont]:10);
end;
fnsEzabatu := sEmaitza;
end;
function fnsTxertatu(sAzpikatea, sDatua: string; iNondik: integer): string;
var
sEmaitza: string;
iKont: integer;
begin
sEmaitza := '';
for iKont:=1 to iNondik-1 do
begin
sEmaitza := sEmaitza + sDatua[iKont];
writeln(iKont:10, sDatua[iKont]:10);
end;
for iKont:=1 to length(sAzpikatea) do
begin
sEmaitza := sEmaitza + sAzpikatea[iKont];
writeln(iKont:12, sAzpikatea[iKont]:10);
end;
for iKont:=iNondik to length(sDatua) do
begin
sEmaitza := sEmaitza + sDatua[iKont];
writeln(iKont:14, sDatua[iKont]:10);
end;
fnsTxertatu := sEmaitza;
end;
procedure kopiatu(sDatua: string; iNondik, iZenbat: integer; var sEmaitza: string);
var
iKont: integer;
begin
sEmaitza := '';
for iKont:=iNondik to iNondik+iZenbat-1 do
begin
sEmaitza := sEmaitza + sDatua[iKont];
writeln(iKont:10, sDatua[iKont]:10);
end;
end;
procedure kokatu(sAzpikatea, sDatua: string; var iNon: integer);
var
iKont, k, i: integer;
boAurkitua, boDesberdinak: boolean;
begin
boAurkitua := FALSE;
iKont := 1;
while (iKont <= length(sDatua)) and not boAurkitua do
begin
boDesberdinak := FALSE;
k := iKont;
i := 1;
while (k < iKont+length(sAzpikatea)) and not boDesberdinak do
begin
writeln('iKont=', iKont:2, 'k=':6, k:2, sDatua[k]:6, 'i=':6, i:2, sAzpikatea[i]:6, 'boDesberdinak=':18, boDesberdinak:5);
if sDatua[k] <> sAzpikatea[i] then
boDesberdinak := TRUE
else
begin
k := k +1;
i := i +1;
end;
end;
if boDesberdinak = FALSE then
boAurkitua := TRUE
else
iKont := iKont +1;
end;
if boAurkitua then
begin
iNon := iKont;
writeln('boAurkitua=', boAurkitua:5, 'iNon=Kont=':15, iNon:2);
end
else
begin
iNon := 0;
writeln('boAurkitua=', boAurkitua:5, 'iNon=':10, iNon:2);
end;
writeln;
end;
{ ----------------------PROGRAMA NAGUSIA---------------------- }
var
cAukera, cItxoin: char;
iNon: integer;
sDatua, sEmaitza: string;
sAzpikatea: string;
iNondik, iZenbat: integer;
begin
repeat
clrscr;
cAukera := fncAukeraHautatu;
writeln;
case cAukera of
'A' : begin
writeln('sDatua emanik, fnsEzabatu() funtzioa kodetu delete() prozedurarena betetzeko');
writeln;
writeln(' procedure delete(var sKatea: string;');
writeln(' iNondik: integer;');
writeln(' iZenbat: integer);');
writeln;
writeln(' function fnsEzabatu( sDatua: string;');
writeln(' iNondik: integer;');
writeln(' iZenbat: integer): string;');
writeln;
write('sDatua eman: ');
readln(sDatua);
writeln('sDatua |', sDatua, '|');
repeat
write('Ezabaketa zein karakteretan hasiko da? ');
readln(iNondik);
if iNondik < 1 then
writeln('Posizioa gutxienez 1 izan behar da');
if iNondik > length(sDatua) then
writeln('Posizioa gehinez ', length(sDatua), ' izan behar da');
until (iNondik >= 1) and (iNondik <= length(sDatua));
repeat
write('Zenbat karaktere ezabatuko dira? ');
readln(iZenbat);
if iZenbat < 1 then
writeln('Gutxienez karaktere 1 kendu behar da');
if iZenbat > length(sDatua)-iNondik+1 then
writeln('Kopurua gehinez ', length(sDatua)-iNondik+1, ' izan behar da');
until (iZenbat >= 1) and (iZenbat <= length(sDatua)-iNondik+1);
sEmaitza := fnsEzabatu(sDatua, iNondik, iZenbat);
writeln('|', sDatua, '|');
writeln('|', sEmaitza, '|');
end;
'B' : begin
writeln('sDatua emanik, fnsTxertatu() funtzioa kodetu insert() prozeduraren lana betez');
writeln;
writeln(' procedure insert(sSartukoDenKatea: string;');
writeln(' var sKateNagusia: string;');
writeln(' iNon: integer);');
writeln;
writeln(' function fnsTxertatu(sAzpikatea: string;');
writeln(' sDatua: string; ');
writeln(' iNondik: integer): string;');
writeln;
write('sDatua eman: ');
readln(sDatua);
writeln('sDatua |', sDatua, '|');
write('sAzpikatea eman: ');
readln(sAzpikatea);
writeln('sAzpikatea |', sAzpikatea, '|');
repeat
write('Txertaketa zein karakteretan hasiko da? ');
readln(iNondik);
if iNondik < 1 then
writeln('Posizioa gutxienez 1 izan behar da');
if iNondik > length(sDatua) then
writeln('Posizioa gehinez ', length(sDatua), ' izan behar da');
until (iNondik >= 1) and (iNondik <= length(sDatua));
sEmaitza := fnsTxertatu(sAzpikatea, sDatua, iNondik);
writeln('|', sDatua, '|');
writeln('|', sEmaitza, '|');
end;
'C' : begin
writeln('sDatua emanik, kopiatu() prozedura kodetu copy() funtzioaren lana betetzeko');
writeln;
writeln(' function copy(sDatuaDenKatea: string;');
writeln(' iNonHasi: integer;');
writeln(' iZenbat: integer): string;');
writeln;
writeln(' procedure kopiatu( sDatua: string;');
writeln(' iNondik: integer;');
writeln(' iZenbat: integer;');
writeln(' var sEmaitza: string);');
writeln;
write('sDatua eman: ');
readln(sDatua);
writeln('sDatua |', sDatua, '|');
repeat
write('Kopiaketa zein karakteretan hasiko da? ');
readln(iNondik);
if iNondik < 1 then
writeln('Posizioa gutxienez 1 izan behar da');
if iNondik > length(sDatua) then
writeln('Posizioa gehinez ', length(sDatua), ' izan behar da');
until (iNondik >= 1) and (iNondik <= length(sDatua));
repeat
write('Zenbat karaktere kopiatuko dira? ');
readln(iZenbat);
if iZenbat < 1 then
writeln('Gutxienez karaktere 1 kendu behar da');
if iZenbat > length(sDatua)-iNondik+1 then
writeln('Kopurua gehinez ', length(sDatua)-iNondik+1, ' izan behar da');
until (iZenbat >= 1) and (iZenbat <= length(sDatua)-iNondik+1);
kopiatu(sDatua, iNondik, iZenbat, sEmaitza);
writeln('|', sDatua, '|');
writeln('|', sEmaitza, '|');
end;
'D' : begin
writeln('sDatua emanik, kokatu() prozedura kodetu pos() funtzioaren lana betetzeko');
writeln;
writeln(' function pos(sBilatukoDenAzpikatea: string;');
writeln(' sKateNagusia: string): integer;');
writeln;
writeln(' procedure kokatu(sAzpikatea: string;');
writeln(' sDatua: string;');
writeln(' var iNon: integer);');
writeln;
write('Kate nagusia den sDatua eman: ');
readln(sDatua);
writeln('sDatua |', sDatua, '|');
write('Bilatuko den sAzpikatea eman: ');
readln(sAzpikatea);
writeln('sAzpikatea |', sAzpikatea, '|');
kokatu(sAzpikatea, sDatua, iNon);
if iNon = 0 then
writeln('|', sAzpikatea, '| ez dago |', sDatua, '| katean')
else
writeln('|', sAzpikatea, '| |', sDatua, '| katearen ', iNon, ' posizioan dago');
end;
'I' : begin
writeln('Programa amaitzera doa. Edozein tekla sakatu.');
end;
end;
cItxoin := readkey; (* emaitzak ikusi ahal izateko itxaron *)
writeln(cItxoin); (* konpilazio abisua kentzeko *)
until cAukera='I';
end.
iruzkinik ez:
Argitaratu iruzkina
Iruzkinen bat idazteko Google-ko kontu bat behar duzu. Iruzkin guztien moderazio-ardura blogeko administratzaileari dagokio.