current/Global/OniImgClass.pas

unit OniImgClass;

interface

uses Math, Dialogs, Types, SysUtils, Classes, Data, ConnectionManager, TypeDefs,
  Imaging, ImagingTypes, Graphics;


type
  TOniImage = class
  private
    FImages: TDynImageDataArray;
    function GetImage(MipGen: Integer): TImageData;
    function GetWidth(MipGen: Integer): Integer;
    function GetHeight(MipGen: Integer): Integer;
    function GetImageFormat: TImageFormat;
    procedure SetImageFormat(Format: TImageFormat);
    function pGetImageFormatInfo: TImageFormatInfo;
    function GetHasMipMaps: Boolean;
  protected
  public
    property Images: TDynImageDataArray         read FImages;
    property Image[MipGen: Integer]: TImageData read GetImage;
    property Width[MipGen: Integer]: Integer    read GetWidth;
    property Height[MipGen: Integer]: Integer   read GetHeight;
    property Format: TImageFormat read GetImageFormat write SetImageFormat;
    property FormatInfo: TImageFormatInfo read pGetImageFormatInfo;
    property HasMipMaps: Boolean read GetHasMipMaps;

    constructor Create;
    procedure Free;

    function GetImageSize(MipMaps: Boolean): Integer;

    function LoadFromFile(filename: String): Boolean;
    function WriteToFile(filename: String): Boolean;
    procedure SaveDataToStream(MipMaps: Boolean; var Target: TStream);
    procedure DrawOnCanvas(Canvas: TCanvas; Index: Integer);

    function Load(ConnectionID, FileID: Integer): Boolean;
    function LoadFromTXMP(ConnectionID, FileID: Integer): Boolean;
    function LoadFromTXMB(ConnectionID, FileID: Integer): Boolean;
    function LoadFromPSpc(ConnectionID, FileID: Integer): Boolean;
  published
  end;


implementation

uses Img_DDSTypes, ImagingComponents;


function TOniImage.GetImage(MipGen: Integer): TImageData;
begin
  if MipGen <= Length(FImages) then
  begin
    InitImage(Result);
    CloneImage(FImages[MipGen-1], Result);
  end;
end;


function TOniImage.GetWidth(MipGen: Integer): Integer;
begin
  if MipGen <= Length(FImages) then
    Result := FImages[MipGen-1].Width
  else
    Result := -1;
end;


function TOniImage.GetHeight(MipGen: Integer): Integer;
begin
  if MipGen <= Length(FImages) then
    Result := FImages[MipGen-1].Height
  else
    Result := -1;
end;


function TOniImage.GetImageFormat: TImageFormat;
begin
  if Length(FImages) > 0 then
    Result := FImages[0].Format
  else
    Result := ifUnknown;
end;

procedure TOniImage.SetImageFormat(Format: TImageFormat);
var
  i: Integer;
begin
  if Length(FImages) > 0 then
    for i := 0 to High(FImages) do
      ConvertImage(FImages[i], Format);
end;


function TOniImage.pGetImageFormatInfo: TImageFormatInfo;
begin
  if Length(FImages) > 0 then
    GetImageFormatInfo(FImages[0].Format, Result);
end;


function TOniImage.GetHasMipMaps: Boolean;
begin
  Result := Length(FImages) > 1;
end;


constructor TOniImage.Create;
begin
end;

procedure TOniImage.Free;
begin
  FreeImagesInArray(FImages);
end;


function TOniImage.GetImageSize(MipMaps: Boolean): Integer;
var
  i: Integer;
begin
  if Length(FImages) > 0 then
  begin
    Result := FImages[0].Size;
    if mipmaps then
      for i := 1 to High(FImages) do
        Result := Result + FImages[i].Size;
  end
  else
    Result := -1;
end;


function TOniImage.LoadFromFile(filename: String): Boolean;
begin
  Result := LoadMultiImageFromFile(filename, FImages);
  if not Result then
    ShowMessage('Couldn''t load image file');
end;


function TOniImage.WriteToFile(filename: String): Boolean;
begin
  Result := SaveMultiImageToFile(filename, FImages);
end;


procedure TOniImage.DrawOnCanvas(Canvas: TCanvas; Index: Integer);
var
  singleimg: TImageData;
  rect: TRect;
begin
  InitImage(singleimg);
  CloneImage(FImages[Index-1], singleimg);
  ConvertImage(singleimg, ifX8R8G8B8);
  rect.Left := 0;
  rect.Top := 0;
  rect.Right := singleimg.Width - 1;
  rect.Bottom := singleimg.Height - 1;
  Canvas.Brush.Color := $C8D0D4;
  Canvas.FillRect(Canvas.ClipRect);
  DisplayImageData(Canvas, rect, singleimg, rect);
  FreeImage(singleimg);
end;


procedure TOniImage.SaveDataToStream(MipMaps: Boolean; var Target: TStream);
var
  images: TDynImageDataArray;
  mem: TMemoryStream;
  i: Integer;
begin
  if Length(FImages) = 0 then
    Exit;
  if MipMaps then
  begin
    if Length(FImages) = 1 then
    begin
      if not GenerateMipMaps(FImages[0], 0, images) then
      begin
        ShowMessage('Could not generate MipMaps');
        Exit;
      end;
    end
    else
    begin
      SetLength(images, Length(FImages));
      for i := 0 to High(FImages) do
        CloneImage(FImages[i], images[i]);
    end;
    mem := TMemoryStream.Create;
    if not SaveMultiImageToStream('dds', mem, images) then
    begin
      ShowMessage('Could not save images to stream');
      Exit;
    end;
    FreeImagesInArray(images);
  end
  else
  begin
    mem := TMemoryStream.Create;
    if not SaveImageToStream('dds', mem, FImages[0]) then
    begin
      ShowMessage('Could not save image to stream');
      Exit;
    end;
  end;
  if not Assigned(Target) then
    Target := TMemoryStream.Create;

  mem.Seek(128, soFromBeginning);
  Target.CopyFrom(mem, mem.Size - 128);
  mem.Free;
  Target.Seek(0, soFromBeginning);
end;


function TOniImage.Load(ConnectionID, FileID: Integer): Boolean;
var
  FileInfo: TFileInfo;
begin
  FileInfo := ConManager.Connection[ConnectionID].GetFileInfo(fileid);
  if FileInfo.Extension = 'PSpc' then
    Result := LoadFromPSpc(ConnectionID, fileid)
  else if FileInfo.Extension = 'TXMB' then
    Result := LoadFromTXMB(ConnectionID, fileid)
  else if FileInfo.Extension = 'TXMP' then
    Result := LoadFromTXMP(ConnectionID, fileid)
  else
    Result := False;
end;


function TOniImage.LoadFromTXMP(ConnectionID, FileID: Integer): Boolean;
var
  img_addr: Integer;
  data: TMemoryStream;
  hdr: TDDSDXTHeader;
  imginfo: Integer;
  x,y, i: Integer;

  _width, _height: Word;
  _storetype: Byte;
  _depth: Byte;
begin
  Result := False;
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $8C, SizeOf(_width), @_width);
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $8E, SizeOf(_height), @_height);
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $90, SizeOf(_storetype), @_storetype);
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $88, SizeOf(imginfo), @imginfo);
  if ConManager.Connection[ConnectionID].DataOS = DOS_WIN then
    ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $9C, SizeOf(img_addr), @img_addr)
  else
    ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $A0, SizeOf(img_addr), @img_addr);

  case _storetype of
    0, 1, 2:
      _depth := 16;
    7, 8:
      _depth := 32;
    9:
      _depth := 16;
    else
      Result := False;
      Exit;
  end;

  with hdr do
  begin
    FOURCC := 'DDS ';
    with SURFACEDESC2 do
    begin
      Size := 124;
      Flags := DDSD_CAPS or DDSD_PIXELFORMAT or DDSD_WIDTH or DDSD_HEIGHT;
      if _storetype = 9 then
        Flags := Flags or DDSD_LINEARSIZE
      else
        Flags := Flags or DDSD_PITCH;
      if (imginfo and $01) > 0 then
        Flags := Flags or DDSD_MIPMAPCOUNT;
      Height := _height;
      Width := _width;
      if _storetype = 9 then
        PitchOrLinearSize := width * height div 2
      else
        PitchOrLinearSize := width * _depth div 8;
      Depth := 0;
      MipMapCount := 1;
      if (imginfo and $01) > 0 then
      begin
        x := width;
        y := height;
        while (x > 1) and (y > 1) do
        begin
          x := x div 2;
          y := y div 2;
          Inc(MipMapCount);
        end;
      end;
      for i := 1 to 11 do
        Reserved[i] := 0;
      with PIXELFORMAT do
      begin
        Size := 32;
        if _storetype = 9 then
          Flags := DDPF_FOURCC
        else
          Flags := DDPF_RGB;
        if _storetype in [0, 2] then
          Flags := Flags or DDPF_ALPHAPIXELS;
        if _storetype = 9 then
          FOURCC := 'DXT1'
        else
        begin
          RGBBitCount := _depth;
          case _storetype of
            0: begin
              RBitMask := $0F00;
              GBitMask := $00F0;
              BBitMask := $000F;
              AlphaBitMask := $F000;
            end;
            1, 2: begin
              RBitMask := $7C00;
              GBitMask := $03E0;
              BBitMask := $001F;
              if _storetype = 2 then
                AlphaBitMask := $8000
              else
                AlphaBitMask := $0000;
            end;
            8: begin
              RBitMask := $00FF0000;
              GBitMask := $0000FF00;
              BBitMask := $000000FF;
              AlphaBitMask := $00000000;
            end;
          end;
        end;
      end;
      with DDSCAPS2 do
      begin
        Caps1 := DDSCAPS_TEXTURE;
        if (imginfo and $01) > 0 then
          Caps1 := Caps1 or DDSCAPS_COMPLEX or DDSCAPS_MIPMAP;
        Caps2 := 0;
        Reserved[1] := 0;
        Reserved[2] := 0;
      end;
    end;
  end;

  data := TMemoryStream.Create;
  data.Write(hdr, SizeOf(hdr));
  if ConManager.Connection[ConnectionID].DataOS = DOS_WIN then
    ConManager.Connection[ConnectionID].LoadRawFile(fileid, $9C, TStream(data))
  else
    ConManager.Connection[ConnectionID].LoadRawFile(fileid, $A0, TStream(data));

  data.Seek(0, soFromBeginning);
  Result := LoadMultiImageFromStream(data, FImages);
  data.Free;

  if not result then
  begin
    ShowMessage('Error while loading file' + #13#10 + DetermineStreamFormat(data));
  end;
end;


function TOniImage.LoadFromTXMB(ConnectionID, FileID: Integer): Boolean;
var
  i, x, y, imgid: Integer;
  rows, cols: Word;
  linkcount: Integer;
  link: Integer;
  images: array of TOniImage;
  x_start, y_start: Integer;

  width, height: Word;
begin
  Result := False;
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $10, SizeOf(width), @width);
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $12, SizeOf(height), @height);
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $18, SizeOf(cols), @cols);
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $1A, SizeOf(rows), @rows);
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $1C, SizeOf(linkcount), @linkcount);
  SetLength(images, linkcount);
  for i := 0 to linkcount - 1 do
  begin
    ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $20 + i * 4, SizeOf(link), @link);
    link := link div 256;
    images[i] := TOniImage.Create;
    images[i].LoadFromTXMP(ConnectionID, link);
  end;
  SetLength(FImages, 1);
  NewImage(width, height, images[0].Format {ifA1R5G5B5}, FImages[0]);
  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 < x then
          x_start := x_start + images[i].Image[1].Width;
      for i := 0 to y do
        if i < y then
          y_start := y_start + images[i].Image[1].Height; 
      CopyRect(images[imgid].Image[1], 0, 0, images[imgid].Image[1].Width,
          images[imgid].Image[1].Height, FImages[0], x_start, y_start);
    end;
  end;
  for i := 0 to linkcount - 1 do
    images[i].Free;
  Result := True;
end;


function TOniImage.LoadFromPSpc(ConnectionID, FileID: Integer): Boolean;
type
  TPoint = packed record
    X, Y: Word;
  end;

  TPSpc = packed record
    p1:   array[0..8] of TPoint;
    p2:   array[0..8] of TPoint;
    TXMP: Integer;
  end;

  TPart = packed record
    x_txmp, y_txmp: Word;
    x_pspc, y_pspc: Word;
    w, h:    Word;
    imgdata: TImageData;
    used:    Boolean;
  end;
const
  PartMatch: array[0..8] of Byte = (0, 3, 6, 1, 4, 7, 2, 5, 8);
  stretch_x: Integer = 1;
  stretch_y: Integer = 1;
var
  x, y: Word;
  i: Integer;

  PSpc:     TPSpc;
  txmpimg:  TOniImage;

  parts:    array[0..8] of TPart;
  part:     Byte;
  cols:     array[0..2] of Word;
  rows:     array[0..2] of Word;
  col, row: Byte;

  pspcimage: TImageData;
begin
  ConManager.Connection[ConnectionID].LoadDatFilePart(fileid, $08, SizeOf(PSpc), @PSpc);
  PSpc.TXMP := PSpc.TXMP div 256;
  if PSpc.TXMP = 0 then
  begin
    Result := False;
    Exit;
  end;
  txmpimg := TOniImage.Create;
  txmpimg.Load(ConnectionID, PSpc.TXMP);
  CloneImage(txmpimg.Image[1], pspcimage);
  txmpimg.Free;

  Result := False;

  with pspc do
  begin
    for i := 0 to 2 do
    begin
      cols[i] := 0;
      rows[i] := 0;
    end;
    for i := 0 to 8 do
    begin
      part := PartMatch[i];
      col  := i div 3;
      row  := i mod 3;
      if (p2[i].X > 0) or (p2[i].Y > 0) then
      begin
        parts[part].x_txmp := p1[i].X;// - 1;
        parts[part].y_txmp := p1[i].Y;// - 1;
        parts[part].x_pspc := 0;
        if col > 0 then
          for x := 0 to col - 1 do
            Inc(parts[part].x_pspc, cols[x]);
        parts[part].y_pspc := 0;
        if row > 0 then
          for y := 0 to row - 1 do
            Inc(parts[part].y_pspc, rows[y]);
        parts[part].w := Max(p2[i].X - p1[i].X, 1);// + 1;
        parts[part].h := Max(p2[i].Y - p1[i].Y, 1);// + 1;
        parts[part].used := True;
        cols[col] := parts[part].w;
        rows[row] := parts[part].h;

        NewImage(parts[part].w, parts[part].h, pspcimage.Format, parts[part].imgdata);

        CopyRect(pspcimage,
            parts[part].x_txmp, parts[part].y_txmp, parts[part].w, parts[part].h,
            parts[part].imgdata, 0, 0);
      end
      else
      begin
        parts[part].used := False;
      end;
    end;

  end;

  for i := 0 to 8 do
  begin
    if parts[i].used then
    begin
//      SaveImageToFile('M:\' + IntToStr(i) + '.bmp', parts[i].imgdata);
    end;
  end;

  SetLength(FImages, 1);
  x := cols[0] + cols[1] * stretch_x + cols[2];
  y := rows[0] + rows[1] * stretch_y + rows[2];

  NewImage(x, y, pspcimage.Format, FImages[0]);

  x := 0;
  for col := 0 to 2 do
  begin
    y := 0;
    for row := 0 to 2 do
    begin
      part := row*3 + col;
      if parts[part].used then
      begin
        if (row = 1) and (col = 1) then
          StretchRect(parts[part].imgdata, 0, 0, parts[part].w, parts[part].h,
              FImages[0], x, y, parts[part].w * stretch_x, parts[part].h * stretch_y, rfNearest)
        else
        if (row = 1) then
          StretchRect(parts[part].imgdata, 0, 0, parts[part].w, parts[part].h,
              FImages[0], x, y, parts[part].w, parts[part].h * stretch_y, rfNearest)
        else
        if (col = 1) then
          StretchRect(parts[part].imgdata, 0, 0, parts[part].w, parts[part].h,
              FImages[0], x, y, parts[part].w * stretch_x, parts[part].h, rfNearest)
        else
          CopyRect(parts[part].imgdata, 0, 0, parts[part].w, parts[part].h,
              FImages[0], x, y );
        if row = 1 then
          y := y + parts[part].h * stretch_y
        else
          y := y + parts[part].h;
      end;
    end;
    if cols[col] > 0 then
    begin
      if (col = 1) then
        x := x + parts[part].w * stretch_x
      else
        x := x + parts[part].w;
    end;
  end;

  FreeImage(pspcimage);
  for i := 0 to 8 do
    if parts[i].used then
      FreeImage(parts[i].imgdata);

  Result := True;
end;

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