source: oup/releases/0.12a/Unit6_imgfuncs.pas@ 570

Last change on this file since 570 was 21, checked in by alloc, 19 years ago
File size: 12.5 KB
RevLine 
[21]1UNIT Unit6_imgfuncs;
2INTERFACE
3USES Math, Dialogs, SysUtils, Unit3_data;
4
5TYPE
6 TImgPackage=RECORD
7 imgx,imgy:Word;
8 imgdepth:Byte;
9 storetype:Byte;
10 datasize:LongWord;
11 raw_addr:LongWord;
12 imgdata:Tdata;
13 END;
14FUNCTION ResizeImage(oldx,oldy:LongWord; imgdepth:Byte; data:Tdata):Tdata;
15FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata;
16FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata;
17FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata;
18FUNCTION BmpToImgdata(bmpdata:Tdata):TImgPackage;
19FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage;
20FUNCTION LoadImgData(fileid:LongWord):TImgPackage;
21
22IMPLEMENTATION
23USES Unit2_functions;
24
25
26FUNCTION ResizeImage(oldx,oldy:LongWord; imgdepth:Byte; data:Tdata):Tdata;
27 VAR
28 i,j:LongWord;
29 col,row,row_orig:LongWord;
30 temparray:Tdata;
31 BEGIN
32 SetLength(temparray,(oldx DIV 2)*(oldy DIV 2)*(imgdepth DIV 8));
33 row_orig:=0;
34 row:=0;
35 col:=0;
36 FOR i:=0 TO (oldx*oldy)-1 DO BEGIN
37 IF ((i MOD oldx)=0) AND (i>0) THEN BEGIN
38 Inc(row_orig);
39 IF (row_orig MOD 2)=0 THEN BEGIN
40 Inc(row);
41 col:=0;
42 END;
43 END;
44 IF (row_orig MOD 2)=0 THEN BEGIN
45 IF (i MOD 2)=0 THEN BEGIN
46 FOR j:=0 TO (imgdepth DIV 8)-1 DO
47 temparray[((row*(oldx DIV 2))+col)*(imgdepth DIV 8)+j]:=data[i*2+j];
48 Inc(col);
49 END;
50 END;
51 END;
52 Result:=temparray;
53 END;
54
55
56FUNCTION RevertImage(imgx,imgy,imgdepth:LongWord; imgdata:Tdata):Tdata;
57 VAR
58 x,y,i:LongWord;
59 BEGIN
60 SetLength(Result,imgx*imgy*(imgdepth DIV 8));
61 FOR y:=0 TO imgy-1 DO
62 FOR x:=0 TO imgx-1 DO
63 FOR i:=0 TO (imgdepth DIV 8)-1 DO
64 Result[((imgx*(imgy-1-y)+x)*(imgdepth DIV 8))+i]:=
65 imgdata[(imgx*y+x)*(imgdepth DIV 8)+i];
66 END;
67
68
69FUNCTION DecompressImage(imgx,imgy:LongWord; imgdata:Tdata):Tdata;
70 TYPE
71 Tcolor=RECORD
72 RGBb:Byte;
73 RGBg:Byte;
74 RGBr:Byte;
75 RGBa:Byte;
76 END;
77 VAR
78 i,j,x,y:LongWord;
79 color:Array[1..4] OF Tcolor;
80 pixel:Array[1..16] OF Byte;
81 BEGIN
82 x:=0;
83 y:=0;
84 SetLength(Result,imgx*imgy*4);
85 FOR i:=0 TO ((imgx*imgy) DIV 16)-1 DO BEGIN
86 Color[1].RGBb:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $001F) / $001F * 255);
87 Color[1].RGBg:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $07E0) / $07E0 * 255);
88 Color[1].RGBr:=Floor(((imgdata[(i*8)+0]+imgdata[(i*8)+1]*256) AND $F800) / $F800 * 255);
89 Color[1].RGBa:=255;
90 Color[2].RGBb:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $001F) / $001F * 255);
91 Color[2].RGBg:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $07E0) / $07E0 * 255);
92 Color[2].RGBr:=Floor(((imgdata[(i*8)+2]+imgdata[(i*8)+3]*256) AND $F800) / $F800 * 255);
93 Color[2].RGBa:=255;
94 Color[3].RGBb:=Floor( Color[1].RGBb/3*2 + Color[2].RGBb/3 );
95 Color[3].RGBg:=Floor( Color[1].RGBg/3*2 + Color[2].RGBg/3 );
96 Color[3].RGBr:=Floor( Color[1].RGBr/3*2 + Color[2].RGBr/3 );
97 Color[3].RGBa:=255;
98 Color[4].RGBb:=Floor( Color[1].RGBb/3 + Color[2].RGBb/3*2 );
99 Color[4].RGBg:=Floor( Color[1].RGBg/3 + Color[2].RGBg/3*2 );
100 Color[4].RGBr:=Floor( Color[1].RGBr/3 + Color[2].RGBr/3*2 );
101 Color[4].RGBa:=255;
102 Pixel[1]:=Floor( (imgdata[(i*8)+4] AND $C0) / $40 + 1 );
103 Pixel[2]:=Floor( (imgdata[(i*8)+4] AND $30) / $10 + 1 );
104 Pixel[3]:=Floor( (imgdata[(i*8)+4] AND $0C) / $04 + 1 );
105 Pixel[4]:=Floor( (imgdata[(i*8)+4] AND $03) + 1 );
106 Pixel[5]:=Floor( (imgdata[(i*8)+5] AND $C0) / $40 + 1 );
107 Pixel[6]:=Floor( (imgdata[(i*8)+5] AND $30) / $10 + 1 );
108 Pixel[7]:=Floor( (imgdata[(i*8)+5] AND $0C) / $04 + 1 );
109 Pixel[8]:=Floor( (imgdata[(i*8)+5] AND $03) + 1 );
110 Pixel[9]:=Floor( (imgdata[(i*8)+6] AND $C0) / $40 + 1 );
111 Pixel[10]:=Floor( (imgdata[(i*8)+6] AND $30) / $10 + 1 );
112 Pixel[11]:=Floor( (imgdata[(i*8)+6] AND $0C) / $04 + 1 );
113 Pixel[12]:=Floor( (imgdata[(i*8)+6] AND $03) + 1 );
114 Pixel[13]:=Floor( (imgdata[(i*8)+7] AND $C0) / $40 + 1 );
115 Pixel[14]:=Floor( (imgdata[(i*8)+7] AND $30) / $10 + 1 );
116 Pixel[15]:=Floor( (imgdata[(i*8)+7] AND $0C) / $04 + 1 );
117 Pixel[16]:=Floor( (imgdata[(i*8)+7] AND $03) + 1 );
118 FOR j:=0 TO 3 DO BEGIN
119 Result[((y+3)*imgx+x+j)*3+0]:=Color[Pixel[16-j]].RGBb;
120 Result[((y+3)*imgx+x+j)*3+1]:=Color[Pixel[16-j]].RGBg;
121 Result[((y+3)*imgx+x+j)*3+2]:=Color[Pixel[16-j]].RGBr;
122 END;
123 FOR j:=0 TO 3 DO BEGIN
124 Result[((y+2)*imgx+x+j)*3+0]:=Color[Pixel[12-j]].RGBb;
125 Result[((y+2)*imgx+x+j)*3+1]:=Color[Pixel[12-j]].RGBg;
126 Result[((y+2)*imgx+x+j)*3+2]:=Color[Pixel[12-j]].RGBr;
127 END;
128 FOR j:=0 TO 3 DO BEGIN
129 Result[((y+1)*imgx+x+j)*3+0]:=Color[Pixel[8-j]].RGBb;
130 Result[((y+1)*imgx+x+j)*3+1]:=Color[Pixel[8-j]].RGBg;
131 Result[((y+1)*imgx+x+j)*3+2]:=Color[Pixel[8-j]].RGBr;
132 END;
133 FOR j:=0 TO 3 DO BEGIN
134 Result[((y+0)*imgx+x+j)*3+0]:=Color[Pixel[4-j]].RGBb;
135 Result[((y+0)*imgx+x+j)*3+1]:=Color[Pixel[4-j]].RGBg;
136 Result[((y+0)*imgx+x+j)*3+2]:=Color[Pixel[4-j]].RGBr;
137 END;
138 x:=x+4;
139 IF x=imgx THEN BEGIN
140 y:=y+4;
141 x:=0;
142 END;
143 END;
144 END;
145
146
147FUNCTION ImgdataToBmp(imgx,imgy,imgdepth,storetype:LongWord; imgdata:Tdata):Tdata;
148 CONST BMPheader:Array[0..53] OF Byte=
149 ($42,$4D,0,0,0,0,0,0,0,0,54,0,0,0,
150 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);
151 VAR
152 i,x,y:LongWord;
153 BEGIN
154 CASE storetype OF
155 0: BEGIN
156 SetLength(Result,imgx*imgy*3);
157 FOR y:=0 TO imgy-1 DO BEGIN
158 FOR x:=0 TO imgx-1 DO BEGIN
159 Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $000F ) / $000F * 255);
160 Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $00F0 ) / $00F0 * 255);
161 Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $0F00 ) / $0F00 * 255);
162 END;
163 END;
164 END;
165 1,2,8: BEGIN
166 SetLength(Result,imgx*imgy*3);
167 FOR y:=0 TO imgy-1 DO BEGIN
168 FOR x:=0 TO imgx-1 DO BEGIN
169 Result[((imgx*y+x)*3)+0]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $001F ) / $001F * 255);
170 Result[((imgx*y+x)*3)+1]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $03E0 ) / $03E0 * 255);
171 Result[((imgx*y+x)*3)+2]:=Floor( ( (imgdata[(imgx*y+x)*2]+imgdata[(imgx*y+x)*2+1]*256) AND $7C00 ) / $7C00 * 255);
172 END;
173 END;
174 END;
175 9: BEGIN
176 Result:=DecompressImage(imgx,imgy,imgdata);
177 END;
178 END;
179 Result:=RevertImage(imgx,imgy,24,Result);
180 SetLength(Result,imgx*imgy*3+54);
181 FOR i:=High(Result)-54 DOWNTO 0 DO Result[i+54]:=Result[i];
182
183 FOR i:=0 TO High(BMPheader) DO Result[i]:=BMPheader[i];
184 Result[2]:=((imgx*imgy*3+54) AND $000000FF);
185 Result[3]:=((imgx*imgy*3+54) AND $0000FF00) DIV $100;
186 Result[4]:=((imgx*imgy*3+54) AND $00FF0000) DIV $10000;
187 Result[5]:=((imgx*imgy*3+54) AND $FF000000) DIV $1000000;
188 Result[18]:=(imgx AND $000000FF) DIV $1;
189 Result[19]:=(imgx AND $0000FF00) DIV $100;
190 Result[20]:=(imgx AND $00FF0000) DIV $10000;
191 Result[21]:=(imgx AND $FF000000) DIV $1000000;
192 Result[22]:=(imgy AND $000000FF) DIV $1;
193 Result[23]:=(imgy AND $0000FF00) DIV $100;
194 Result[24]:=(imgy AND $00FF0000) DIV $10000;
195 Result[25]:=(imgy AND $FF000000) DIV $1000000;
196 Result[34]:=((imgx*imgy*3) AND $000000FF) DIV $1;
197 Result[35]:=((imgx*imgy*3) AND $0000FF00) DIV $100;
198 Result[36]:=((imgx*imgy*3) AND $00FF0000) DIV $10000;
199 Result[37]:=((imgx*imgy*3) AND $FF000000) DIV $1000000;
200 END;
201
202FUNCTION BmpToImgdata(bmpdata:Tdata):TImgPackage;
203 VAR
204 x,y:LongWord;
205 r24,g24,b24:Word;
206 r16,g16,b16:Word;
207 gesamt:Word;
208 BEGIN
209 Result.imgdepth:=0;
210 IF NOT((bmpdata[00]=$42) AND (bmpdata[01]=$4D)) THEN BEGIN
211 ShowMessage('Not a standard 24bit bitmap');
212 Exit;
213 END;
214 IF NOT(bmpdata[10]=54) THEN BEGIN
215 ShowMessage('Imagedata has to start at 0x54');
216 Exit;
217 END;
218 IF NOT(bmpdata[14]=40) THEN BEGIN
219 ShowMessage('Second bitmap header has to have 40 bytes');
220 Exit;
221 END;
222 IF NOT(bmpdata[28]=24) THEN BEGIN
223 ShowMessage('Bitmap has to have 24bits');
224 Exit;
225 END;
226 IF NOT(bmpdata[30]=0) THEN BEGIN
227 ShowMessage('Bitmap has to be uncompressed');
228 Exit;
229 END;
230 Result.imgx:=bmpdata[18]+bmpdata[19]*256+bmpdata[20]*256*256+bmpdata[21]*256*256*256;
231 Result.imgy:=bmpdata[22]+bmpdata[23]*256+bmpdata[24]*256*256+bmpdata[25]*256*256*256;
232 Result.imgdepth:=16;
233 Result.storetype:=1;
234
235 SetLength(Result.imgdata,Result.imgx*Result.imgy*2);
236 FOR y:=0 TO Result.imgy-1 DO BEGIN
237 FOR x:=0 TO Result.imgx-1 DO BEGIN
238 r24:=bmpdata[54+(Result.imgx*y+x)*3+0];
239 g24:=bmpdata[54+(Result.imgx*y+x)*3+1];
240 b24:=bmpdata[54+(Result.imgx*y+x)*3+2];
241 r16:=(Ceil(r24*$001F/255)) AND $001F;
242 g16:=(Ceil(g24*$03E0/255)) AND $03E0;
243 b16:=(Ceil(b24*$7C00/255)) AND $7C00;
244 gesamt:=r16+g16+b16;
245 Result.imgdata[((Result.imgx*y+x)*2)+0]:=gesamt AND $00FF;
246 Result.imgdata[((Result.imgx*y+x)*2)+1]:=(gesamt AND $FF00) DIV 256;
247 END;
248 END;
249
250 Result.imgdata:=RevertImage(Result.imgx,Result.imgy,Result.imgdepth,Result.imgdata);
251 END;
252
253FUNCTION LoadTXMBconnected(fileid:LongWord):TImgPackage;
254 VAR
255 i,x,y,x2,y2,pixelid,imgid:LongWord;
256 rows,cols:Word;
257 linkcount:LongWord;
258 link:LongWord;
259 single_image:TImgPackage;
260 images_decoded:Array OF TImgPackage;
261 x_start,y_start:LongWord;
262 BEGIN
263 LoadDatFilePart(fileid,$10,SizeOf(Result.imgx),@Result.imgx);
264 LoadDatFilePart(fileid,$12,SizeOf(Result.imgy),@Result.imgy);
265 LoadDatFilePart(fileid,$18,SizeOf(cols),@cols);
266 LoadDatFilePart(fileid,$1A,SizeOf(rows),@rows);
267 LoadDatFilePart(fileid,$1C,SizeOf(linkcount),@linkcount);
268 SetLength(images_decoded,linkcount);
269 FOR i:=0 TO linkcount-1 DO BEGIN
270 LoadDatFilePart(fileid,$20+i*4,SizeOf(link),@link);
271 link:=link DIV 256;
272 single_image:=LoadImgData(link);
273 images_decoded[i]:=BmpToImgdata(ImgdataToBmp(single_image.imgx,single_image.imgy,single_image.imgdepth,single_image.storetype,single_image.imgdata));
274 END;
275 SetLength(Result.imgdata,Result.imgx*Result.imgy*2);
276 FOR y:=0 TO rows-1 DO BEGIN
277 FOR x:=0 TO cols-1 DO BEGIN
278 imgid:=y*cols+x;
279 x_start:=0;
280 y_start:=0;
281 FOR i:=0 TO x DO IF i<x THEN x_start:=x_start+images_decoded[i].imgx;
282 FOR i:=0 TO y DO IF i<y THEN y_start:=y_start+images_decoded[i].imgy;
283 FOR y2:=0 TO images_decoded[imgid].imgy-1 DO BEGIN
284 FOR x2:=0 TO images_decoded[imgid].imgx-1 DO BEGIN
285 IF ( (x_start+x2)<Result.imgx ) AND ( (y_start+y2)<Result.imgy ) THEN BEGIN
286 pixelid:=y_start*Result.imgx+x_start+y2*Result.imgx+x2;
287 Result.imgdata[pixelid*2+0]:=images_decoded[imgid].imgdata[(y2*images_decoded[imgid].imgx+x2)*2+0];
288 Result.imgdata[pixelid*2+1]:=images_decoded[imgid].imgdata[(y2*images_decoded[imgid].imgx+x2)*2+1];
289 END;
290 END;
291 END;
292 END;
293 END;
294 Result.imgdepth:=16;
295 Result.storetype:=1;
296 END;
297
298FUNCTION LoadImgData(fileid:LongWord):TImgPackage;
299 BEGIN
300 LoadDatFilePart(fileid,$9C,SizeOf(Result.raw_addr),@Result.raw_addr);
301 LoadDatFilePart(fileid,$8C,SizeOf(Result.imgx),@Result.imgx);
302 LoadDatFilePart(fileid,$8E,SizeOf(Result.imgy),@Result.imgy);
303 LoadDatFilePart(fileid,$90,SizeOf(Result.storetype),@Result.storetype);
304
305 CASE Result.storetype OF
306 0,1,2: BEGIN
307 Result.datasize:=Result.imgx*Result.imgy*2;
308 Result.imgdepth:=16;
309 END;
310 8: BEGIN
311 Result.datasize:=Result.imgx*Result.imgy*4;
312 Result.imgdepth:=32;
313 END;
314 9: BEGIN
315 Result.datasize:=Result.imgx*Result.imgy DIV 2;
316 Result.imgdepth:=16;
317 END;
318 ELSE
319 Exit;
320 END;
321 SetLength(Result.imgdata,Result.datasize);
322
323 LoadRawFilePart(Result.raw_addr,Result.datasize,@Result.imgdata[0]);
324 END;
325
326END.
Note: See TracBrowser for help on using the repository browser.