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 Functions;
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: TByteData;
    used:    Boolean;
  end;
const
  PartMatch: array[0..8] of Byte = (0, 3, 6, 1, 4, 7, 2, 5, 8);
var
  x, y, pixel: 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;
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.LoadFromTXMP(ConnectionID, PSpc.TXMP);
  txmpimg.DecodeImageTo32bit;
//  txmpimg.WriteToBMP('C:\file.bmp');
  txmpimg.GetAs32bit(txmpdata);
{    ShowMessage(IntToStr(txmpimg.Width)+'x'+IntToStr(txmpimg.Height));
    for i:=0 to High(txmpdata) do
      txmpimg.Data[i]:=txmpdata[i];
    txmpimg.WriteToBMP('D:\file2.bmp');
}
  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 := p2[i].X - p1[i].X + 1;
        parts[part].h := p2[i].Y - p1[i].Y + 1;
        parts[part].used := True;
        cols[col] := parts[part].w;
        rows[row] := parts[part].h;
        SetLength(parts[part].imgdata, parts[part].w * parts[part].h * 4);
        for y := 0 to parts[part].h - 1 do
        begin
          for x := 0 to parts[part].w - 1 do
          begin
            for pixel := 0 to 3 do
            begin
              parts[part].imgdata[(y * parts[part].w + x) * 4 + pixel] :=
                txmpdata[((parts[part].y_txmp + y) * txmpimg.Width +
                parts[part].x_txmp + x) * 4 + pixel];
            end;
          end;
        end;
      end
      else
      begin
        parts[part].used := False;
      end;
    end;

  end;

  txmpimg.Free;
  txmpimg := TOniImage.Create;
  for i := 0 to 8 do
  begin
    if parts[i].used then
    begin
      SetLength(txmpimg.FData, Length(parts[i].imgdata));
      for pixel := 0 to High(parts[i].imgdata) do
        txmpimg.Data[pixel] := parts[i].imgdata[pixel];
      txmpimg.Width := parts[i].w;
      txmpimg.Height    := parts[i].h;
      txmpimg.StoreType := 8;
      txmpimg.DataType  := [DT_Decoded32];
      txmpimg.Depth     := 32;
      txmpimg.WriteToBMP('M:\' + IntToStr(i) + '.bmp');
    end;
  end;
  txmpimg.Free;

  Self.FWidth  := 0;
  Self.FHeight := 0;
  for i := 0 to 2 do
  begin
    Inc(Self.FWidth, cols[i]);
    Inc(Self.FHeight, rows[i]);
  end;
  SetLength(Self.FData, Self.FWidth * Self.FHeight * 4);

  //Combine data parts

  Self.FDepth     := 32;
  Self.FStoreType := 8;
  Self.FDataType  := [DT_Decoded32];
  //    Self.RevertImage;
*)
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, x2, y2, pixelid, 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:	194
Committed:	Sat May 26 18:26:48 2007 UTC (18 years, 4 months ago) by alloc
Content type:	text/x-pascal
File size:	15824 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 Functions;
51	uses Img_DDSTypes, ImagingComponents;
52
53
54	procedure TOniImage.DrawOnCanvas(Canvas: TCanvas; Index: Integer);
55	var
56	singleimg: TImageData;
57	rect: TRect;
58	begin
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);
70	end;
71
72
73
74	constructor TOniImage.Create;
75	begin
76	end;
77
78
79
80	procedure TOniImage.Free;
81	begin
82	FreeImagesInArray(FImages);
83	end;
84
85
86
87
88	function TOniImage.GetImage(MipGen: Integer): TImageData;
89	begin
90	if MipGen <= Length(FImages) then
91	begin
92	InitImage(Result);
93	CloneImage(FImages[MipGen-1], Result);
94	end;
95	end;
96
97
98
99	function TOniImage.GetWidth(MipGen: Integer): Integer;
100	begin
101	if MipGen <= Length(FImages) then
102	Result := FImages[MipGen-1].Width
103	else
104	Result := -1;
105	end;
106
107
108	function TOniImage.GetHeight(MipGen: Integer): Integer;
109	begin
110	if MipGen <= Length(FImages) then
111	Result := FImages[MipGen-1].Height
112	else
113	Result := -1;
114	end;
115
116
117	function TOniImage.GetImageFormat: TImageFormat;
118	begin
119	if Length(FImages) > 0 then
120	Result := FImages[0].Format
121	else
122	Result := ifUnknown;
123	end;
124
125	procedure TOniImage.SetImageFormat(Format: TImageFormat);
126	var
127	i: Integer;
128	begin
129	if Length(FImages) > 0 then
130	for i := 0 to High(FImages) do
131	ConvertImage(FImages[i], Format);
132	end;
133
134
135	function TOniImage.pGetImageFormatInfo: TImageFormatInfo;
136	begin
137	if Length(FImages) > 0 then
138	GetImageFormatInfo(FImages[0].Format, Result);
139	end;
140
141
142	function TOniImage.GetHasMipMaps: Boolean;
143	begin
144	Result := Length(FImages) > 1;
145	end;
146
147
148	function TOniImage.Load(ConnectionID, FileID: Integer): Boolean;
149	var
150	FileInfo: TFileInfo;
151	begin
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;
161	end;
162
163
164
165
166	function TOniImage.LoadFromPSpc(ConnectionID, FileID: Integer): Boolean;
167	type
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;
185	const
186	PartMatch: array[0..8] of Byte = (0, 3, 6, 1, 4, 7, 2, 5, 8);
187	var
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;
200	begin
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	*)
305	end;
306
307
308
309
310	function TOniImage.LoadFromTXMP(ConnectionID, FileID: Integer): Boolean;
311	var
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;
321	begin
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;
460	end;
461
462
463
464
465	function TOniImage.LoadFromTXMB(ConnectionID, FileID: Integer): Boolean;
466	var
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;
475	begin
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;
510	end;
511
512
513
514	procedure TOniImage.SaveDataToStream(MipMaps: Boolean; var Target: TStream);
515	var
516	images: TDynImageDataArray;
517	mem: TMemoryStream;
518	i: Integer;
519	begin
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);
565	end;
566
567
568	function TOniImage.LoadFromFile(filename: String): Boolean;
569	begin
570	if not LoadMultiImageFromFile(filename, FImages) then
571	ShowMessage('Couldn''t load image file');
572	end;
573
574
575	function TOniImage.WriteToFile(filename: String): Boolean;
576	begin
577	SaveMultiImageToFile(filename, FImages);
578	end;
579
580
581
582	function TOniImage.GetImageSize(MipMaps: Boolean): Integer;
583	var
584	i: Integer;
585	begin
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;
595	end;
596
597	end.