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 Load(ConnectionID, FileID: Integer): Boolean;
    function LoadFromPSpc(ConnectionID, FileID: Integer): Boolean;
    function LoadFromTXMP(ConnectionID, FileID: Integer): Boolean;
    function LoadFromTXMB(ConnectionID, FileID: Integer): Boolean;

    procedure SaveDataToStream(MipMaps: Boolean; var Target: TStream);

    function LoadFromFile(filename: String): Boolean;
    function WriteToFile(filename: String): Boolean;

    procedure DrawOnCanvas(Canvas: TCanvas; Index: Integer);
    function GetImageSize(MipMaps: Boolean): Integer;
  published
  end;


implementation

uses Img_DDSTypes, ImagingComponents;


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;


constructor TOniImage.Create;
begin
end;


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


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;


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.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;
//  txmpdata: TByteData;

  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;

  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);
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 := True;
  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);
//  data.SaveToFile('m:\test.txmp');

  data.Seek(0, soFromBeginning);
  result := LoadMultiImageFromStream(data, FImages);
  data.Free;
{
  if result then
  begin
    for i := 0 to High(FImages) do
    begin
      data := TMemoryStream.Create;
      data.Write(FImages[i].Bits^, FImages[i].Size);
      data.Seek(0, soFromBeginning);
      data.SaveToFile('m:\test.txmp.'+IntToStr(i));
      data.Free;
    end;
  end;
}
  if not result then
  begin
    ShowMessage('Error while loading file' + #13#10 + DetermineStreamFormat(data));
//    data.SaveToFile('m:\prob.dds');
  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
  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);
    SetLength(FImages, 1);
    NewImage(width, height, ifA1R5G5B5, FImages[0]);
  end;
  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[0].Width;
      for i := 0 to y do
        if i < y then
          y_start := y_start + images[i].Image[0].Height;
      CopyRect(images[imgid].Image[0], 0, 0, images[imgid].Image[0].Width,
          images[imgid].Image[0].Height, FImages[0], x_start, y_start);
    end;
  end;
  for i := 0 to linkcount - 1 do
    images[i].Free;
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(0, soFromBeginning);
//  mem.SaveToFile('m:\dds.dds');

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


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


function TOniImage.WriteToFile(filename: String): Boolean;
begin
  SaveMultiImageToFile(filename, 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;

end.
Revision:	199
Committed:	Sat May 26 20:41:34 2007 UTC (18 years, 4 months ago) by alloc
Content type:	text/x-pascal
File size:	16170 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	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
48	implementation
49
50	uses Img_DDSTypes, ImagingComponents;
51
52
53	procedure TOniImage.DrawOnCanvas(Canvas: TCanvas; Index: Integer);
54	var
55	singleimg: TImageData;
56	rect: TRect;
57	begin
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);
69	end;
70
71
72
73	constructor TOniImage.Create;
74	begin
75	end;
76
77
78
79	procedure TOniImage.Free;
80	begin
81	FreeImagesInArray(FImages);
82	end;
83
84
85
86
87	function TOniImage.GetImage(MipGen: Integer): TImageData;
88	begin
89	if MipGen <= Length(FImages) then
90	begin
91	InitImage(Result);
92	CloneImage(FImages[MipGen-1], Result);
93	end;
94	end;
95
96
97
98	function TOniImage.GetWidth(MipGen: Integer): Integer;
99	begin
100	if MipGen <= Length(FImages) then
101	Result := FImages[MipGen-1].Width
102	else
103	Result := -1;
104	end;
105
106
107	function TOniImage.GetHeight(MipGen: Integer): Integer;
108	begin
109	if MipGen <= Length(FImages) then
110	Result := FImages[MipGen-1].Height
111	else
112	Result := -1;
113	end;
114
115
116	function TOniImage.GetImageFormat: TImageFormat;
117	begin
118	if Length(FImages) > 0 then
119	Result := FImages[0].Format
120	else
121	Result := ifUnknown;
122	end;
123
124	procedure TOniImage.SetImageFormat(Format: TImageFormat);
125	var
126	i: Integer;
127	begin
128	if Length(FImages) > 0 then
129	for i := 0 to High(FImages) do
130	ConvertImage(FImages[i], Format);
131	end;
132
133
134	function TOniImage.pGetImageFormatInfo: TImageFormatInfo;
135	begin
136	if Length(FImages) > 0 then
137	GetImageFormatInfo(FImages[0].Format, Result);
138	end;
139
140
141	function TOniImage.GetHasMipMaps: Boolean;
142	begin
143	Result := Length(FImages) > 1;
144	end;
145
146
147	function TOniImage.Load(ConnectionID, FileID: Integer): Boolean;
148	var
149	FileInfo: TFileInfo;
150	begin
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;
160	end;
161
162
163
164
165	function TOniImage.LoadFromPSpc(ConnectionID, FileID: Integer): Boolean;
166	type
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;
184	const
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;
188	var
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;
203	begin
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);
316	end;
317
318
319
320
321	function TOniImage.LoadFromTXMP(ConnectionID, FileID: Integer): Boolean;
322	var
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;
332	begin
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;
471	end;
472
473
474
475
476	function TOniImage.LoadFromTXMB(ConnectionID, FileID: Integer): Boolean;
477	var
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;
486	begin
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;
521	end;
522
523
524
525	procedure TOniImage.SaveDataToStream(MipMaps: Boolean; var Target: TStream);
526	var
527	images: TDynImageDataArray;
528	mem: TMemoryStream;
529	i: Integer;
530	begin
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);
576	end;
577
578
579	function TOniImage.LoadFromFile(filename: String): Boolean;
580	begin
581	if not LoadMultiImageFromFile(filename, FImages) then
582	ShowMessage('Couldn''t load image file');
583	end;
584
585
586	function TOniImage.WriteToFile(filename: String): Boolean;
587	begin
588	SaveMultiImageToFile(filename, FImages);
589	end;
590
591
592
593	function TOniImage.GetImageSize(MipMaps: Boolean): Integer;
594	var
595	i: Integer;
596	begin
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;
606	end;
607
608	end.