source: oup/current/Global/OniImgClass.pas@ 194

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