De parte del señor alcalde se hace saber que:
El autor no asume ninguna responsabilidad por el uso o alteracion de este
software. El autor no garantiza de ninguna forma su funcionamiento
y en ningun caso sera el autor responsable de daños o perjuicios que se deriven
del mal uso del software, aun cuando este haya sido notificado de la posibilidad de dicho daño.
Dicho lo dicho, a por la chicha:
Bueno, pos os presento el programa, que es un poco cutre y esta capado en muchos sentidos.
¿Pero para que me voy a molestar en hacer un interface que te pida el nombre de los ficheros si
es otra cosa lo que quiero mostrar?. Dicho esto comento el programa: Parte de una imagen TGA
(la informacion de las imagenes TGA va de regalo) y a partir de esta la copia invertida a su lado. Y a partir de esta ultima la copia invertida abajo.
Con esto queda claro que no valdra cualquier fondo, tendra que ser uno mas o menos uniforme, de
todas formas ya os dareis cuenta en el caso de que lo probeis. Ahora que lo sabeis direis ¡Que chorrada
de algoritmo!. Suele pasar, en fin....
P.D.: Compilado con Turbo pascal v7.0 fonfona. Los TGA han de ser en 256 colores sin comprimir.
Program Conti_TGA;
{INFO: Los colores almacenados BGR no RGB}
uses
const
FICHE='Ficheroorigen.tga';
FICHEc='Ficherodestino.tga';
type
tipopal=array[0..255,1..3] of byte;
linea=array [1..640] of byte;
var
Idlen :byte; {Tamaño de la informaciñn adiccional}
CMtype :byte; {0 -> No hay paleta. 1 -> Si}
Imtype :Byte; {0 -> No hay datos imagen
1 -> Sin comprimir y con paleta
2 -> RGB sin comprimir
3 -> Escala de grises sin comprimir
9 -> Comprimido RLE y con paleta
10 -> RGB comprimido con RLE
11 -> Escala grises comprimido RLE
32 -> Comprimido Huffman con paleta
33 -> Comprimido Huffman cuadruple pasada con paleta}
Cmorg :integer; {Valor primer indice de la paleta; =0 si existe paleta}
Cmcnt :integer; {Nº elementos paleta. Debe valer 256}
cmsiz :byte; {Nº bits por elemento paleta}
Imxorg :Integer; {Coor. horizontal esquina inf. izquierda}
Imyorg :integer; {Coor. vertical esquina inf. izquierda}
Imwidth :Integer; {Ancho imagen}
Imheight :Integer; {Alto imagen}
Imwidth2 :Integer; {Ancho imagen}
Imheight2 :Integer; {Alto imagen}
Imdepth :byte; {Bits por pixel (8,15,16,24 ¢ 32)}
Imdesc :byte; {BITS 0-3: bits de overlay (0000,0001,1000)
4 : 1 -> Imagen de derecha a izq.
5 : 1 -> Imagen de abajo a arriba
6-7: 01 -> Imagen entrelazada}
f,fc:file;
Comentario:array[0..255] of char;
Tamcabe:word;
{******************************}
Procedure Gracioso;
begin
clrscr;
write(' Preparate para tener un nuevo concepto de grafico...');
delay(5000);
write(' ¿Ta gustao tontolhaba?');
halt;
end;
Procedure voltea(v1:linea;var v2:linea;tama:Integer);
var
begin
for cont:=1 to tama do
v2[tama+1-cont]:=v1[cont];
end;
Procedure Normal;
var
paleta:tipopal;
aux:byte;
x1,val1,val2:word;
incre:byte;
AUXVEC,volvec:linea;
k:char;
begin
blockread(f,paleta,sizeof(paleta));
blockwrite(fc,paleta,sizeof(paleta));
tamcabe:=tamcabe+sizeof(paleta);
for x1:=imheight downto 1 do
begin
Seek(f,tamcabe+(x1-1)*imwidth);
blockread(f,auxvec,imwidth);
blockwrite(fc,auxvec,imwidth);
voltea(auxvec,volvec,imwidth);
blockwrite(fc,volvec,imwidth);
write(x1);
end;
Seek(f,tamcabe);
for x1:=1 to imheight do
begin
blockread(f,auxvec,imwidth);
blockwrite(fc,auxvec,imwidth);
voltea(auxvec,volvec,imwidth);
blockwrite(fc,volvec,imwidth);
write(x1);
end;
end;
Procedure Cabecera;
begin
blockread(f,idlen,sizeof(idlen));
blockwrite(fc,idlen,sizeof(idlen));
Tamcabe:=tamcabe+sizeof(idlen);
blockread(f,cmtype,sizeof(cmtype));
blockwrite(fc,cmtype,sizeof(cmtype));
Tamcabe:=tamcabe+sizeof(Cmtype);
blockread(f,imtype,sizeof(imtype));
blockwrite(fc,imtype,sizeof(imtype));
Tamcabe:=tamcabe+sizeof(imtype);
blockread(f,cmorg,sizeof(cmorg));
blockwrite(fc,cmorg,sizeof(cmorg));
Tamcabe:=tamcabe+sizeof(cmorg);
blockread(f,cmcnt,sizeof(cmcnt));
blockwrite(fc,cmcnt,sizeof(cmcnt));
Tamcabe:=tamcabe+sizeof(cmcnt);
blockread(f,cmsiz,sizeof(cmsiz));
blockwrite(fc,cmsiz,sizeof(cmsiz));
Tamcabe:=tamcabe+sizeof(cmsiz);
blockread(f,imxorg,sizeof(imxorg));
blockwrite(fc,imxorg,sizeof(imxorg));
Tamcabe:=tamcabe+sizeof(imxorg);
blockread(f,imyorg,sizeof(imyorg));
blockwrite(fc,imyorg,sizeof(imyorg));
Tamcabe:=tamcabe+sizeof(imyorg);
blockread(f,imwidth,sizeof(imwidth));
Imwidth2:=Imwidth*2;
blockwrite(fc,imwidth2,sizeof(imwidth));
Tamcabe:=tamcabe+sizeof(imwidth);
blockread(f,imheight,sizeof(imheight));
Imheight2:=Imheight*2;
blockwrite(fc,imheight2,sizeof(imheight));
Tamcabe:=tamcabe+sizeof(imheight);
blockread(f,imdepth,sizeof(imdepth));
blockwrite(fc,imdepth,sizeof(imdepth));
Tamcabe:=tamcabe+sizeof(imdepth);
blockread(f,imdesc,sizeof(imdesc));
blockwrite(fc,imdesc,sizeof(imdesc));
Tamcabe:=tamcabe+sizeof(imdesc);
if idlen>0 then
begin
blockread(f,Comentario,idlen);
blockwrite(fc,Comentario,idlen);
Tamcabe:=tamcabe+idlen;
end;
case imtype of
end;
end;
begin
Tamcabe:=0;
assign(f,fiche);
assign(fc,fichec);
reset(f,1);
rewrite(fc,1);
Cabecera;
end.