//DJXTextures v1.4
unit DJXTextures;

interface

uses
  Classes,
  Windows,
  Graphics,
  SysUtils,
  Math,
  JPEG,
  DJXClasses,
  Direct3D9,
  D3DX9;

type
  TDJXTextureList = class;
  TDJXTexture = class;

  TDJXTexture = class (TObject)
  private
    m_Name: string;
    m_DanJetX: Pointer;
    m_Texture: IDirect3DTexture9;
    m_DepthStencil: IDirect3DSurface9;
    m_RealWidth: integer;
    m_RealHeight: integer;
    m_Height: integer;
    m_Width: integer;
    m_PW: integer;
    m_PH: integer;
    m_TransparentColor: TColor;
    m_SurfaceDesc: TD3DSURFACE_DESC;
    m_SurfaceRect: TD3DLOCKED_RECT;
    m_Locked: boolean;
    m_Levels: integer;
    m_RenderTarget: boolean;
    m_AutoDepthStencil: boolean;
  protected
    function GetRealWidth: integer;
    function GetRealHeight: integer;
    function GetPixel(X,Y: integer): TDJXColor;
    procedure SetPixel(X,Y: integer; Value: TDJXColor);
    procedure LoadError;
  public
    constructor Create(Name: string; DanJetX: Pointer);
    destructor Destroy; override;
    property Name: string read m_Name write m_Name;
    property Texture: IDirect3DTexture9 read m_Texture;
    property DepthStencil: IDirect3DSurface9 read m_DepthStencil;
    property RealWidth: integer read m_RealWidth;
    property RealHeight: integer read m_RealHeight;
    property Width: integer read m_Width write m_Width;
    property Height: integer read m_Height write m_Height;
    property PatternWidth: integer read m_PW write m_PW;
    property PatternHeight: integer read m_PH write m_PH;
    property TransparentColor: Tcolor read m_TransparentColor write m_TransparentColor;
    property Pixels[X,Y: integer]: TDJXColor read GetPixel write SetPixel;
    procedure TexLock(Level: byte = 0);
    procedure TexUnLock(Level: byte = 0);
    procedure Assign(Source: TDJXTexture);
    procedure LoadFromFile(
      f: string;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
    procedure LoadFromPicture(
      p: TPicture;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
    procedure LoadFromGraphic(
      p: TGraphic;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
    procedure LoadFromStream(
      Stream: TMemoryStream;
      Size: DWORD;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
    procedure LoadFromBuffer(
      Buffer: Pointer;
      Size: DWORD;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
    procedure LoadFromRes(
      const ResName: string;
      const Folder: string;
      const Res: string;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
    procedure MakeRenderTarget(
      TexWidth, TexHeight: integer;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
    procedure MakeTexture(
      TexWidth, TexHeight: integer;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
    procedure Release;
    procedure GenerateMipMaps;
    procedure DrawBillboard(
      x, y, z: single;
      x1, y1, x2, y2, x3, y3, x4, y4: single;
      col1, col2, col3, col4: TDJXColor;
      Rotation, ScaleX, ScaleY: single;
      ImageIndex: integer = 0;
      TileWidth: integer = 0; TileHeight: integer = 0
    );
    procedure DrawBillboardCyl(
      p1x, p1y, p1z: single;
      p2x, p2y, p2z: single;
      r1, r2: single;
      col1, col2, col3, col4: TDJXColor;
      Scale: single;
      ImageIndex: integer = 0;
      TileWidth: integer = 0; TileHeight: integer = 0
    );
    procedure Draw(
      x, y: double;
      Color: TDJXColor;
      ImageIndex: integer = 0;
      TileWidth: integer = 0; TileHeight: integer = 0
    ); overload;
    procedure Draw(
      x, y: double;
      Color: TDJXColor;
      CenterX, CenterY, Rotation, ScaleX, ScaleY: single;
      FlipTopBottom: boolean = false;
      FlipLeftRight: boolean = false;
      ImageIndex: integer = 0;
      TileWidth: integer = 0; TileHeight: integer = 0
    ); overload;
    procedure Draw4col(
      x1, y1, x2, y2, x3, y3, x4, y4: double;
      col1, col2, col3, col4: TDJXColor;
      ImageIndex: integer = 0;
      TileWidth: integer = 0; TileHeight: integer = 0
    ); overload;
    procedure Draw4col(
      x1, y1, x2, y2, x3, y3, x4, y4: double;
      col1, col2, col3, col4: TDJXColor;
      CenterX, CenterY, Rotation, ScaleX, ScaleY: single;
      FlipTopBottom: boolean = false;
      FlipLeftRight: boolean = false;
      ImageIndex: integer = 0;
      TileWidth: integer = 0; TileHeight: integer = 0
    ); overload;
    procedure SetToDevice(Stage: byte);
    procedure ReloadFromRenderTarget(Levels: integer = 1);
  end;

  TDJXTextureFormat = (
    TDJXTFMT_A8R8G8B8,
    TDJXTFMT_X8R8G8B8,
    TDJXTFMT_A4R4G4B4,
    TDJXTFMT_R8G8B8,
    TDJXTFMT_R5G6B5
  );
  
  TDJXTextureList = class(TDJXComponent)
  private
    m_Textures: Tlist;
    m_AutoMipMaps: boolean;
    m_AutoSwapDepthStencil: boolean;
    m_TextureFormat: TDJXTextureFormat;
  protected
    function getItem(Index: integer): TDJXTexture;
    procedure setItem(Index: integer; Value: TDJXTexture);
    function getCount: integer;
    function GetFormat: TD3DFormat;
  public
    property DanJetX: Pointer read m_DanJetX write m_DanJetX;
    property Textures[Index: integer]: TDJXTexture read getItem write setItem;
    property Count: integer read getCount;
    function Find(name: string): TDJXTexture;
    function FindIndex(name: string): integer;
    function Add(Texture: TDJXTexture): TDJXTexture;
    function Remove(Texture: TDJXTexture): TDJXTexture;
    function RemoveName(Name: string): TDJXTexture;
    function Delete(Index: integer): TDJXTexture;
    procedure FreeAndRemove(Texture: TDJXTexture);
    procedure FreeAndRemoveName(Name: string);
    procedure FreeAndDelete(Index: integer);
    procedure Clear;
    procedure FreeTextures;
    function CreateTextureFromFile(
      f: string;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
    function CreateTextureFromPicture(
      p: TPicture;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
    function CreateTextureFromGraphic(
      p: TGraphic;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
    function CreateTextureFromStream(
      Stream: TMemoryStream;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
    function CreateTextureFromBuffer(
      Buffer: Pointer;
      Size: DWORD;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
    function CreateTextureFromRes(
      ResName: string;
      Folder: string;
      Res: string;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
    function CreateRenderTargetTexture(
      Width,Height: integer;
      TextureName: string
    ): TDJXTexture;
    function CreateTexture(
      Width,Height: integer;
      TextureName: string;
      MipLevels: integer = 1
    ): TDJXTexture;
    procedure LoadFromFile(f: string);
    procedure Init(DanJetX: Pointer); override;
    procedure OnLostDevice; override;
    procedure OnResetDevice; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AutoGenerateMipMaps: boolean read m_AutoMipMaps write m_AutoMipMaps default false;
    property AutoSwapDepthStencil: boolean read m_AutoSwapDepthStencil write m_AutoSwapDepthStencil default false;
    property TextureFormat: TDJXTextureFormat read m_TextureFormat write m_TextureFormat default TDJXTFMT_A8R8G8B8;
  end;


implementation

uses
  DJX, DJXRender, DJXUtils;

//TDJXTextureList BEGIN

constructor TDJXTextureList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  m_AutoMipMaps := false;
  m_AutoSwapDepthStencil := false;
  m_TextureFormat := TDJXTFMT_A8R8G8B8;
end;
destructor TDJXTextureList.Destroy;
begin
  if m_Textures <> nil then
  begin
    FreeTextures;
    m_Textures.Free;
  end;
  inherited Destroy;
end;
procedure TDJXTextureList.Init(DanJetX: Pointer);
begin
  m_Textures := Tlist.Create;
  inherited Init(DanJetX);
end;
procedure TDJXTextureList.OnLostDevice;
var
  i: integer;
begin
  for i := 0 to m_Textures.Count - 1 do
  if TDJXTexture(m_Textures[i]).m_RenderTarget then
  safe_release(TDJXTexture(m_Textures[i]).m_Texture);
end;
procedure TDJXTextureList.OnResetDevice;
var
  i: integer;
begin
  for i := 0 to m_Textures.Count - 1 do
  if TDJXTexture(m_Textures[i]).m_RenderTarget then
  TDJXTexture(m_Textures[i]).MakeRenderTarget(
    TDJXTexture(m_Textures[i]).Width,
    TDJXTexture(m_Textures[i]).Height
  );
end;
function TDJXTextureList.getCount: integer;
begin
  result := m_Textures.Count;
end;
function TDJXTextureList.GetFormat: TD3DFormat;
begin
  result := D3DFMT_UNKNOWN;
  case m_TextureFormat of
    TDJXTFMT_A8R8G8B8: result := D3DFMT_A8R8G8B8;
    TDJXTFMT_X8R8G8B8: result := D3DFMT_X8R8G8B8;
    TDJXTFMT_A4R4G4B4: result := D3DFMT_A4R4G4B4;
    TDJXTFMT_R8G8B8: result := D3DFMT_R8G8B8;
    TDJXTFMT_R5G6B5: result := D3DFMT_R5G6B5;
  end;
end;

procedure TDJXTextureList.LoadFromFile(f: string);
type
  TFileHeader = record
    Caption: string[16];
    NumOfPictures: integer;
  end;
  TPictureInfo = record
    name: string[32];
    ext: string[4];
    offset: int64;
    width: integer;
    height: integer;
    Transparent: boolean;
    TransparentColor: TColor;
  end;
var
  FileHeader: TFileHeader;
  PicInfo: TPictureInfo;
  Stream: TFileStream;
  MStream: TMemoryStream;
  i: integer;
  PicBin: array of byte;
  Ext: string;
  Texture: TDJXTexture;
begin
  if not fileExists(f) then exit;
  Stream := TFileStream.Create(f, fmOpenRead);
  Stream.Position := 0;
  Stream.ReadBuffer(FileHeader, sizeof(FileHeader));
  for i := 0 to FileHeader.NumOfPictures - 1 do
  begin
    Stream.ReadBuffer(PicInfo, sizeof(PicInfo));
    setLength(PicBin, PicInfo.offset);

    MStream := TMemoryStream.Create;
    MStream.CopyFrom(Stream, PicInfo.offset);
    if PicInfo.Transparent then
    Texture := CreateTextureFromStream(MStream, PicInfo.name, 16, PicInfo.TransparentColor or ($ff shl 24))
    else
    Texture:=CreateTextureFromStream(MStream, PicInfo.name, 16);
    MStream.Free;

    Ext := PicInfo.ext;
    if (Ext = 'bmp') or (Ext = 'jpg') or (Ext = 'jpeg') or (Ext = 'png') then
    begin
      Texture.Width := PicInfo.width;
      Texture.Height := PicInfo.height;
    end;
  end;
  Stream.Free;
end;
function TDJXTextureList.Find(name: string): TDJXTexture;
var
  i: integer;
begin
  for i := 0 to m_Textures.Count - 1 do
  if TDJXTexture(m_Textures.Items[i]).Name = name then
  begin
    result := TDJXTexture(m_Textures.Items[i]);
    exit;
  end;
  result := nil;
end;
function TDJXTextureList.FindIndex(name: string): integer;
var
  i: integer;
begin
  for i := 0 to m_Textures.Count - 1 do
  if TDJXTexture(m_Textures.Items[i]).Name = name then
  begin
    result := i;
    exit;
  end;
  result := -1;
end;
function TDJXTextureList.Add(Texture: TDJXTexture): TDJXTexture;
begin
  m_Textures.Add(Texture);
  Result := Texture;
end;
function TDJXTextureList.Remove(Texture: TDJXTexture): TDJXTexture;
begin
  m_Textures.Remove(Texture);
  Result := Texture;
end;
function TDJXTextureList.RemoveName(Name: string): TDJXTexture;
var
  Texture: TDJXTexture;
begin
  Texture := Find(Name);
  m_Textures.Remove(Texture);
  Result := Texture;
end;
function TDJXTextureList.Delete(Index: integer): TDJXTexture;
begin
  Result := Textures[Index];
  m_Textures.Delete(Index);
end;
procedure TDJXTextureList.FreeAndRemove(Texture: TDJXTexture);
begin
  Remove(Texture).Free;
end;
procedure TDJXTextureList.FreeAndRemoveName(Name: string);
begin
  RemoveName(Name).Free;
end;
procedure TDJXTextureList.FreeAndDelete(Index: integer);
begin
  Delete(Index).Free;
end;
procedure TDJXTextureList.Clear;
begin
  if m_Textures <> nil then
  begin
    while m_Textures.Count > 0 do
    m_Textures.Delete(0);
  end;
end;
procedure TDJXTextureList.FreeTextures;
begin
  if m_Textures <> nil then
  begin
    while m_Textures.Count > 0 do
    begin
      TDJXTexture(m_Textures.Items[0]).Free;
      m_Textures.Delete(0);
    end;
  end;
end;
function TDJXTextureList.getItem(Index: integer): TDJXTexture;
begin
  result := TDJXTexture(m_Textures.items[Index]);
end;
procedure TDJXTextureList.setItem(Index: integer; Value: TDJXTexture);
begin
  TDJXTexture(m_Textures.items[Index]).assign(Value);
end;
function TDJXTextureList.CreateTextureFromFile(
      f: string;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
var
  Texture: TDJXTexture;
begin
  Texture := TDJXTexture.Create(TextureName, m_DanJetX);
  Add(Texture);
  Texture.TransparentColor := TransparentColor;
  Texture.LoadFromFile(f, MipLevels, GetFormat);
  if m_AutoMipMaps then Texture.GenerateMipMaps;
  Result := Texture;
end;
function TDJXTextureList.CreateTextureFromPicture(
      P: TPicture;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
var
  Texture: TDJXTexture;
begin
  Texture := TDJXTexture.create(TextureName, m_DanJetX);
  Add(Texture);
  Texture.TransparentColor := TransparentColor;
  Texture.LoadFromPicture(p, MipLevels, GetFormat);
  if m_AutoMipMaps then Texture.GenerateMipMaps;
  Result := Texture;
end;
function TDJXTextureList.CreateTextureFromGraphic(
      P: TGraphic;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
var
  Texture: TDJXTexture;
begin
  Texture := TDJXTexture.create(TextureName, m_DanJetX);
  Add(Texture);
  Texture.TransparentColor := TransparentColor;
  Texture.LoadFromGraphic(p, MipLevels, GetFormat);
  if m_AutoMipMaps then Texture.GenerateMipMaps;
  Result := Texture;
end;
function TDJXTextureList.CreateTextureFromStream(
      Stream: TMemoryStream;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
var
  Texture: TDJXTexture;
begin
  Texture := TDJXTexture.create(TextureName, m_DanJetX);
  Add(Texture);
  Texture.TransparentColor := TransparentColor;
  Texture.LoadFromStream(Stream, Stream.Size, MipLevels, GetFormat);
  if m_AutoMipMaps then Texture.GenerateMipMaps;
  Result := Texture;
end;
function TDJXTextureList.CreateTextureFromBuffer(
      Buffer: Pointer;
      Size: DWORD;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
var
  Texture: TDJXTexture;
begin
  Texture := TDJXTexture.create(TextureName, m_DanJetX);
  Add(Texture);
  Texture.TransparentColor := TransparentColor;
  Texture.LoadFromBuffer(Buffer, Size, MipLevels, GetFormat);
  if m_AutoMipMaps then Texture.GenerateMipMaps;
  Result := Texture;
end;
function TDJXTextureList.CreateTextureFromRes(
      ResName: string;
      Folder: string;
      Res: string;
      TextureName: string;
      MipLevels: integer = 1;
      TransparentColor: TDJXColor = $00000000
    ): TDJXTexture;
var
  Texture: TDJXTexture;
begin
  Texture := TDJXTexture.Create(TextureName, m_DanJetX);
  Add(Texture);
  Texture.TransparentColor := TransparentColor;
  Texture.LoadFromRes(ResName, Folder, Res, MipLevels, GetFormat);
  if m_AutoMipMaps then Texture.GenerateMipMaps;
  Result := Texture;
end;
function TDJXTextureList.CreateRenderTargetTexture(
      Width, Height: integer;
      TextureName: string
    ): TDJXTexture;
var
  Texture: TDJXTexture;
  Format: TD3DFormat;
begin
  Texture := TDJXTexture.create(TextureName, m_DanJetX);
  Add(Texture);
  Texture.MakeRenderTarget(Width, Height, GetFormat);
  Texture.m_AutoDepthStencil := m_AutoSwapDepthStencil;
  Result := Texture;
end;
function TDJXTextureList.CreateTexture(
      Width, Height: integer;
      TextureName: string;
      MipLevels: integer = 1
    ): TDJXTexture;
var
  Texture: TDJXTexture;
begin
  Texture := TDJXTexture.create(TextureName, m_DanJetX);
  Add(Texture);
  Texture.MakeTexture(Width, Height, MipLevels, GetFormat);
  Result := Texture;
end;
//TDJXTextureList END

//TDJXTexture BEGIN
constructor TDJXTexture.Create(Name: string; DanJetX: Pointer);
begin
  inherited Create;
  m_Name := Name;
  m_DanJetX := DanJetX;
  Release;
end;

destructor TDJXTexture.Destroy;
begin
  Release;
  inherited Destroy;
end;

procedure TDJXTexture.Assign(Source: TDJXTexture);
begin
  TPersistent(self).Assign(Tpersistent(Source));
end;

procedure TDJXTexture.LoadFromFile(
      f: string; Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
var
  TexDesc: TD3DSurfaceDesc;
  Usage: DWORD;
  ImageInfo: TD3DXImageInfo;
begin
  Release;
  Usage := 0;

  if FAILED(
    D3DXCreateTextureFromFileEx(
      TDanJetX(m_DanJetX).Device,
      PChar(f),
      0, 0,
      Levels,
      Usage,
      Format,
      D3DPOOL_MANAGED,
      D3DX_FILTER_NONE,
      D3DX_FILTER_NONE,
      m_TransparentColor,
      @ImageInfo, nil,
      m_Texture
    )
  ) then
  begin
    LoadError;
    Exit;
  end;

  m_Levels := Levels;

  m_Width := ImageInfo.Width;
  m_Height := ImageInfo.Height;

  m_Texture.GetLevelDesc(0, TexDesc);
  m_RealWidth := TexDesc.Width;
  m_RealHeight := TexDesc.Height;

  m_PW := m_Width;
  m_PH := m_Height;
end;

procedure TDJXTexture.LoadFromPicture(
      p: Tpicture; Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
begin
  LoadFromGraphic(p.Graphic, Levels, Format);
end;

procedure TDJXTexture.LoadFromGraphic(
      p: TGraphic;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
var
  Stream: TMemoryStream;
begin
  Stream := TMemoryStream.Create;
  p.SaveToStream(Stream);
  LoadFromStream(Stream, Stream.Size, Levels, Format);
  Stream.Free;
end;
procedure TDJXTexture.LoadFromStream(
      Stream: TMemoryStream;
      Size: DWORD;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
begin
  LoadFromBuffer(Stream.Memory, Size, Levels, Format);
end;

procedure TDJXTexture.LoadFromBuffer(
      Buffer: Pointer;
      Size: DWORD;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
var
  TexDesc: TD3DSurfaceDesc;
  Usage: DWORD;
  ImageInfo: TD3DXImageInfo;
begin
  Release;
  Usage := 0;

  if FAILED(
    D3DXCreateTextureFromFileInMemoryEx(
      TDanJetX(m_DanJetX).Device,
      Buffer,
      Size,
      0, 0,
      Levels,
      Usage,
      Format,
      D3DPOOL_MANAGED,
      D3DX_FILTER_NONE,
      D3DX_FILTER_NONE,
      m_TransparentColor,
      @ImageInfo, NIL,
      m_Texture
    )
  )then
  begin
    LoadError;
    Exit;
  end;

  m_Levels := Levels;

  m_Width := ImageInfo.Width;
  m_Height := ImageInfo.Height;

  m_Texture.GetLevelDesc(0, TexDesc);
  m_RealWidth := TexDesc.Width;
  m_RealHeight := TexDesc.Height;

  m_PW := m_Width;
  m_PH := m_Height;
end;

procedure TDJXTexture.LoadFromRes(
      const ResName: string;
      const Folder: string;
      const Res: string;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
var
  R: TDJXRes;
  ResBuffer: TDJXResBuffer;
begin
  R := TDanJetX(m_DanJetX).Resources.Find(ResName);
  if Assigned(R) then
  begin
    ResBuffer := R.GetResBuffer(Folder, Res);
    LoadFromBuffer(
      ResBuffer.Data,
      ResBuffer.Size,
      Levels,
      Format
    );
  end;
end;

procedure TDJXTexture.MakeRenderTarget(
      TexWidth, TexHeight: integer;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
var
  TexDesc: TD3DSurfaceDesc;
  Usage: DWORD;
  DepthStencilFormat: TD3DFormat;
begin
  Release;

  Usage := 0;
  Usage := Usage or D3DUSAGE_RENDERTARGET;

  m_Width := TexWidth;
  m_Height := TexHeight;
  GetRealWidth;
  GetRealHeight;

  if FAILED(
    TDanJetX(m_DanJetX).Device.CreateTexture(
      m_RealWidth,
      m_RealHeight,
      1,
      Usage,
      Format,
      D3DPOOL_DEFAULT,
      m_Texture,
      nil
    )
  ) then
  begin
    Release;
    Exit;
  end;

  if m_AutoDepthStencil then
  begin
    case TDanJetX(m_DanJetX).InitParams.DepthStencil of
      dsD16: DepthStencilFormat := D3DFMT_D16;
      dsD24S8: DepthStencilFormat := D3DFMT_D24S8;
    end;

    if FAILED(
      TDanJetX(m_DanJetX).Device.CreateDepthStencilSurface(
        m_RealWidth, m_RealHeight,
        DepthStencilFormat,
        D3DMULTISAMPLE_NONE,
        0, false,
        m_DepthStencil,
        nil
      )
    ) then
    begin
      Release;
      Exit;
    end;
  end;

  m_Levels := 1;
  m_RenderTarget := true;
end;

procedure TDJXTexture.MakeTexture(
      TexWidth, TexHeight: integer;
      Levels: integer = 8;
      Format: TD3DFormat = D3DFMT_A8R8G8B8
    );
var
  TexDesc: TD3DSurfaceDesc;
  Usage: DWORD;
  MaxLevels, UsedLevels: integer;
begin
  Release;

  MaxLevels := round(Sqrt(Min(TexWidth, TexHeight)) / 2);
  if MaxLevels < Levels then UsedLevels := MaxLevels
  else UsedLevels := Levels;

  m_Width := TexWidth;
  m_Height := TexHeight;
  GetRealWidth;
  GetRealHeight;

  Usage := 0;

  if FAILED(
    TDanJetX(m_DanJetX).Device.CreateTexture(
      m_RealWidth,
      m_RealHeight,
      UsedLevels,
      Usage,
      Format,
      D3DPOOL_MANAGED,
      m_Texture,
      nil
    )
  ) then
  begin
    Release;
    exit;
  end;
  
  m_Levels := Levels;
end;

procedure TDJXTexture.Release;
begin
  m_Levels := 0;
  m_Width := 0;
  m_Height := 0;
  m_RealWidth := 0;
  m_RealHeight := 0;
  safe_release(m_Texture);
  safe_release(m_DepthStencil);
  m_Locked := false;
  m_RenderTarget := false;
  m_AutoDepthStencil := false;
end;

procedure TDJXTexture.GenerateMipMaps;
var
  i, x, y: integer;
  Map1: array of array of TDJXColor;
  MaxWidth, MaxHeight: integer;
begin
  MaxWidth := m_RealWidth;
  MaxHeight := m_RealHeight;
  for i := 1 to m_Levels - 1 do
  begin
    if (MaxWidth shr (i - 1) < 1) or (MaxHeight shr (i - 1) < 1) then break;
    if i > 1 then
    setlength(Map1, MaxWidth shr (i - 1), MaxHeight shr (i - 1))
    else
    setlength(Map1, MaxWidth, MaxHeight);
    TexLock(i - 1);
    for y := 0 to length(Map1[0]) - 1 do
    for x := 0 to length(Map1) - 1 do
    Map1[x,y] := Pixels[x, y];
    TexUnLock(i - 1);
    TexLock(i);
    for y := 0 to length(Map1[0]) div 2 - 1 do
    for x := 0 to length(Map1) div 2 - 1 do
    Pixels[x, y] := DJXColor(
      (DJXColorR(Map1[x * 2, y * 2]) + DJXColorR(Map1[x * 2 + 1, y * 2]) + DJXColorR(Map1[x * 2, y * 2 + 1]) + DJXColorR(Map1[x * 2 + 1, y * 2 + 1])) div 4,
      (DJXColorG(Map1[x * 2, y * 2]) + DJXColorG(Map1[x * 2 + 1, y * 2]) + DJXColorG(Map1[x * 2, y * 2 + 1]) + DJXColorG(Map1[x * 2 + 1, y * 2 + 1])) div 4,
      (DJXColorB(Map1[x * 2, y * 2]) + DJXColorB(Map1[x * 2 + 1, y * 2]) + DJXColorB(Map1[x * 2, y * 2 + 1]) + DJXColorB(Map1[x * 2 + 1, y * 2 + 1])) div 4,
      (DJXColorA(Map1[x * 2, y * 2]) + DJXColorA(Map1[x * 2 + 1, y * 2]) + DJXColorA(Map1[x * 2, y * 2 + 1]) + DJXColorA(Map1[x * 2 + 1, y * 2 + 1])) div 4
    );
    TexUnlock(i);
  end;
end;

function TDJXTexture.GetRealWidth: integer;
begin
  m_RealWidth := 1;
  while (m_RealWidth < m_Width) do m_RealWidth := m_RealWidth shl 1;
  result := m_RealWidth;
end;

function TDJXTexture.GetRealHeight: integer;
begin
  m_RealHeight := 1;
  while (m_RealHeight < m_Height) do m_RealHeight := m_RealHeight shl 1;
  result := m_RealHeight;
end;

procedure TDJXTexture.TexLock(Level: byte = 0);
begin
  if (FAILED(m_Texture.GetLevelDesc(Level, m_SurfaceDesc))) then exit;
  if (FAILED(m_Texture.LockRect(Level, m_SurfaceRect, nil, 0))) then exit;
  m_Locked := true;
end;

procedure TDJXTexture.TexUnLock(Level: byte = 0);
begin
  if not m_Locked then Exit;
  m_Texture.UnlockRect(Level);
  m_Locked := false;
end;

function TDJXTexture.GetPixel(X,Y: integer): TDJXColor;
var
  t1, t2, tmp: word;
  pb: pbyte;
  r,g,b,a: byte;
begin
  Result := DJXColor(0, 0, 0, 0);
  r := 0; g := 0; b := 0; a := 255;
  if not m_Locked then exit;
  case m_SurfaceDesc.Format of
    D3DFMT_X8R8G8B8, D3DFMT_A8R8G8B8:
    begin
      pb := pbyte(longint(m_SurfaceRect.pBits) + y * m_SurfaceRect.pitch + x * 4);
      b  := pb^; inc(pb);
      g  := pb^; inc(pb);
      r  := pb^; inc(pb);
      a  := pb^;
    end;
    D3DFMT_R8G8B8:
    begin
      pb := pbyte(longint(m_SurfaceRect.pBits) + y * m_SurfaceRect.pitch + x * 3);
      b  := pb^; inc(pb);
      g  := pb^; inc(pb);
      r  := pb^;
    end;
    D3DFMT_A4R4G4B4:
    begin
      pb := pbyte(longint(m_SurfaceRect.pBits) + y * m_SurfaceRect.pitch + x * 2);
      t2 := pb^; inc(pb);
      t1 := pb^;
      tmp:= t1 shl 8 + t2;
      b  := (tmp and $0F) shl 4;
      g  := ((tmp shr 4)  and $0F) shl 4;
      r  := ((tmp shr 8)  and $0F) shl 4;
      a  := ((tmp shr 12) and $0F) shl 4;
    end;
    D3DFMT_R5G6B5:
    begin
      pb := pbyte(longint(m_SurfaceRect.pBits) + y * m_SurfaceRect.pitch + x * 2);
      t2 := pb^; inc(pb);
      t1 := pb^;
      tmp:= t1 shl 8 + t2;
      b  := (tmp and $1F) shl 3;
      g  := ((tmp shr 5)  and $3F) shl 2;
      r  := ((tmp shr 11) and $1F) shl 3;
    end;
    else
    Exit;
  end;
  Result := DJXColor(r, g, b, a);
end;

procedure TDJXTexture.SetPixel(X, Y: integer; Value: TDJXColor);
var
  r, g, b, a: byte;
  pb: pbyte;
  tmp: word;
begin
  if not m_Locked then exit;
  r := DJXColorR(Value);
  g := DJXColorG(Value);
  b := DJXColorB(Value);
  a := DJXColorA(Value);
  case m_SurfaceDesc.Format of
    D3DFMT_X8R8G8B8, D3DFMT_A8R8G8B8:
    begin
      pb  := pbyte(longint(m_SurfaceRect.pBits) + y * m_SurfaceRect.pitch + x * 4);
      pb^ := b; inc(pb);
      pb^ := g; inc(pb);
      pb^ := r; inc(pb);
      pb^ := a;
    end;
    D3DFMT_R8G8B8:
    begin
      pb  := pbyte(longint(m_SurfaceRect.pBits) + y * m_SurfaceRect.pitch + x * 3);
      pb^ := b; inc(pb);
      pb^ := g; inc(pb);
      pb^ := r;
    end;
    D3DFMT_A4R4G4B4:
    begin
      pb  := pbyte(longint(m_SurfaceRect.pBits) + y * m_SurfaceRect.pitch + x * 2);
      tmp := (a shr 4) shl 12 + (r shr 4) shl 8 + (g shr 4) shl 4 + (b shr 4);
      pb^ := lo(tmp); inc(pb);
      pb^ := hi(tmp);
    end;
    D3DFMT_R5G6B5:
    begin
      pb  := pbyte(longint(m_SurfaceRect.pBits) + y * m_SurfaceRect.pitch + x * 2);
      tmp := (r shr 3) shl 11 + (g shr 2) shl 5 + (b shr 3);
      pb^ := lo(tmp); inc(pb);
      pb^ := hi(tmp);
    end;
  end;
end;

procedure TDJXTexture.LoadError;
var
  bmp: TBitmap;
  s: string;
begin
  Release;
  bmp := TBitmap.Create;
  bmp.Width := 256;
  bmp.Height := 256;
  bmp.Canvas.Pen.Width := 10;
  bmp.Canvas.Pen.Color := clRed;
  bmp.Canvas.Rectangle(0, 0, bmp.Width, bmp.Height);
  bmp.Canvas.MoveTo(0, 0);
  bmp.Canvas.LineTo(bmp.Width, bmp.Height);
  bmp.Canvas.MoveTo(bmp.Width, 0);
  bmp.Canvas.LineTo(0, bmp.Height);
  s := 'Error Loading Texture';
  bmp.Canvas.Font.Size := 18;
  bmp.Canvas.TextOut(
    (bmp.Width - bmp.Canvas.TextWidth(s)) div 2,
    bmp.Height div 2 - bmp.Canvas.TextHeight(s) * 2,
    s
  );
  s := m_Name;
  bmp.Canvas.TextOut(
    (bmp.Width - bmp.Canvas.TextWidth(s)) div 2,
    bmp.Height div 2 + bmp.Canvas.TextHeight(s),
    s
  );
  LoadFromGraphic(bmp, 1);
  bmp.Free;
end;

procedure TDJXTexture.DrawBillboard(
      x, y, z: single;
      x1, y1, x2, y2, x3, y3, x4, y4: single;
      col1, col2, col3, col4: TDJXColor;
      Rotation, ScaleX, ScaleY: single;
      ImageIndex: integer = 0;
      TileWidth: integer = 0; TileHeight: integer = 0
    );
begin
  if (m_DanJetX = nil) or (TDanJetX(m_DanJetX).Render = nil) then exit;
  TDJXRender(TDanJetX(m_DanJetX).Render).DrawBillboard(
    x, y, z,
    x1, y1, x2, y2, x3, y3, x4, y4,
    col1, col2, col3, col4,
    Rotation, ScaleX, ScaleY,
    self,
    ImageIndex,
    TileWidth, TileHeight
  );
end;

procedure TDJXTexture.DrawBillboardCyl(
      p1x, p1y, p1z: single;
      p2x, p2y, p2z: single;
      r1, r2: single;
      col1, col2, col3, col4: TDJXColor;
      Scale: single;
      ImageIndex: integer = 0;
      TileWidth: integer = 0; TileHeight: integer = 0
    );
begin
  if (m_DanJetX = nil) or (TDanJetX(m_DanJetX).Render = nil) then exit;
  TDJXRender(TDanJetX(m_DanJetX).Render).DrawBillboardCyl(
    p1x, p1y, p1z,
    p2x, p2y, p2z,
    -r1, 0, r1, 0, r2, 0, -r2, 0,
    col1, col2, col3, col4,
    Scale,
    self,
    ImageIndex,
    TileWidth, TileHeight
  );
end;

procedure TDJXTexture.Draw(
            x, y: double;
            Color: TDJXColor;
            ImageIndex: integer = 0;
            TileWidth: integer = 0; TileHeight: integer = 0
          );
var
  w,h: single;
begin
  if (m_DanJetX = nil) or (TDanJetX(m_DanJetX).Render = nil) then exit;
  if TileWidth > 0 then w := TileWidth else w := m_Width;
  if TileHeight > 0 then h := TileHeight else h := m_Height;
  TDJXRender(TDanJetX(m_DanJetX).Render).DrawTexture2D(
    x, y, x + w, y, x + w, y + h, x, y + h,
    Color, Color, Color, Color,
    0, 0, 0, 1, 1,
    self, false, false,
    ImageIndex, TileWidth, TileHeight
  );
end;

procedure TDJXTexture.Draw(
            x, y: double;
            Color: TDJXColor;
            CenterX, CenterY, Rotation, ScaleX, ScaleY: single;
            FlipTopBottom: boolean = false;
            FlipLeftRight: boolean = false;
            ImageIndex: integer = 0;
            TileWidth: integer = 0; TileHeight: integer = 0
          );
var
  w, h: single;
begin
  if (m_DanJetX = nil) or (TDanJetX(m_DanJetX).Render = nil) then exit;
  if TileWidth > 0 then w := TileWidth else w := m_Width;
  if TileHeight > 0 then h := TileHeight else h := m_Height;
  TDJXRender(TDanJetX(m_DanJetX).Render).DrawTexture2D(
    x, y, x + w, y, x + w, y + h, x, y + h,
    Color, Color, Color, Color,
    CenterX, CenterY, Rotation, ScaleX, ScaleY,
    self,
    FlipTopBottom, FlipLeftRight,
    ImageIndex, TileWidth, TileHeight
  );
end;

procedure TDJXTexture.Draw4col(
            x1, y1, x2, y2, x3, y3, x4, y4: double;
            col1, col2, col3, col4: TDJXColor;
            ImageIndex: integer = 0;
            TileWidth: integer = 0; TileHeight: integer = 0
          );
begin
  if (m_DanJetX = nil) or (TDanJetX(m_DanJetX).Render = nil) then exit;
  TDJXRender(TDanJetX(m_DanJetX).Render).DrawTexture2D(
    x1, y1, x2, y2, x3, y3, x4, y4,
    col1, col2, col3, col4,
    0,0,0,1,1,
    self, false, false,
    ImageIndex, TileWidth, TileHeight
  );
end;

procedure TDJXTexture.Draw4col(
            x1, y1, x2, y2, x3, y3, x4, y4: double;
            col1, col2, col3, col4: TDJXColor;
            CenterX, CenterY, Rotation, ScaleX, ScaleY: single;
            FlipTopBottom: boolean = false;
            FlipLeftRight: boolean = false;
            ImageIndex: integer = 0; TileWidth: integer = 0; TileHeight: integer = 0
          );
begin
  if (m_DanJetX = nil) or (TDanJetX(m_DanJetX).Render = nil) then exit;
  TDJXRender(TDanJetX(m_DanJetX).Render).DrawTexture2D(
    x1, y1, x2, y2, x3, y3, x4, y4,
    col1, col2, col3, col4,
    CenterX, CenterY, Rotation, ScaleX, ScaleY,
    self,
    FlipTopBottom, FlipLeftRight,
    ImageIndex, TileWidth, TileHeight
  );
end;

procedure TDJXTexture.SetToDevice(Stage: byte);
begin
  if m_DanJetX = nil then exit;
  TDanJetX(m_DanJetX).Device.SetTexture(Stage, m_Texture);
end;

procedure TDJXTexture.ReloadFromRenderTarget(Levels: integer = 1);
var
  RTSurfaceDesc: TD3DSURFACE_DESC;
  RTSurface: IDirect3DSurface9;
  SysMemSurface: IDirect3DSurface9;
  TexPixels: array of array of TDJXColor;
  SizePerPixel: DWORD;
  LockRect: TD3DLOCKED_RECT;
  i: integer;
  pb: pbyte;
begin
  if not m_RenderTarget or (m_Texture = nil) then exit;
  m_Texture.GetLevelDesc(0, RTSurfaceDesc);
  TDanJetX(m_DanJetX).Device.CreateOffscreenPlainSurface(
    RTSurfaceDesc.Width, RTSurfaceDesc.Height,
    RTSurfaceDesc.Format,
    D3DPOOL_SYSTEMMEM,
    SysMemSurface,
    nil
  );
  m_Texture.GetSurfaceLevel(0, RTSurface);
  TDanJetX(m_DanJetX).Device.GetRenderTargetData(
    RTSurface,
    SysMemSurface
  );
  SizePerPixel := GetFormatSize(RTSurfaceDesc.Format);
  SetLength(TexPixels, RTSurfaceDesc.Height, RTSurfaceDesc.Width);
  SysMemSurface.LockRect(LockRect, nil, 0);
  for i := 0 to RTSurfaceDesc.Height - 1 do
  Move(Pointer(cardinal(LockRect.pBits) + i * LockRect.Pitch)^, TexPixels[i, 0], SizePerPixel * RTSurfaceDesc.Width);
  SysMemSurface.UnlockRect;
  MakeTexture(RTSurfaceDesc.Width, RTSurfaceDesc.Height, Levels);
  TexLock;
  for i := 0 to RTSurfaceDesc.Height - 1 do
  begin
    pb := pbyte(cardinal(m_SurfaceRect.pBits) + m_SurfaceRect.Pitch * i);
    Move(TexPixels[i, 0], pb^, SizePerPixel * RTSurfaceDesc.Width);
  end;
  TexUnlock;
  safe_release(RTSurface);
  safe_release(SysMemSurface);
end;
//TDJXTexture END




end.
