Pascal/Turbo Pascal - ayuda en un programa

   
Vista:

ayuda en un programa

Publicado por xero (1 intervención) el 22/01/2008 16:43:51
hola estoy estudiando en la universidad informatica y nos han mandado un programa que recrea la funcion de rellenar por inundacion del paint,

mirar aver donde puede dar el error po favor.

PROGRAM minipaint;
USES
crt;
CONST
MAX = 500;
TYPE
tdato= record
valor:char;
cambio:boolean;
end;
ttabla=array[1..MAX,1..MAX] of tdato;
posicion=0..250000;
telemento=record
x:integer;
y:integer;
end;
tcola=record
datos:array[1..1000] of telemento;
cab,fin:posicion;
end;
VAR
tabla:ttabla;
cola:tcola;
posi:telemento;
nombrefichero:text;
nombre:string;
color,numerofich:integer;


//****************************************************************************//
//INICIAMATRIZ //
//inicia la matriz dejando todos sus campos con valores predeterminados //
//****************************************************************************//
PROCEDURE iniciamatriz(var tab:ttabla);
VAR
i,j:integer;
BEGIN
for i:=0 to MAX do
for j:=0 to MAX do
BEGIN
tab[i,j].valor:='-';
tab[i,j].cambio:=false;
END;
END;
//****************************************************************************//
//COPIAMATRIZ //
//Procedimiento que rellena una matriz con los datos del fichero que se le //
//pasa //
//****************************************************************************//
PROCEDURE copiamatriz(var tab:ttabla;var archivo:text);
VAR
dato:char;
i,j:integer;
BEGIN
i:=0;
j:=0;
reset(archivo);
while not Eof(archivo) do
BEGIN
j:=j+1;
while not Eoln(archivo) do
BEGIN
i:=i+1;
read(archivo,dato);
tab[i,j].valor:=dato;
if dato='0' then
tab[i,j].cambio:=true
else
tab[i,j].cambio:=false;
END;
readln(archivo);
END;
close(archivo);
END;

//****************************************************************************//
//COLAVACIA //
//Deja vacia la pila que posteriormente utilizaremos para crear //
//los pixeles que le rodean si tienen el mismo color //
//****************************************************************************//
PROCEDURE colavacia(var c:tcola);
BEGIN
c.cab:=1;
c.fin:=0;
END;
//****************************************************************************//
//ESVACIA //
//Nos dice si la cola esta o no vacia //
// //
//****************************************************************************//
FUNCTION esvacia(c:tcola):boolean;
BEGIN
esvacia:=c.fin<c.cab;
END;
//****************************************************************************//
//ESLLENA //
//Nos dice si la cola esta o no llena //
// //
//****************************************************************************//
FUNCTION esllena(c:tcola):boolean;
BEGIN
esllena:=c.fin=1000;
END;
//****************************************************************************//
//PRIMERO //
//Devuelve el primer elemento de la cola sin modificar la cola //
// //
//****************************************************************************//
FUNCTION primero(c:tcola):telemento;
BEGIN
if not esvacia(c) then
primero.x:=c.datos[c.cab].x;
primero.y:=c.datos[c.cab].y;
END;
//****************************************************************************//
//ENCOLAR //
//añade a la cola el elemento seleccionado //
// //
//****************************************************************************//
PROCEDURE encolar(var c:tcola;aux:telemento);
BEGIN
if not esllena(c) then
with c do
BEGIN
fin:=fin+1;
datos[fin].x:=aux.x;
datos[fin].y:=aux.y;
END;
END;
//****************************************************************************//
//SUPRIMIR //
//elimina el elemento cabeza de la cola modificando la cola //
// //
//****************************************************************************//
PROCEDURE suprimir(var c:tcola);
VAR
i:posicion;
BEGIN
for i:=1 to c.fin-1 do
c.datos[i]:=c.datos[i+1];
c.fin:=c.fin-1;
END;
//****************************************************************************//
//QUITAR //
//devuelve el elemento cabeza de la cola y lo suprime //
// //
//****************************************************************************//
PROCEDURE quitar(var c:tcola;var x:telemento);
BEGIN
if not esvacia(c) then
BEGIN
x.x:=primero(c).x;
x.y:=primero(c).y;
suprimir(c);
END;
END;
//****************************************************************************//
//GETFONDO //
//devuelve el parametro 'valor' de el lugar que se quiere cambiar el fondo //
// //
//****************************************************************************//
FUNCTION getfondo(tab:ttabla;var x:telemento):char;
VAR
fondo:char;
BEGIN
fondo:=tab[x.x,x.y].valor;
getfondo:=fondo;
END;
//****************************************************************************//
//GRABA //
//graba el array en un fichero cada vez que se realiza un cambio //
//****************************************************************************//
PROCEDURE graba(numfich:integer; tab:ttabla);
VAR
nombre,linea:string;
nombfich:text;
numero:string;
i,j:integer;
BEGIN
linea:='';
numero:='';
str(numfich,numero);
nombre:='imagen_'+numero+'.txt';
writeln(nombre);
assign(nombfich,nombre);
rewrite(nombfich);
for i:=0 to MAX do
for j:=0 to MAX do
BEGIN
if tab[i,j].valor<>'-' then
linea:=linea+tabla[i,j].valor
else
BEGIN
writeln(nombfich,linea);
linea:='';
break;
END;
END;
close(nombfich);
END;
//****************************************************************************//
//INUNDACION //
//Procedimiento que cambia el color del el pixel que se le pasa y el de todos //
//los pixeles que le rodean si tienen el mismo color //
//****************************************************************************//
PROCEDURE inundacion(var tabla:ttabla;var c:tcola;color,fondo:char;posi:telemento);
VAR
i:telemento;
aux:telemento;
BEGIN
colavacia(c);
if (tabla[posi.x,posi.y].valor='0') OR (tabla[posi.x,posi.y].cambio) then
BEGIN
tabla[posi.x,posi.y].valor:=color;
encolar(c,posi);
while not esvacia(c) do
BEGIN
aux:=primero(c);
i.x:=aux.x-1;
i.y:=aux.y;
if ((tabla[i.x,i.y].valor=fondo) AND (tabla[i.x,i.y].cambio)) AND (i.x>=0)
then BEGIN
tabla[i.x,i.y].valor:=color;
encolar(c,i);
END;
i.x:=aux.x+1;
if ((tabla[i.x,i.y].valor=fondo) AND (tabla[i.x,i.y].cambio))
then BEGIN
tabla[i.x,i.y].valor:=color;
encolar(c,i);
END;
i.x:=aux.x;
i.y:=aux.y-1;
if ((tabla[i.x,i.y].valor=fondo) AND (tabla[i.x,i.y].cambio)) AND (i.y>=0)
then BEGIN
tabla[i.x,i.y].valor:=color;
encolar(c,i);
END;
i.y:=aux.y+1;
if ((tabla[i.x,i.y].valor=fondo) AND (tabla[i.x,i.y].cambio))
then BEGIN
tabla[i.x,i.y].valor:=color;
encolar(c,i);
END;
suprimir(c);
END;
END;
numerofich:=numerofich+1;
graba(numerofich,tabla);
END;
BEGIN
numerofich:=0;
iniciamatriz(tabla);
clrscr;
writeln('Introduce el nombre del fichero a leer: ');
readln(nombre);
assign(nombrefichero,nombre);
copiamatriz(tabla,nombrefichero);
repeat
writeln('Introduce el color a aplicar en la imagen');
readln(color);
if color>0 then
BEGIN
writeln('Introduce coordenadas de comienzo del relleno');
write('Fila: ');
readln(posi.x);
write('Columna: ');
readln(posi.y);
inundacion(tabla,cola,chr(color),getfondo(tabla,posi),posi);
END;
until(color<0);
writeln('Ha elegido salir');
//aqui hay que mostrar las estadisticas
END.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder