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.