// // The graphics GaLaXy Engine. The unit of GXScene // unit Formatx.DDSImage; (* Alternative for DDS unit with more supported formats of flat image: Alpha8, Luminance8, R3G3B2, RGB5A1, RGBA4, Alpha8Luminance8, Luminance16, R5G6B5, RGB8, R10G10B10A2, RGBA8, RGBA16, R16F, RGBA16F, R32F, RGBA32F, GR16, GR16F, GR32F, Compressed RGB S3TC DXT1, Compressed RGBA S3TC DXT1, Compressed RGBA S3TC DXT3, Compressed RGBA S3TC DXT5 But it down color to RGBA8 because becomes to TBitmap Good for preview picture in OpenDialog, so you may include both DDSImage (preview) and GLFileDDS (loading) *) interface {$I Stage.Defines.inc} uses Winapi.OpenGL, Winapi.Windows, System.Classes, System.SysUtils, FMX.Graphics, FMX.Types, Stage.VectorGeometry, Stage.TextureFormat, GXS.Graphics, GXS.Context, GXS.FileDDS, Formatx.DXTC; type TDDSImage = class(TBitmap) public procedure LoadFromStream(stream: TStream); //override; -> E2170 Cannot override a non-virtual method override; procedure SaveToStream(stream: TStream); //override; -> E2170 Cannot override a non-virtual method override; end; EDDSException = class(Exception); implementation //------------------------------------------------------------- // ------------------ // ------------------ TDDSImage ------------------ // ------------------ procedure TDDSImage.LoadFromStream(stream: TStream); var FullDDS: TgxDDSImage; DDSImage: TDDSImage; // added to replace Scanline in FMX BitmapData: TBitmapData; bCubeMap: Boolean; src, dst: PGLubyte; y: integer; begin FullDDS := TgxDDSImage.Create; DDSImage := TDDSImage.Create; try FullDDS.LoadFromStream(stream); DDSImage.LoadFromStream(stream); except FullDDS.Free; DDSImage.Free; raise; end; bCubeMap := FullDDS.CubeMap; FullDDS.Narrow; // TODO : E2129 Cannot assign to a read-only property (*PixelFormat := glpf32bit;*) // TODO : E2064 Left side cannot be assigned to (*Transparent := True; *) Width := FullDDS.LevelWidth[0]; Height := FullDDS.LevelHeight[0]; src := PGLubyte(FullDDS.Data); if bCubeMap then for y := 0 to Height - 1 do begin DDSImage.Map(TMapAccess.ReadWrite, BitmapData); dst := BitmapData.GetScanline(y); BGRA32ToRGBA32(src, dst, Width); Inc(src, Width * 4); end else for y := 0 to Height - 1 do begin DDSImage.Map(TMapAccess.ReadWrite, BitmapData); dst := BitmapData.GetScanline(Height - 1 - y); BGRA32ToRGBA32(src, dst, Width); Inc(src, Width * 4); end; FullDDS.Free; DDSImage.Free; end; procedure TDDSImage.SaveToStream(stream: TStream); const Magic: array[0..3] of AnsiChar = 'DDS '; var header: TDDSHeader; rowSize: integer; i: Integer; begin FillChar(header, SizeOf(TDDSHeader), 0); header.magic := cardinal(Magic); with header.SurfaceFormat do begin dwSize := sizeof(TDDSURFACEDESC2); dwFlags := DDSD_CAPS + DDSD_PIXELFORMAT + DDSD_WIDTH + DDSD_HEIGHT + DDSD_PITCH; dwWidth := Width; dwHeight := Height; ddpf.dwSize := sizeof(TDDPIXELFORMAT); case PixelFormat of TPixelFormat.RGBA: begin ddpf.dwFlags := DDPF_RGB; ddpf.dwRGBBitCount := 32; ddpf.dwRBitMask := $00FF0000; ddpf.dwGBitMask := $0000FF00; ddpf.dwBBitMask := $000000FF; if Transparent=1 then begin ddpf.dwFlags := ddpf.dwFlags + DDPF_ALPHAPIXELS; ddpf.dwRGBAlphaBitMask := $FF000000; end; end; else raise EDDSException.Create('Unsupported pixel format'); end; rowSize := (ddpf.dwRGBBitCount div 8) * dwWidth; dwPitchOrLinearSize := dwHeight * cardinal(rowSize); dwCaps := DDSCAPS_TEXTURE; stream.Write(header, SizeOf(TDDSHeader)); for i := 0 to Height - 1 do // TODO : E2003 Undeclared identifier: 'ScanLine' (* stream.Write(ScanLine[i]^, rowSize);*) end; end; initialization // ------------------------------------------------------------- // TODO : E2003 Undeclared identifier: 'RegisterFileFormat' (* TPicture.RegisterFileFormat( 'dds', 'Microsoft DirectDraw Surface', TDDSImage); *) finalization // -------------------------------------------------------------- // TODO : E2003 Undeclared identifier: 'UnregisterGraphicClass' (* TPicture.UnregisterGraphicClass(TDDSImage); *) end.