Este es ,¿que tal esta ?son dos jugadores cada uno tiene que dar una palabra y gana el primero que hacierte,la partida se debe poder guardar y cargar,en modo texto no en binario.Si hacierta con la letras sigues tirando si no pierdes turno.
program ahorcado;
uses crt;
type
cadena=string[9];
var
fich:text;
palabra1,adivinar1:cadena;
palabra2,adivinar2:cadena;
letra:char;
posicion1,posicion2,longuitud1,longuitud2:integer;
{en el procedimiento las cadenas palabra,aux,adivinar las pasamos por referencia
porque las modificaciones que vamos a efectuar en el parametro formal las realizaremos sobre
el parametro real lo mismo sucede con la longuitud porque varia segun sea la palabra}
procedure inicializarvector (var palabra,adivinar:cadena;var longuitud:integer);
var
i:integer;
begin
writeln('Escribe la palabra que quiere que adivinen: ');
readln(palabra);
{Calculamos la loguitud de la palabra introducida}
longuitud:=lenght(palabra);
for i:=1 to longuitud do
{Inicializamos la palabra con guiones}
adivinar
:='_';
end;
{Pasamos todo los argumentos por referencia salvo "palabra" que la pasamos por valor porque no la vamos a modificar}
procedure comprobarletra (var letra:char;var posicion:integer;var adivinar:cadena;palabra:cadena);
var
i:integer;
begin
repeat
writeln('¿Que letra crees que esta en la palabra?');
readln(letra);
{Vemos en que posicion se encuentra la letra dada en la palabra que tenemos que adivinar}
posicion:=pos(letra,palabra);
if posicion<>0 then
begin
writeln('La posición es:',posicion);
{Cambiamos en la palabra que tenemos que adivinar el guion por la letra dada}
adivinar[posicion]:=letra;
{Y mostramos por pantalla los cambios efectuados}
writeln(adivinar);
end
{si no se encuentra la letra en la palabra}
else
begin
writeln('La letra dada no se encuentra en la palabra.');
writeln('¡¡¡PIERDES TURNO!!!');
writeln('Lista de letras que no estan en la palabra que tienes que adivinar:');
writeln(letra);
end;
until (posicion=0) ;
end;
{----------------------CUERPO DEL PROGRAMA-------------------------}
begin
clrscr;
writeln('=================================JUEGO DEL AHORCADO============================');
{$I-}{Desactivamos el control automático de errores de E/S.}
assign(fich,'C:\juego.txt');
append(fich);
{$I+}{Activamos el control automático de errores de E/S.}
if IOResult<>0 then {Comprobamos si ha habido errores}
writeln('Error:',IOResult,'al abrir el fichero.')
else
begin
writeln('Comencemos el juego del ahorcado,con el jugador 1.');
inicializarvector(palabra1,adivinar1,longuitud1);
clrscr;
writeln('jugador 2 es su turno');
clrscr;
inicializarvector(palabra2,adivinar2,longuitud2);
repeat
writeln('Jugador 1');
comprobarletra(letra,posicion2,adivinar2,palabra2);
clrscr;
writeln('Su turno,jugador 2');
comprobarletra(letra,posicion1,adivinar1,palabra1);
clrscr;
until
(adivinar1=palabra1) or (adivinar2=palabra2);
if(adivinar2=palabra2)then
writeln('¡¡¡¡GANASTE JUGADOR 1!!!')
else
writeln('¡¡¡GANASTE JUGADOR 2!!!');
close(fich);
end;
end.