Ver Mensaje Individual
  #6 (permalink)  
Antiguo 28/04/2010, 05:41
kurkix
 
Fecha de Ingreso: abril-2010
Mensajes: 5
Antigüedad: 14 años
Puntos: 0
Respuesta: Turbo Pascal a DEV-C++

EL SEGUNDO PROGRAMA

program ezetz_asmatu;
uses wincrt;
const txmax=5;
type
txapelketa= array [1..txmax,1..5] of integer;
akats= array [1..5] of integer;
var
akakont,asmal:txapelketa;
puntu,azktx:akats;
hitza,kop,ak:string;
luzera,buelt,l,auke,txp,jkop,m,tx,znb,akakop,asma, k,ondo,ira,iratx:integer;
ka:char;
procedure marrak(var h:string; l:integer);
var
k:integer;
begin
for k:=1 to l do
h[k]:='_';
end;
procedure azaldu(ko,a:string);
begin
writeln('egoera:');
writeln(ko);
writeln('akatsak:');
writeln(a);
end;
procedure begiratu(h:string;var h2:string;kar:char; var o:integer);
var
k,l:integer;
begin
o:=0;
l:=length(h);
for k:=1 to l do
begin
if h[k]=kar then
begin
o:=o+1;
h2[k]:=kar;
end;
end;
end;
BEGIN
clrscr;
Repeat
begin
Writeln(' @ @ ');
Writeln(' --[ ]-- EZETZ ASMATU --[ ]-- ');
Writeln(' | | MENUA | | ');
Writeln;
Writeln(' 1.- BAKARKA. ');
Writeln(' 2.- TXAPELKETA.(gehienez 4 kide) ');
Writeln(' 3.- ARGIBIDEA. ');
Writeln(' 4.- EXIT. ');
Writeln;
Writeln(' EGILEAK: ');
Writeln(' IGOR AGIRREGOMEZKORTA');
Writeln(' JOSEBA ARRILLAGA ');
Readln(auke);
If auke=1 then
begin
buelt:=0;
While (buelt=0) do
begin
clrscr;
write('idatzi hitza:');
readln(hitza);
clrscr;
luzera:=length(hitza);
kop:=hitza;
ak:=hitza;
for m:=6 to 15 do
ak[m]:=' ';
marrak(kop,luzera);
for k:=1 to 5 do
ak[k]:='_';
akakop:=0;
asma:=0;
repeat
begin
azaldu(kop,ak);
write('idatzi karakterea: ');
readln(ka);
begiratu (hitza,kop,ka,ondo);
if ondo>0 then asma:=asma+ondo
else
begin
akakop:=akakop+1;
ak[akakop]:=ka;
end;
end;
until (asma=luzera) or (akakop=5);
azaldu(kop,ak);
writeln(hitza);
if asma=luzera then writeln('ZORIONAK!IRABAZI DUZU!!')
else writeln('GAME OVER');
Writeln('Berriz jolastu nahi duzu?');
Writeln('BAI ----> 0 EZ ----> 1');
readln(buelt);
end;
readln;
end;
If auke=2 then
begin
clrscr;
buelt:=0;
Writeln('Zenbat jokalari zarete:');
Readln(znb);
While znb>4 do
begin
Writeln('BARKATU BAINA GEHIENEZ LAU PARTAIDE IZAN DAITEZKE:');
Write('Sartu ezazu kopuru egokia:');
Readln(znb);
end;
While (buelt=0) do
begin
For tx:=1 to txmax do
begin
for jkop:=1 to znb do
begin
asmal[tx,jkop]:=0;
akakont[tx,jkop]:=0;
end;
end;
write('idatzi hitza:');
readln(hitza);
For jkop:=1 to znb do
begin
clrscr;
luzera:=length(hitza);
kop:=hitza;
ak:=hitza;
for m:=6 to 15 do
ak[m]:=' ';
for k:=1 to luzera do
kop[k]:='_';
for k:=1 to 5 do
ak[k]:='_';
akakop:=0;
asma:=0;
tx:=1;
repeat
begin
Writeln('*************** ',jkop,'.PARTAIDEA *************');
Writeln('*************** ',tx,'.TXANDA *************');
writeln('egoera:');
writeln(kop);
writeln('akatsak:');
writeln(ak);
write('idatzi karakterea: ');
readln(ka);
ondo:=0;
l:=length(hitza);
for k:=1 to l do
begin
if hitza[k]=ka then
begin
ondo:=ondo+1;
kop[k]:=ka;
end;
end;
if ondo>0 then
begin
asma:=asma+ondo;
tx:=tx;
end
else
begin
akakop:=akakop+1;
ak[akakop]:=ka;
tx:=tx+1;
end;
asmal[tx,jkop]:=asma;
akakont[tx,jkop]:=akakop;
end;
until (asma=luzera) or (akakop=5);
writeln('egoera:');
writeln(kop);
writeln('akatsak:');
writeln(ak);
writeln(hitza);
If asmal[tx,jkop]=luzera then
begin
azktx[jkop]:=tx;
end;
case azktx[jkop] of
1: txp:=50;
2: txp:=40;
3: txp:=30;
4: txp:=20;
5: txp:=0;
end;
puntu[jkop]:= ((asma*5)-akakop+txp);
If ira<puntu[jkop] then
begin
ira:=puntu[jkop];
iratx:=jkop;
end;
readln;
end;
for jkop:=1 to znb do
begin
Write(' ',jkop,'. JOKALARIA');
end;
Writeln;
for jkop:=1 to znb do
begin
Write(' asmat.-akats. ');
end;
for tx:=1 to txmax do
begin
Writeln;
Write(tx,' txand: ');
for jkop:=1 to znb do
begin
write(asmal[tx,jkop],' ',akakont[tx,jkop]);
write(' ');
end;
readln;
end;
For jkop:=1 to znb do
begin
Writeln(jkop,'. jokalariak ',puntu[jkop], ' puntu lortu ditu.');
end;
Writeln('Beraz ',iratx,'. jokalaria da irabazlea ',ira,' punturekin.');
Writeln('Berriz jolastu nahi al duzue?');
Writeln;
Writeln('BAI ----> 0 EZ ----> 1');
readln(buelt);
ira:=0;
iratx:=0;
end;
readln;
end;
If auke=3 then
begin
WRITELN(' ARGIBIDEAK ');
WRITELN(' A/MENUA: ');
WRITELN('Menuari dagokionez, esan behar dut lau aukera azaltzen direla.');
WRITELN('[1]. aukerari dagokionez, bakarrik jolasteko opzioa da eta hemen,');
WRITELN('gaineratu behar dut, ez dagoela inongo puntuaketarik, soilik, ');
WRITELN('jokalariak irabazi edo galdu duen esango zaio. ');
WRITELN('"RETURN" sakatu jarraitzeko.');
READLN;
WRITELN('[2]. aukeran, iada jokalari askok jolastu dezakete, baina hori ');
WRITELN('bai, gehienez 4-ek.Hemn ordea,puntuaketa bat emango zaio jokalari');
WRITELN('bakoitzari, hurrengo puntuan azalduko dizuedan kriterio zehatz ');
WRITELN('batzuk jarraituz. ');
WRITELN('Partaide berdinekin partidak errepikatzeko aukera ere ematen du.');
WRITELN('Hori bai, partaide kopurua aldatu nahi baduzu, menura itzuli ');
WRITELN('beharko duzu.');
WRITELN('Horrez gain,jokalari bakoitzaren, txanda bakoitzen asmatutako ta');
WRITELN('hutsegindako letra kopurua azalduko dugu.Esan behar dugu, ');
WRITELN('jokalari bakoitzak txanda guztiak egin ondoren, iritsiko zaiola ');
WRITELN('bste jokalariari bere txanda ta hola jokalari guztiak pasa arte.');
WRITELN('Gaineratu behar dugu, jokalariak akats bat egin ezean,txanda ');
WRITELN(' bakoitza mantendu egingo dela. ');
WRITELN('"RETURN" sakatu jarraitzeko.');
READLN;
WRITELN('[3]. aukera, uste dut azaldu beharrik ere ez dagoela. ');
WRITELN;
WRITELN('[4]. aukera, jokutik irten ahal izateko da. ');
WRITELN;
WRITELN(' B\PUNTUAKETA: ');
WRITELN('Puntuaketari dagokionez, asmaturiko letra bakoitzeko, 5 puntu ');
WRITELN('lortuko ditu jokalariak, baina egindako akats bakoitzeko puntu ');
WRITELN('1 kenduko zaio.Horrez gain, garrantzia eman diogu zenbatgarren ');
WRITELN('txandan hitzaren soluzioa lortzeari.Horrela: ');
WRITELN('1.txandan:50 puntu -- 2.txandan:40 puntu -- 3.txandan:30 puntu ');
WRITELN('4.txandan:20 puntu -- 5.txandan:0 puntu ');
WRITELN('"RETURN" sakatu amaitzeko.');
READLN;
clrscr;
end;
end;
until auke=4;
end.

Última edición por kurkix; 03/05/2010 a las 10:52