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 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 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], 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.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);
  result := LoadMultiImageFromStream(data, FImages);
  data.Free;

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