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

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