UNIT Unit6_imgfuncs; INTERFACE USES Math, Dialogs, SysUtils, Unit3_data; TYPE TImgPackage=RECORD imgx,imgy:Word; imgdepth:Byte; storetype:Byte; datasize:LongWord; raw_addr:LongWord; imgdata:Tdata; END; FUNCTION ResizeImage(oldx,oldy:LongWord; imgdepth:Byte; data:Tdata):Tdata; FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; FUNCTION LoadImgData(fileid:LongWord):TImgPackage; FUNCTION GetImageDataSize(imgx,imgy,imgdepth:Word; fading:Boolean):LongWord; FUNCTION CreateFadedImage(image:TImgPackage):Tdata; IMPLEMENTATION USES Unit2_functions; FUNCTION ResizeImage(oldx,oldy:LongWord; imgdepth:Byte; data:Tdata):Tdata; VAR i,j:LongWord; col,row,row_orig:LongWord; temparray:Tdata; BEGIN SetLength(temparray,(oldx DIV 2)*(oldy DIV 2)*(imgdepth DIV 8)); row_orig:=0; row:=0; col:=0; FOR i:=0 TO (oldx*oldy)-1 DO BEGIN IF ((i MOD oldx)=0) AND (i>0) THEN BEGIN Inc(row_orig); IF (row_orig MOD 2)=0 THEN BEGIN Inc(row); col:=0; END; END; IF (row_orig MOD 2)=0 THEN BEGIN IF (i MOD 2)=0 THEN BEGIN FOR j:=0 TO (imgdepth DIV 8)-1 DO temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j]; Inc(col); END; END; END; Result:=temparray; END; FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata; VAR x,y,i:LongWord; BEGIN SetLength(Result,imgx*imgy*(imgdepth DIV 8)); FOR y:=0 TO imgy-1 DO FOR x:=0 TO imgx-1 DO FOR i:=0 TO (imgdepth DIV 8)-1 DO Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:= imgdata[(imgx*y+x)*(imgdepth DIV 8)+i]; END; FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata; TYPE Tcolor=RECORD RGBb:Byte; RGBg:Byte; RGBr:Byte; RGBa:Byte; END; VAR i,j,x,y:LongWord; color:Array[1..4] OF Tcolor; pixel:Array[1..16] OF Byte; BEGIN x:=0; y:=0; SetLength(Result,imgx*imgy*4); FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255); Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255); Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255); Color[1].RGBa:=255; Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255); Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255); Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255); Color[2].RGBa:=255; Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 ); Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 ); Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 ); Color[3].RGBa:=255; Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 ); Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 ); Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 ); Color[4].RGBa:=255; Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 ); Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 ); Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 ); Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 ); Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 ); Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 ); Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 ); Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 ); Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 ); Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 ); Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 ); Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 ); Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 ); Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 ); Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 ); Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 ); FOR j:=0 TO 3 DO BEGIN Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb; Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg; Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr; END; FOR j:=0 TO 3 DO BEGIN Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb; Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg; Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr; END; FOR j:=0 TO 3 DO BEGIN Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb; Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg; Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr; END; FOR j:=0 TO 3 DO BEGIN Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb; Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg; Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr; END; x:=x+4; IF x=imgx THEN BEGIN y:=y+4; x:=0; END; END; END; FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata; CONST BMPheader:Array[0..53] OF Byte= ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0, 40,0,0,0,0,0,0,0,0,0,0,0,1,0,$18,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); VAR i,x,y:LongWord; BEGIN CASE storetype OF 0: BEGIN SetLength(Result,imgx*imgy*3); FOR y:=0 TO imgy-1 DO BEGIN FOR x:=0 TO imgx-1 DO BEGIN Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255); Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255); Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255); END; END; END; 1,2: BEGIN SetLength(Result,imgx*imgy*3); FOR y:=0 TO imgy-1 DO BEGIN FOR x:=0 TO imgx-1 DO BEGIN Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255); Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255); Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255); END; END; END; 8: BEGIN SetLength(Result,imgx*imgy*3); FOR y:=0 TO imgy-1 DO BEGIN FOR x:=0 TO imgx-1 DO BEGIN Result[((imgx*y+x)*3)+0]:=imgdata[(imgx*y+x)*4+0]; Result[((imgx*y+x)*3)+1]:=imgdata[(imgx*y+x)*4+1]; Result[((imgx*y+x)*3)+2]:=imgdata[(imgx*y+x)*4+2]; END; END; END; 9: BEGIN Result:=DecompressImage(imgx,imgy,imgdata); END; END; Result:=RevertImage(imgx,imgy,24,Result); SetLength(Result,imgx*imgy*3+54); FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i]; FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i]; Result[2]:=((imgx*imgy*3+54) AND $000000FF); Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100; Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000; Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000; Result[18]:=(imgx AND $000000FF) DIV $1; Result[19]:=(imgx AND $0000FF00) DIV $100; Result[20]:=(imgx AND $00FF0000) DIV $10000; Result[21]:=(imgx AND $FF000000) DIV $1000000; Result[22]:=(imgy AND $000000FF) DIV $1; Result[23]:=(imgy AND $0000FF00) DIV $100; Result[24]:=(imgy AND $00FF0000) DIV $10000; Result[25]:=(imgy AND $FF000000) DIV $1000000; Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1; Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100; Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000; Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000; END; FUNCTION BmpToImgdata(bmpdata:Tdata; _32bit:Boolean):TImgPackage; VAR x,y:LongWord; r24,g24,b24:Word; r16,g16,b16:Word; gesamt:Word; BEGIN Result.imgdepth:=0; IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN ShowMessage('Not a standard 24bit bitmap'); Exit; END; IF NOT(bmpdata[10]=54) THEN BEGIN ShowMessage('Imagedata has to start at 0x54'); Exit; END; IF NOT(bmpdata[14]=40) THEN BEGIN ShowMessage('Second bitmap header has to have 40 bytes'); Exit; END; IF NOT(bmpdata[28]=24) THEN BEGIN ShowMessage('Bitmap has to have 24bits'); Exit; END; IF NOT(bmpdata[30]=0) THEN BEGIN ShowMessage('Bitmap has to be uncompressed'); Exit; END; Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256; Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256; IF _32bit THEN BEGIN Result.imgdepth:=32; Result.storetype:=8; END ELSE BEGIN Result.imgdepth:=16; Result.storetype:=1; END; SetLength(Result.imgdata,Result.imgx*Result.imgy*Result.imgdepth DIV 8); IF _32bit THEN BEGIN FOR y:=0 TO Result.imgy-1 DO BEGIN FOR x:=0 TO Result.imgx-1 DO BEGIN Result.imgdata[((Result.imgx*y+x)*4)+0]:=bmpdata[54+(Result.imgx*y+x)*3+0]; Result.imgdata[((Result.imgx*y+x)*4)+1]:=bmpdata[54+(Result.imgx*y+x)*3+1]; Result.imgdata[((Result.imgx*y+x)*4)+2]:=bmpdata[54+(Result.imgx*y+x)*3+2]; Result.imgdata[((Result.imgx*y+x)*4)+3]:=0; END; END; END ELSE BEGIN FOR y:=0 TO Result.imgy-1 DO BEGIN FOR x:=0 TO Result.imgx-1 DO BEGIN r24:=bmpdata[54+(Result.imgx*y+x)*3+0]; g24:=bmpdata[54+(Result.imgx*y+x)*3+1]; b24:=bmpdata[54+(Result.imgx*y+x)*3+2]; r16:=(Ceil(r24*$001F/255)) AND $001F; g16:=(Ceil(g24*$03E0/255)) AND $03E0; b16:=(Ceil(b24*$7C00/255)) AND $7C00; gesamt:=r16+g16+b16; Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF; Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256; END; END; END; Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata); END; FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage; VAR i,x,y,x2,y2,pixelid,imgid:LongWord; rows,cols:Word; linkcount:LongWord; link:LongWord; single_image:TImgPackage; images_decoded:Array OF TImgPackage; x_start,y_start:LongWord; BEGIN LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx); LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy); LoadDatFilePart(fileid,$18,SizeOf(cols),@cols); LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows); LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount); SetLength(images_decoded,linkcount); FOR i:=0 TO linkcount-1 DO BEGIN LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link); link:=link DIV 256; single_image:=LoadImgData(link); images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata),False); END; SetLength(Result.imgdata,Result.imgx*Result.imgy*2); FOR y:=0 TO rows-1 DO BEGIN FOR x:=0 TO cols-1 DO BEGIN imgid:=y*cols+x; x_start:=0; y_start:=0; FOR i:=0 TO x DO IF i