source: oup/releases/0.34a/Global/OniImgClass.pas@ 1009

Last change on this file since 1009 was 200, checked in by alloc, 18 years ago
File size: 15.8 KB
Line 
1unit OniImgClass;
2
3interface
4
5uses Math, Dialogs, Types, SysUtils, Classes, Data, ConnectionManager, TypeDefs,
6 Imaging, ImagingTypes, Graphics;
7
8
9type
10 TOniImage = class
11 private
12 FImages: TDynImageDataArray;
13 function GetImage(MipGen: Integer): TImageData;
14 function GetWidth(MipGen: Integer): Integer;
15 function GetHeight(MipGen: Integer): Integer;
16 function GetImageFormat: TImageFormat;
17 procedure SetImageFormat(Format: TImageFormat);
18 function pGetImageFormatInfo: TImageFormatInfo;
19 function GetHasMipMaps: Boolean;
20 protected
21 public
22 property Images: TDynImageDataArray read FImages;
23 property Image[MipGen: Integer]: TImageData read GetImage;
24 property Width[MipGen: Integer]: Integer read GetWidth;
25 property Height[MipGen: Integer]: Integer read GetHeight;
26 property Format: TImageFormat read GetImageFormat write SetImageFormat;
27 property FormatInfo: TImageFormatInfo read pGetImageFormatInfo;
28 property HasMipMaps: Boolean read GetHasMipMaps;
29
30 constructor Create;
31 procedure Free;
32 function Load(ConnectionID, FileID: Integer): Boolean;
33 function LoadFromPSpc(ConnectionID, FileID: Integer): Boolean;
34 function LoadFromTXMP(ConnectionID, FileID: Integer): Boolean;
35 function LoadFromTXMB(ConnectionID, FileID: Integer): Boolean;
36
37 procedure SaveDataToStream(MipMaps: Boolean; var Target: TStream);
38
39 function LoadFromFile(filename: String): Boolean;
40 function WriteToFile(filename: String): Boolean;
41
42 procedure DrawOnCanvas(Canvas: TCanvas; Index: Integer);
43 function GetImageSize(MipMaps: Boolean): Integer;
44 published
45 end;
46
47
48implementation
49
50uses Img_DDSTypes, ImagingComponents;
51
52
53procedure TOniImage.DrawOnCanvas(Canvas: TCanvas; Index: Integer);
54var
55 singleimg: TImageData;
56 rect: TRect;
57begin
58 InitImage(singleimg);
59 CloneImage(FImages[Index-1], singleimg);
60 ConvertImage(singleimg, ifX8R8G8B8);
61 rect.Left := 0;
62 rect.Top := 0;
63 rect.Right := singleimg.Width - 1;
64 rect.Bottom := singleimg.Height - 1;
65 Canvas.Brush.Color := $C8D0D4;
66 Canvas.FillRect(Canvas.ClipRect);
67 DisplayImageData(Canvas, rect, singleimg, rect);
68 FreeImage(singleimg);
69end;
70
71
72
73constructor TOniImage.Create;
74begin
75end;
76
77
78
79procedure TOniImage.Free;
80begin
81 FreeImagesInArray(FImages);
82end;
83
84
85
86
87function TOniImage.GetImage(MipGen: Integer): TImageData;
88begin
89 if MipGen <= Length(FImages) then
90 begin
91 InitImage(Result);
92 CloneImage(FImages[MipGen-1], Result);
93 end;
94end;
95
96
97
98function TOniImage.GetWidth(MipGen: Integer): Integer;
99begin
100 if MipGen <= Length(FImages) then
101 Result := FImages[MipGen-1].Width
102 else
103 Result := -1;
104end;
105
106
107function TOniImage.GetHeight(MipGen: Integer): Integer;
108begin
109 if MipGen <= Length(FImages) then
110 Result := FImages[MipGen-1].Height
111 else
112 Result := -1;
113end;
114
115
116function TOniImage.GetImageFormat: TImageFormat;
117begin
118 if Length(FImages) > 0 then
119 Result := FImages[0].Format
120 else
121 Result := ifUnknown;
122end;
123
124procedure TOniImage.SetImageFormat(Format: TImageFormat);
125var
126 i: Integer;
127begin
128 if Length(FImages) > 0 then
129 for i := 0 to High(FImages) do
130 ConvertImage(FImages[i], Format);
131end;
132
133
134function TOniImage.pGetImageFormatInfo: TImageFormatInfo;
135begin
136 if Length(FImages) > 0 then
137 GetImageFormatInfo(FImages[0].Format, Result);
138end;
139
140
141function TOniImage.GetHasMipMaps: Boolean;
142begin
143 Result := Length(FImages) > 1;
144end;
145
146
147function TOniImage.Load(ConnectionID, FileID: Integer): Boolean;
148var
149 FileInfo: TFileInfo;
150begin
151 FileInfo := ConManager.Connection[ConnectionID].GetFileInfo(fileid);
152 if FileInfo.Extension = 'PSpc' then
153 Result := LoadFromPSpc(ConnectionID, fileid)
154 else if FileInfo.Extension = 'TXMB' then
155 Result := LoadFromTXMB(ConnectionID, fileid)
156 else if FileInfo.Extension = 'TXMP' then
157 Result := LoadFromTXMP(ConnectionID, fileid)
158 else
159 Result := False;
160end;
161
162
163
164
165function TOniImage.LoadFromPSpc(ConnectionID, FileID: Integer): Boolean;
166type
167 TPoint = packed record
168 X, Y: Word;
169 end;
170
171 TPSpc = packed record
172 p1: array[0..8] of TPoint;
173 p2: array[0..8] of TPoint;
174 TXMP: Integer;
175 end;
176
177 TPart = packed record
178 x_txmp, y_txmp: Word;
179 x_pspc, y_pspc: Word;
180 w, h: Word;
181 imgdata: TImageData;
182 used: Boolean;
183 end;
184const
185 PartMatch: array[0..8] of Byte = (0, 3, 6, 1, 4, 7, 2, 5, 8);
186 stretch_x: Integer = 1;
187 stretch_y: Integer = 1;
188var
189 x, y: Word;
190 i: Integer;
191
192 PSpc: TPSpc;
193 txmpimg: TOniImage;
194// txmpdata: TByteData;
195
196 parts: array[0..8] of TPart;
197 part: Byte;
198 cols: array[0..2] of Word;
199 rows: array[0..2] of Word;
200 col, row: Byte;
201
202 pspcimage: TImageData;
203begin
204 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $08, SizeOf(PSpc), @PSpc);
205 PSpc.TXMP := PSpc.TXMP div 256;
206 if PSpc.TXMP = 0 then
207 begin
208 Result := False;
209 Exit;
210 end;
211 txmpimg := TOniImage.Create;
212 txmpimg.Load(ConnectionID, PSpc.TXMP);
213 CloneImage(txmpimg.Image[1], pspcimage);
214 txmpimg.Free;
215
216 with pspc do
217 begin
218 for i := 0 to 2 do
219 begin
220 cols[i] := 0;
221 rows[i] := 0;
222 end;
223 for i := 0 to 8 do
224 begin
225 part := PartMatch[i];
226 col := i div 3;
227 row := i mod 3;
228 if (p2[i].X > 0) or (p2[i].Y > 0) then
229 begin
230 parts[part].x_txmp := p1[i].X;// - 1;
231 parts[part].y_txmp := p1[i].Y;// - 1;
232 parts[part].x_pspc := 0;
233 if col > 0 then
234 for x := 0 to col - 1 do
235 Inc(parts[part].x_pspc, cols[x]);
236 parts[part].y_pspc := 0;
237 if row > 0 then
238 for y := 0 to row - 1 do
239 Inc(parts[part].y_pspc, rows[y]);
240 parts[part].w := Max(p2[i].X - p1[i].X, 1);// + 1;
241 parts[part].h := Max(p2[i].Y - p1[i].Y, 1);// + 1;
242 parts[part].used := True;
243 cols[col] := parts[part].w;
244 rows[row] := parts[part].h;
245
246 NewImage(parts[part].w, parts[part].h, pspcimage.Format, parts[part].imgdata);
247
248 CopyRect(pspcimage,
249 parts[part].x_txmp, parts[part].y_txmp, parts[part].w, parts[part].h,
250 parts[part].imgdata, 0, 0);
251 end
252 else
253 begin
254 parts[part].used := False;
255 end;
256 end;
257
258 end;
259
260 for i := 0 to 8 do
261 begin
262 if parts[i].used then
263 begin
264// SaveImageToFile('M:\' + IntToStr(i) + '.bmp', parts[i].imgdata);
265 end;
266 end;
267
268 SetLength(FImages, 1);
269 x := cols[0] + cols[1] * stretch_x + cols[2];
270 y := rows[0] + rows[1] * stretch_y + rows[2];
271
272 NewImage(x, y, pspcimage.Format, FImages[0]);
273
274 x := 0;
275 for col := 0 to 2 do
276 begin
277 y := 0;
278 for row := 0 to 2 do
279 begin
280 part := row*3 + col;
281 if parts[part].used then
282 begin
283 if (row = 1) and (col = 1) then
284 StretchRect(parts[part].imgdata, 0, 0, parts[part].w, parts[part].h,
285 FImages[0], x, y, parts[part].w * stretch_x, parts[part].h * stretch_y, rfNearest)
286 else
287 if (row = 1) then
288 StretchRect(parts[part].imgdata, 0, 0, parts[part].w, parts[part].h,
289 FImages[0], x, y, parts[part].w, parts[part].h * stretch_y, rfNearest)
290 else
291 if (col = 1) then
292 StretchRect(parts[part].imgdata, 0, 0, parts[part].w, parts[part].h,
293 FImages[0], x, y, parts[part].w * stretch_x, parts[part].h, rfNearest)
294 else
295 CopyRect(parts[part].imgdata, 0, 0, parts[part].w, parts[part].h,
296 FImages[0], x, y );
297 if row = 1 then
298 y := y + parts[part].h * stretch_y
299 else
300 y := y + parts[part].h;
301 end;
302 end;
303 if cols[col] > 0 then
304 begin
305 if (col = 1) then
306 x := x + parts[part].w * stretch_x
307 else
308 x := x + parts[part].w;
309 end;
310 end;
311
312 FreeImage(pspcimage);
313 for i := 0 to 8 do
314 if parts[i].used then
315 FreeImage(parts[i].imgdata);
316end;
317
318
319
320
321function TOniImage.LoadFromTXMP(ConnectionID, FileID: Integer): Boolean;
322var
323 img_addr: Integer;
324 data: TMemoryStream;
325 hdr: TDDSDXTHeader;
326 imginfo: Integer;
327 x,y, i: Integer;
328
329 _width, _height: Word;
330 _storetype: Byte;
331 _depth: Byte;
332begin
333 Result := True;
334 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $8C, SizeOf(_width), @_width);
335 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $8E, SizeOf(_height), @_height);
336 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $90, SizeOf(_storetype), @_storetype);
337 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $88, SizeOf(imginfo), @imginfo);
338 if ConManager.Connection[ConnectionID].DataOS = DOS_WIN then
339 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $9C, SizeOf(img_addr), @img_addr)
340 else
341 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $A0, SizeOf(img_addr), @img_addr);
342
343 case _storetype of
344 0, 1, 2:
345 _depth := 16;
346 7, 8:
347 _depth := 32;
348 9:
349 _depth := 16;
350 else
351 Result := False;
352 Exit;
353 end;
354
355 with hdr do
356 begin
357 FOURCC := 'DDS ';
358 with SURFACEDESC2 do
359 begin
360 Size := 124;
361 Flags := DDSD_CAPS or DDSD_PIXELFORMAT or DDSD_WIDTH or DDSD_HEIGHT;
362 if _storetype = 9 then
363 Flags := Flags or DDSD_LINEARSIZE
364 else
365 Flags := Flags or DDSD_PITCH;
366 if (imginfo and $01) > 0 then
367 Flags := Flags or DDSD_MIPMAPCOUNT;
368 Height := _height;
369 Width := _width;
370 if _storetype = 9 then
371 PitchOrLinearSize := width * height div 2
372 else
373 PitchOrLinearSize := width * _depth div 8;
374 Depth := 0;
375 MipMapCount := 1;
376 if (imginfo and $01) > 0 then
377 begin
378 x := width;
379 y := height;
380 while (x > 1) and (y > 1) do
381 begin
382 x := x div 2;
383 y := y div 2;
384 Inc(MipMapCount);
385 end;
386 end;
387 for i := 1 to 11 do
388 Reserved[i] := 0;
389 with PIXELFORMAT do
390 begin
391 Size := 32;
392 if _storetype = 9 then
393 Flags := DDPF_FOURCC
394 else
395 Flags := DDPF_RGB;
396 if _storetype in [0, 2] then
397 Flags := Flags or DDPF_ALPHAPIXELS;
398 if _storetype = 9 then
399 FOURCC := 'DXT1'
400 else
401 begin
402 RGBBitCount := _depth;
403 case _storetype of
404 0: begin
405 RBitMask := $0F00;
406 GBitMask := $00F0;
407 BBitMask := $000F;
408 AlphaBitMask := $F000;
409 end;
410 1, 2: begin
411 RBitMask := $7C00;
412 GBitMask := $03E0;
413 BBitMask := $001F;
414 if _storetype = 2 then
415 AlphaBitMask := $8000
416 else
417 AlphaBitMask := $0000;
418 end;
419 8: begin
420 RBitMask := $00FF0000;
421 GBitMask := $0000FF00;
422 BBitMask := $000000FF;
423 AlphaBitMask := $00000000;
424 end;
425 end;
426 end;
427 end;
428 with DDSCAPS2 do
429 begin
430 Caps1 := DDSCAPS_TEXTURE;
431 if (imginfo and $01) > 0 then
432 Caps1 := Caps1 or DDSCAPS_COMPLEX or DDSCAPS_MIPMAP;
433 Caps2 := 0;
434 Reserved[1] := 0;
435 Reserved[2] := 0;
436 end;
437 end;
438 end;
439
440 data := TMemoryStream.Create;
441 data.Write(hdr, SizeOf(hdr));
442 if ConManager.Connection[ConnectionID].DataOS = DOS_WIN then
443 ConManager.Connection[ConnectionID].LoadRawFile(fileid, $9C, TStream(data))
444 else
445 ConManager.Connection[ConnectionID].LoadRawFile(fileid, $A0, TStream(data));
446
447// data.Seek(0, soFromBeginning);
448// data.SaveToFile('m:\test.txmp');
449
450 data.Seek(0, soFromBeginning);
451 result := LoadMultiImageFromStream(data, FImages);
452 data.Free;
453{
454 if result then
455 begin
456 for i := 0 to High(FImages) do
457 begin
458 data := TMemoryStream.Create;
459 data.Write(FImages[i].Bits^, FImages[i].Size);
460 data.Seek(0, soFromBeginning);
461 data.SaveToFile('m:\test.txmp.'+IntToStr(i));
462 data.Free;
463 end;
464 end;
465}
466 if not result then
467 begin
468 ShowMessage('Error while loading file' + #13#10 + DetermineStreamFormat(data));
469// data.SaveToFile('m:\prob.dds');
470 end;
471end;
472
473
474
475
476function TOniImage.LoadFromTXMB(ConnectionID, FileID: Integer): Boolean;
477var
478 i, x, y, imgid: Integer;
479 rows, cols: Word;
480 linkcount: Integer;
481 link: Integer;
482 images: array of TOniImage;
483 x_start, y_start: Integer;
484
485 width, height: Word;
486begin
487 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $10, SizeOf(width), @width);
488 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $12, SizeOf(height), @height);
489 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $18, SizeOf(cols), @cols);
490 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $1A, SizeOf(rows), @rows);
491 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $1C, SizeOf(linkcount), @linkcount);
492 SetLength(images, linkcount);
493 for i := 0 to linkcount - 1 do
494 begin
495 ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $20 + i * 4, SizeOf(link), @link);
496 link := link div 256;
497 images[i] := TOniImage.Create;
498 images[i].LoadFromTXMP(ConnectionID, link);
499 SetLength(FImages, 1);
500 NewImage(width, height, ifA1R5G5B5, FImages[0]);
501 end;
502 for y := 0 to rows - 1 do
503 begin
504 for x := 0 to cols - 1 do
505 begin
506 imgid := y * cols + x;
507 x_start := 0;
508 y_start := 0;
509 for i := 0 to x do
510 if i < x then
511 x_start := x_start + images[i].Image[0].Width;
512 for i := 0 to y do
513 if i < y then
514 y_start := y_start + images[i].Image[0].Height;
515 CopyRect(images[imgid].Image[0], 0, 0, images[imgid].Image[0].Width,
516 images[imgid].Image[0].Height, FImages[0], x_start, y_start);
517 end;
518 end;
519 for i := 0 to linkcount - 1 do
520 images[i].Free;
521end;
522
523
524
525procedure TOniImage.SaveDataToStream(MipMaps: Boolean; var Target: TStream);
526var
527 images: TDynImageDataArray;
528 mem: TMemoryStream;
529 i: Integer;
530begin
531 if Length(FImages) = 0 then
532 Exit;
533 if MipMaps then
534 begin
535 if Length(FImages) = 1 then
536 begin
537 if not GenerateMipMaps(FImages[0], 0, images) then
538 begin
539 ShowMessage('Could not generate MipMaps');
540 Exit;
541 end;
542 end
543 else
544 begin
545 SetLength(images, Length(FImages));
546 for i := 0 to High(FImages) do
547 CloneImage(FImages[i], images[i]);
548 end;
549 mem := TMemoryStream.Create;
550 if not SaveMultiImageToStream('dds', mem, images) then
551 begin
552 ShowMessage('Could not save images to stream');
553 Exit;
554 end;
555 FreeImagesInArray(images);
556 end
557 else
558 begin
559 mem := TMemoryStream.Create;
560 if not SaveImageToStream('dds', mem, FImages[0]) then
561 begin
562 ShowMessage('Could not save image to stream');
563 Exit;
564 end;
565 end;
566 if not Assigned(Target) then
567 Target := TMemoryStream.Create;
568
569// mem.Seek(0, soFromBeginning);
570// mem.SaveToFile('m:\dds.dds');
571
572 mem.Seek(128, soFromBeginning);
573 Target.CopyFrom(mem, mem.Size - 128);
574 mem.Free;
575 Target.Seek(0, soFromBeginning);
576end;
577
578
579function TOniImage.LoadFromFile(filename: String): Boolean;
580begin
581 if not LoadMultiImageFromFile(filename, FImages) then
582 ShowMessage('Couldn''t load image file');
583end;
584
585
586function TOniImage.WriteToFile(filename: String): Boolean;
587begin
588 SaveMultiImageToFile(filename, FImages);
589end;
590
591
592
593function TOniImage.GetImageSize(MipMaps: Boolean): Integer;
594var
595 i: Integer;
596begin
597 if Length(FImages) > 0 then
598 begin
599 Result := FImages[0].Size;
600 if mipmaps then
601 for i := 1 to High(FImages) do
602 Result := Result + FImages[i].Size;
603 end
604 else
605 Result := -1;
606end;
607
608end.
Note: See TracBrowser for help on using the repository browser.