//DJXUtils v1.5
unit DJXUtils;

interface

//{$DEFINE SUPPORTS_INLINE}

uses
  Windows,
  Classes,
  MMsystem,
  Dialogs,
  Math,
  SysUtils,
  DJXClasses,
  DJXTextures,
  Direct3D9,
  D3DX9;


type
  TCircle = record
    x, y, radius: single;
  end;

  TQuad = array[0..3] of TD3DXVector2;

  TIntersection = record
    Locations: array of TD3DXVector2;
    Intersection: boolean;
    InSegment: boolean;
  end;

  TDJXFPSCounter = class
  private
    fFPS: cardinal;
    fTimerStart: cardinal;
    fTimerCount: cardinal;
    fInterval: cardinal;
    fFrequency: int64;
    fProcNewTime, fProcOldTime: int64;
    fIntervalPos: cardinal;
    fIntervalProc: cardinal;
    fFramesPas: integer;
    fSpeedfactor: single;
    fTargetFPS: integer;
  public
    constructor Create;
    destructor Destroy; override;
    property FPS: cardinal read fFPS;
    property SpeedFactor: single read fSpeedFactor;
    property IntervalProc: cardinal read fIntervalProc write fIntervalProc;
    property Interval: cardinal read fInterval write fInterval;
    procedure Update;
  end;

  TIndex16Arr = array[0..0] of WORD;
  PIndex16Arr = ^TIndex16Arr;
  TIndex32Arr = array[0..0] of DWORD;
  PIndex32Arr = ^TIndex32Arr;
  TGetIndexProc = function(IBPtr: Pointer; Ind: DWORD): DWORD;
  
  function getAngDeg(x1,y1,x2,y2: single): single;
  function getAngRad(x1,y1,x2,y2: single): single;
  function GetAng3D(v1, v2: TD3DXVector3): TD3DXQuaternion;
  procedure SetTileTexture(
    var OutTU0, OutTV0, OutTU1, OutTV1, OutTU2, OutTV2, OutTU3, OutTV3: single;
    const Texture: TDJXTexture;
    FlipTopBottom: boolean = false;
    FlipLeftRight: boolean = false;
    ImageIndex: integer = 0;
    TileWidth: integer = 0;
    TileHeight: integer = 0;
    TruncatePixel: boolean = false
  );
  procedure SetTextureToVertices(
    var V1,V2,V3,V4: TDJXVertex3D;
    const Texture: TDJXTexture;
    FlipTopBottom: boolean = false;
    FlipLeftRight: boolean = false;
    ImageIndex: integer = 0;
    TileWidth: integer = 0;
    TileHeight: integer = 0;
    TruncatePixel: boolean = false
  ); overload;
  procedure SetTextureToVertices(
    var V1,V2,V3,V4: TDJXVertex2D;
    const Texture: TDJXTexture;
    FlipTopBottom: boolean = false;
    FlipLeftRight: boolean = false;
    ImageIndex: integer = 0;
    TileWidth: integer = 0;
    TileHeight: integer = 0;
    TruncatePixel: boolean = false
  ); overload;
  function GetTriangleNormal(Vertex1,Vertex2,Vertex3: TD3DXVector3): TD3DXVector3; overload;
  function GetTriangleNormal(Vertex1, Vertex2, Vertex3: TDJXVertex3D): TD3DXVector3; overload;
  procedure NormalizeTriangle(var Vertex1,Vertex2,Vertex3: TDJXVertex3D); overload;
  procedure NormalizeTriangle(var Vertex1,Vertex2,Vertex3: TDJXVertexFlex); overload;
  function limit_int(num,min,max: integer):integer;
  function limit_dbl(num,min,max:double): double;
  function distance_int(x1,y1,z1,x2,y2,z2: integer): integer;
  function distance_dbl(x1,y1,z1,x2,y2,z2: double): double;
  function FtoDW(f: Single): DWord;
  function Quad(const pt1,pt2,pt3,pt4: TD3DXVector2): TQuad; overload;
  function Quad(const pt1x,pt1y,pt2x,pt2y,pt3x,pt3y,pt4x,pt4y: single): TQuad; overload;
  function PointInPolygon(const Polygon: array of TDJXVertex2D; const pt: TD3DXVector2): boolean; overload;
  function PointInPolygon(const Polygon: array of TD3DXVector2; const pt: TD3DXVector2): boolean; overload;
  function LinesIntersect(const l1p1,l1p2,l2p1,l2p2: Tpoint):boolean; overload;
  function LinesIntersect(const l1x1,l1y1,l1x2,l1y2,l2x1,l2y1,l2x2,l2y2: integer):boolean; overload;
  function LinesIntersectSpec(const l1p1,l1p2,l2p1,l2p2: TD3DXVector2): TIntersection;
  function LineInCircle(p1,p2,pC: TPoint; Rad: integer): boolean;
  function CircleVsQuad(var Circle1: TCircle; const Quad1: TQuad): boolean;
  function PointLineDistance(
    const lineV1, lineV2, pt: TD3DXVector2;
    var Intersection: TD3DXVector2;
    var InSegment: boolean
  ): single;
  function RectInRect(const R1,R2: TRect): boolean;
  function PointInRect(const x, y: single; const R: TRect): boolean; overload;
  function PointInRect(const x, y: single; const Rleft,Rtop,Rright,Rbottom: single): boolean; overload;
  function QuadInQuad(Quad1,Quad2: TQuad): boolean;
  function PointInTriangle(x,y:integer;const Triangle: array of TD3DXVector2): boolean;
  function GetRect(const x1,y1,x2,y2: integer): TRect;
  function RayVsTriangle(
    RayOrigin, RayDir, TriV1, TriV2, TriV3 : TD3DXVector3;
    var t, u, v: single
  ): boolean;
  function VectorToDJXColor(Vec: TD3DXVector3): TDJXColor;
  function ReflectVec2(Vec: TD3DXVector2; Normal: TD3DXVector2): TD3DXVector2;
  procedure CreateTangentSpaceVectors(
    const v1: TD3DXVector3;
    const v2: TD3DXVector3;
    const v3: TD3DXVector3;
    const v1u, v1v: single;
    const v2u, v2v: single;
    const v3u, v3v: single;
    var vTangent: TD3DXVector3;
    var vBiNormal: TD3DXVector3;
    var vNormal: TD3DXVector3
  );
  function LoadVertexShaderFromFile(
    const f: string;
    const Device: IDirect3DDevice9;
    var ErrorStr: string
  ): IDirect3DVertexShader9;
  function LoadVertexShaderFromFileC(
    const f: string;
    const Device: IDirect3DDevice9
  ): IDirect3DVertexShader9;
  function LoadPixelShaderFromFile(
    const f: string;
    const Device: IDirect3DDevice9;
    var ErrorStr: string
  ): IDirect3DPixelShader9;
  function LoadPixelShaderFromFileC(
    const f: string;
    const Device: IDirect3DDevice9
  ): IDirect3DPixelShader9;
  function CreateVertexDeclarationFromFVF(
    Device: IDirect3DDevice9;
    const FVF: cardinal
  ): IDirect3DVertexDeclaration9;
  function CreateVertexDeclaration(
    Device: IDirect3DDevice9;
    const Decl: TFVFDeclaration
  ): IDirect3DVertexDeclaration9;
  function D3DVertexElement(
    Stream:     Word;
    Offset:     Word;
    _Type:      TD3DDeclType;
    Method:     TD3DDeclMethod;
    Usage:      TD3DDeclUsage;
    UsageIndex: byte
  ): TD3DVertexElement9;
  function GetTexCoordSetsCount(dwFVF: DWORD): DWORD;
  function GetFVFComponentOffset(
    dwFVF: DWORD;
    dwFVFComponent: DWORD;
    iTexCoordIndex: byte = 0
  ): DWORD;
  procedure MatrixLerp(
    out OutMat: TD3DXMatrix;
    const Mat1, Mat2: TD3DXMatrix;
    const Grad: single
  );
  procedure MatrixInterpolate(
    out OutMat: TD3DXMatrix;
    const Mat1, Mat2: TD3DXMatrix;
    const Grad: single
  );
  function MatrixGenerate(
    const Scale: TD3DXVector3;
    const Rotation: TD3DXQuaternion;
    const Translation: TD3DXVector3
  ): TD3DXMatrix;
  procedure GenerateTextureSpaceMatrices(
    Mesh: ID3DXMesh;
    TextureStageIndex: integer;
    MatrixTextureStage: integer
  );
  procedure GenerateTextureSpaceMatricesPerVertex(
    Mesh: ID3DXMesh;
    TextureStageIndex: integer;
    MatrixTextureStage: integer
  );
  function GetIndex16(IBPtr: Pointer; Ind: DWORD): DWORD;
  function GetIndex32(IBPtr: Pointer; Ind: DWORD): DWORD;
  procedure ThrowError(ErrorMsg: string);
  procedure ThrowMessage(ErrorMsg: string);
  function ThrowYesNo(ErrorMsg: string): integer;
  function GetPITime(Amp: single = 1000): single;
  function GetTimeInterval(Interval: DWORD = 1000): single;
  function GetRandomPi: single;
  function GetRandom2Pi: single;
  procedure SinCosConstants(var Vec1, Vec2: TD3DXVector4);
  function Factorial(Num: integer): integer;
  function GenerateShadowMesh(
    const pd3dDevice: IDirect3DDevice9;
    const pMesh: ID3DXMesh;
    out ppOutMesh: ID3DXMesh
  ): HRESULT;
  function GetFormatSize(Format: TD3DFormat): DWORD;
  procedure safe_release(var i);
  function GetDesktopHandle: HWND;

const
  HalfPi = pi * 0.5;
  TwoPi = pi * 2;  

implementation

procedure safe_release(var i);{$IFDEF SUPPORTS_INLINE} inline;{$ENDIF}
begin
  if IUnknown(i) <> nil then IUnknown(i):= nil;
end;

//FPSCounter BEGIN
constructor TDJXFPSCounter.Create;
begin
  inherited create;
  fInterval:=50;
  fTargetfps := 100;
  fIntervalProc:= 200;
  fIntervalPos:=GetTickCount;
  fFramesPas:=1;
  QueryPerformanceCounter(fProcOldTime);
  QueryPerformanceFrequency(fFrequency);
  fSpeedFactor:=1;
end;
destructor TDJXFPSCounter.Destroy;
begin
  inherited Destroy;
end;
procedure TDJXFPSCounter.update;
begin
  if fTimerCount=0 then fTimerStart:=GetTickCount;
  inc(ftimerCount);
  if ftimerCount>=fInterval-1 then
  begin
    ftimerCount:=0;
    fFPS:=round((fInterval*1000)/(GetTickCount-fTimerStart));
  end;
  if GetTickCount-fIntervalPos>fIntervalProc then
  begin
    QueryPerformanceCounter(fProcNewTime);
    fSpeedFactor := (fProcNewTime-fProcOldTime)/(fFrequency/fTargetFPS);
    if (fSpeedFactor <= 0) then
    fSpeedFactor := 1;
    fSpeedFactor:=fSpeedFactor/fFramesPas;
    fProcOldTime := fProcNewTime;
    fIntervalPos:=GetTickCount;
    fFramesPas:=1;
  end
  else
  inc(fFramesPas);
end;
//FPSCounter END

function FtoDW(f: Single): DWord; 
begin
  Result:= PDWord(@f)^;
end;

function Quad(const pt1,pt2,pt3,pt4: TD3DXVector2): TQuad;
begin
  Result[0]:=D3DXVector2(pt1.x,pt1.y);
  Result[1]:=D3DXVector2(pt2.x,pt2.y);
  Result[2]:=D3DXVector2(pt3.x,pt3.y);
  Result[3]:=D3DXVector2(pt4.x,pt4.y);
end;
function Quad(const pt1x,pt1y,pt2x,pt2y,pt3x,pt3y,pt4x,pt4y: single): TQuad;
begin
  Result[0]:=D3DXVector2(pt1x,pt1y);
  Result[1]:=D3DXVector2(pt2x,pt2y);
  Result[2]:=D3DXVector2(pt3x,pt3y);
  Result[3]:=D3DXVector2(pt4x,pt4y);
end;

function GetTriangleNormal(
      Vertex1, Vertex2, Vertex3: TD3DXVector3
    ): TD3DXVector3; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
var
  v1,v2: TD3DXVector3;
begin
  D3DXVec3Subtract(v1, Vertex2, Vertex1);
  D3DXVec3Subtract(v2, Vertex3, Vertex1);
  D3DXVec3Cross(Result, v1, v2);
  D3DXVec3Normalize(Result, Result);
end;
function GetTriangleNormal(
      Vertex1, Vertex2, Vertex3: TDJXVertex3D
    ): TD3DXVector3; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
var
  v1,v2: TD3DXVector3;
begin
  D3DXVec3Subtract(
    v1,
    D3DXVector3(Vertex2.x, Vertex2.y, Vertex2.z),
    D3DXVector3(Vertex1.x, Vertex1.y, Vertex1.z)
  );
  D3DXVec3Subtract(
    v2,
    D3DXVector3(Vertex3.x, Vertex3.y, Vertex3.z),
    D3DXVector3(Vertex1.x, Vertex1.y, Vertex1.z)
  );
  D3DXVec3Cross(Result, v1, v2);
  D3DXVec3Normalize(Result, Result);
end;
procedure NormalizeTriangle(
      var Vertex1,Vertex2,Vertex3: TDJXVertex3D
    );{$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
var
Vec: TD3DXVector3;
begin
  Vec:=GetTriangleNormal(
    D3DXVector3(Vertex1.x,Vertex1.y,Vertex1.z),
    D3DXVector3(Vertex2.x,Vertex2.y,Vertex2.z),
    D3DXVector3(Vertex3.x,Vertex3.y,Vertex3.z)
  );
  Vertex1.nx:=Vec.x;
  Vertex1.ny:=Vec.y;
  Vertex1.nz:=Vec.z;
  Vertex2.nx:=Vec.x;
  Vertex2.ny:=Vec.y;
  Vertex2.nz:=Vec.z;
  Vertex3.nx:=Vec.x;
  Vertex3.ny:=Vec.y;
  Vertex3.nz:=Vec.z;
end;
procedure NormalizeTriangle(
      var Vertex1,Vertex2,Vertex3: TDJXVertexFlex
    );{$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
var
Vec: TD3DXVector3;
begin
  Vec:=GetTriangleNormal(
    D3DXVector3(Vertex1.x,Vertex1.y,Vertex1.z),
    D3DXVector3(Vertex2.x,Vertex2.y,Vertex2.z),
    D3DXVector3(Vertex3.x,Vertex3.y,Vertex3.z)
  );
  Vertex1.nx:=Vec.x;
  Vertex1.ny:=Vec.y;
  Vertex1.nz:=Vec.z;
  Vertex2.nx:=Vec.x;
  Vertex2.ny:=Vec.y;
  Vertex2.nz:=Vec.z;
  Vertex3.nx:=Vec.x;
  Vertex3.ny:=Vec.y;
  Vertex3.nz:=Vec.z;
end;

procedure SetTileTexture(
  var OutTU0, OutTV0, OutTU1, OutTV1, OutTU2, OutTV2, OutTU3, OutTV3: single;
  const Texture: TDJXTexture;
  FlipTopBottom: boolean = false;
  FlipLeftRight: boolean = false;
  ImageIndex: integer = 0;
  TileWidth: integer = 0;
  TileHeight: integer = 0;
  TruncatePixel: boolean = false
); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
var
  tw,th,tu,tv,TexUnitX,TexUnitY,
  tu1,tv1,tu2,tv2,tu3,tv3,tu4,tv4: single;
  wc: integer;
begin
  if TileWidth>0 then tw:=TileWidth else tw:=Texture.Width;
  if TileHeight>0 then th:=TileHeight else th:=Texture.Height;
  tv:=th/Texture.RealHeight;
  tu:=tw/Texture.RealWidth;
  wc:=round(Texture.Width/tw);
  if TruncatePixel then
  begin
    TexUnitX:=1/Texture.RealWidth;
    TexUnitY:=1/Texture.RealHeight;
  end
  else
  begin
    TexUnitX:=0;
    TexUnitY:=0;
  end;
  tu1:=(ImageIndex mod wc)*tu+TexUnitX;     tv1:=trunc(ImageIndex/wc)*tv+TexUnitY;
  tu2:=(ImageIndex mod wc)*tu+tu-TexUnitX;  tv2:=trunc(ImageIndex/wc)*tv+TexUnitY;
  tu3:=(ImageIndex mod wc)*tu+tu-TexUnitX;  tv3:=trunc(ImageIndex/wc)*tv+tv-TexUnitY;
  tu4:=(ImageIndex mod wc)*tu+TexUnitX;     tv4:=trunc(ImageIndex/wc)*tv+tv-TexUnitY;
  OutTU0 := tu1;
  OutTV0:=tv1;
  OutTU1:=tu2;
  OutTV1:=tv2;
  OutTU2:=tu3;
  OutTV2:=tv3;
  OutTU3:=tu4;
  OutTV3:=tv4;
  if FlipTopBottom then
  begin
    OutTV0:=tv4;
    OutTV1:=tv3;
    OutTV2:=tv2;
    OutTV3:=tv1;
  end;
  if FlipLeftRight then
  begin
    OutTU0:=tu2;
    OutTU1:=tu1;
    OutTU2:=tu4;
    OutTU3:=tu3;
  end;
end;
procedure SetTextureToVertices(
  var V1,V2,V3,V4: TDJXVertex3D;
  const Texture: TDJXTexture;
  FlipTopBottom: boolean = false;
  FlipLeftRight: boolean = false;
  ImageIndex: integer = 0;
  TileWidth: integer = 0;
  TileHeight: integer = 0;
  TruncatePixel: boolean = false
); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
var
tw,th,tu,tv,TexUnitX,TexUnitY,
tu1,tv1,tu2,tv2,tu3,tv3,tu4,tv4: single;
wc: integer;
begin
  if TileWidth>0 then tw:=TileWidth else tw:=Texture.Width;
  if TileHeight>0 then th:=TileHeight else th:=Texture.Height;
  tv:=th/Texture.RealHeight;
  tu:=tw/Texture.RealWidth;
  wc:=round(Texture.Width/tw);
  if TruncatePixel then
  begin
    TexUnitX:=1/Texture.RealWidth;
    TexUnitY:=1/Texture.RealHeight;
  end
  else
  begin
    TexUnitX:=0;
    TexUnitY:=0;
  end;
  tu1:=(ImageIndex mod wc)*tu+TexUnitX;     tv1:=trunc(ImageIndex/wc)*tv+TexUnitY;
  tu2:=(ImageIndex mod wc)*tu+tu-TexUnitX;  tv2:=trunc(ImageIndex/wc)*tv+TexUnitY;
  tu3:=(ImageIndex mod wc)*tu+tu-TexUnitX;  tv3:=trunc(ImageIndex/wc)*tv+tv-TexUnitY;
  tu4:=(ImageIndex mod wc)*tu+TexUnitX;     tv4:=trunc(ImageIndex/wc)*tv+tv-TexUnitY;
  V1.tu:=tu1;
  V1.tv:=tv1;
  V2.tu:=tu2;
  V2.tv:=tv2;
  V3.tu:=tu3;
  V3.tv:=tv3;
  V4.tu:=tu4;
  V4.tv:=tv4;
  if FlipTopBottom then
  begin
    V1.tv:=tv4;
    V2.tv:=tv3;
    V3.tv:=tv2;
    V4.tv:=tv1;
  end;
  if FlipLeftRight then
  begin
    V1.tu:=tu2;
    V2.tu:=tu1;
    V3.tu:=tu4;
    V4.tu:=tu3;
  end;
end;
procedure SetTextureToVertices(
  var V1,V2,V3,V4: TDJXVertex2D;
  const Texture: TDJXTexture;
  FlipTopBottom: boolean = false;
  FlipLeftRight: boolean = false;
  ImageIndex: integer = 0;
  TileWidth: integer = 0;
  TileHeight: integer = 0;
  TruncatePixel: boolean = false
); {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
var
tw,th,tu,tv,TexUnitX,TexUnitY,
tu1,tv1,tu2,tv2,tu3,tv3,tu4,tv4: single;
wc: integer;
begin
  if TileWidth>0 then tw:=TileWidth else tw:=Texture.Width;
  if TileHeight>0 then th:=TileHeight else th:=Texture.Height;
  tv:=th/Texture.RealHeight;
  tu:=tw/Texture.RealWidth;
  wc:=round(Texture.Width/tw);
  if TruncatePixel then
  begin
    TexUnitX:=1/Texture.RealWidth;
    TexUnitY:=1/Texture.RealHeight;
  end
  else
  begin
    TexUnitX:=0;
    TexUnitY:=0;
  end;
  tu1:=(ImageIndex mod wc)*tu+TexUnitX;     tv1:=trunc(ImageIndex/wc)*tv+TexUnitY;
  tu2:=(ImageIndex mod wc)*tu+tu-TexUnitX;  tv2:=trunc(ImageIndex/wc)*tv+TexUnitY;
  tu3:=(ImageIndex mod wc)*tu+tu-TexUnitX;  tv3:=trunc(ImageIndex/wc)*tv+tv-TexUnitY;
  tu4:=(ImageIndex mod wc)*tu+TexUnitX;     tv4:=trunc(ImageIndex/wc)*tv+tv-TexUnitY;
  V1.tu:=tu1;
  V1.tv:=tv1;
  V2.tu:=tu2;
  V2.tv:=tv2;
  V3.tu:=tu3;
  V3.tv:=tv3;
  V4.tu:=tu4;
  V4.tv:=tv4;
  if FlipTopBottom then
  begin
    V1.tv:=tv4;
    V2.tv:=tv3;
    V3.tv:=tv2;
    V4.tv:=tv1;
  end;
  if FlipLeftRight then
  begin
    V1.tu:=tu2;
    V2.tu:=tu1;
    V3.tu:=tu4;
    V4.tu:=tu3;
  end;
end;

function distance_int(x1,y1,z1,x2,y2,z2: integer): integer;
begin
  result:=round(Sqrt(Sqr(x1-x2)+Sqr(y1-y2)+Sqr(z1-z2)));
end;
function distance_dbl(x1,y1,z1,x2,y2,z2: double): double;
begin
  result:=Sqrt(Sqr(x1-x2)+Sqr(y1-y2)+Sqr(z1-z2));
end;

function PointInPolygon(const Polygon: array of TD3DXVector2; const pt: TD3DXVector2): boolean;
var
  i: integer; 
  pi, pj: TD3DXVector2; 
begin 
  Result:= False; 
  if High(Polygon) < 2 then Exit;
  pj:= Polygon[High(Polygon)];
  for i:= 0 to High(Polygon) do
  begin 
    pi:= Polygon[i];
    if ((((pi.y <= pt.y) and (pt.y < pj.y)) or ((pj.y <= pt.y) and (pt.y < pi.y))) and
    (pt.x < (pj.x - pi.x) * (pt.Y - pi.y) / (pj.y - pi.y) + pi.x)) 
    then Result:= not Result; 
    pj:= pi; 
  end; 
end;
function PointInPolygon(const Polygon: array of TDJXVertex2D; const pt: TD3DXVector2): boolean;
var 
  i: integer; 
  pi, pj: TD3DXVector2; 
begin 
  Result:= False;
  if High(Polygon) < 2 then Exit;
  pj:=D3DXVector2(Polygon[High(Polygon)].x,Polygon[High(Polygon)].y);
  for i:=0 to High(Polygon) do
  begin 
    pi:=D3DXVector2(Polygon[i].x,Polygon[i].x); 
    if ((((pi.y <= pt.y) and (pt.y < pj.y)) or ((pj.y <= pt.y) and (pt.y < pi.y))) and
    (pt.x < (pj.x - pi.x) * (pt.Y - pi.y) / (pj.y - pi.y) + pi.x))
    then Result:= not Result; 
    pj:= pi; 
  end; 
end;
function LinesIntersect(const l1x1,l1y1,l1x2,l1y2,l2x1,l2y1,l2x2,l2y2: integer):boolean;
var
  K1,C1,K2,C2: single;
  X,Y: single;
begin
  result := false;
  if (l1x1-l1x2=0)and(l2x1-l2x2=0) then
  begin //both lines are vertical
    if l1x1=l2x1 then
    result:=true
    else
    result:=false;
    exit;
  end;
  if l1x1-l1x2=0 then
  begin
    K2:=(l2y2-l2y1)/(l2x2-l2x1);
    C2:=l2y1-K2*l2x1;
    X:=l1x1;
    Y:=K2*X+C2;
  end
  else
  if l2x1-l2x2=0 then
  begin
    K1:=(l1y2-l1y1)/(l1x2-l1x1);
    C1:=l1y1-K1*l1x1;
    X:=l2x1;
    Y:=K1*X+C1;
  end
  else
  begin
    K1:=(l1y2-l1y1)/(l1x2-l1x1);
    C1:=l1y1-K1*l1x1;
    K2:=(l2y2-l2y1)/(l2x2-l2x1);
    C2:=l2y1-K2*l2x1;
    if K1-K2=0 then
    begin //lines do not intersect
      result:=false;
      exit;
    end;
    X:=(C2-C1)/(K1-K2);
    Y:=K1*X+C1;
  end;
  if  PointInRect(X,Y,GetRect(l1x1,l1y1,l1x2,l1y2))
  and PointInRect(X,Y,GetRect(l2x1,l2y1,l2x2,l2y2))
  then
  result:=true; //lines intersect;
end;
function LinesIntersect(const l1p1,l1p2,l2p1,l2p2: Tpoint):boolean;
var
K1,C1,K2,C2: single;
X,Y: single;
begin
  result := false;
  if (l1p1.x-l1p2.x=0)and(l2p1.x-l2p2.x=0) then
  begin //both lines are vertical
    if l1p1.x=l2p1.x then result:=true else result:=false;
    exit;
  end;
  if l1p1.x-l1p2.x=0 then
  begin
    K2:=(l2p2.y-l2p1.y)/(l2p2.x-l2p1.x);
    C2:=l2p1.y-K2*l2p1.x;
    X:=l1p1.x;
    Y:=K2*X+C2;
  end
  else
  if l2p1.x-l2p2.x=0 then
  begin
    K1:=(l1p2.y-l1p1.y)/(l1p2.x-l1p1.x);
    C1:=l1p1.y-K1*l1p1.x;
    X:=l2p1.x;
    Y:=K1*X+C1;
  end
  else
  begin
    K1:=(l1p2.y-l1p1.y)/(l1p2.x-l1p1.x);
    C1:=l1p1.y-K1*l1p1.x;
    K2:=(l2p2.y-l2p1.y)/(l2p2.x-l2p1.x);
    C2:=l2p1.y-K2*l2p1.x;
    if K1-K2=0 then
    begin //lines do not intersect
      result:=false;
      exit;
    end;
    X:=(C2-C1)/(K1-K2);
    Y:=K1*X+C1;
  end;
  if  PointInRect(X,Y,GetRect(l1p1.x,l1p1.y,l1p2.x,l1p2.y))
  and PointInRect(X,Y,GetRect(l2p1.x,l2p1.y,l2p2.x,l2p2.y))
  then
  result:=true; //lines intersect;
end;
function LinesIntersectSpec(const l1p1,l1p2,l2p1,l2p2: TD3DXVector2): TIntersection;
var
  K1,C1,K2,C2: single;
  X,Y: single;
begin
  Result.Intersection := false;
  Result.InSegment := false;
  setlength(Result.Locations, 0);
  if (l1p1.x-l1p2.x=0)and(l2p1.x-l2p2.x=0) then
  begin //both lines are vertical
    if l1p1.x=l2p1.x then
    begin
      result.Intersection:=true;
    end
    else
    result.Intersection:=false;
    exit;
  end;
  if l1p1.x-l1p2.x=0 then
  begin
    K2:=(l2p2.y-l2p1.y)/(l2p2.x-l2p1.x);
    C2:=l2p1.y-K2*l2p1.x;
    X:=l1p1.x;
    Y:=K2*X+C2;
  end
  else
  if l2p1.x-l2p2.x=0 then
  begin
    K1:=(l1p2.y-l1p1.y)/(l1p2.x-l1p1.x);
    C1:=l1p1.y-K1*l1p1.x;
    X:=l2p1.x;
    Y:=K1*X+C1;
  end
  else
  begin
    K1:=(l1p2.y-l1p1.y)/(l1p2.x-l1p1.x);
    C1:=l1p1.y-K1*l1p1.x;
    K2:=(l2p2.y-l2p1.y)/(l2p2.x-l2p1.x);
    C2:=l2p1.y-K2*l2p1.x;
    if K1-K2=0 then
    begin //lines do not intersect
      result.Intersection:=false;
      exit;
    end;
    X:=(C2-C1)/(K1-K2);
    Y:=K1*X+C1;
  end;
  result.Intersection:=true; //lines intersect;
  setLength(result.Locations,1);
  result.Locations[0]:=D3DXVector2(X,Y);
  if  PointInRect(X,Y,GetRect(round(l1p1.x),round(l1p1.y),round(l1p2.x),round(l1p2.y)))
  and PointInRect(X,Y,GetRect(round(l2p1.x),round(l2p1.y),round(l2p2.x),round(l2p2.y)))
  then
  begin
    Result.InSegment := true;
  end;
end;
function QuadInQuad(Quad1,Quad2: TQuad): boolean;
var
  i: integer;
begin
  result:=false;
  for i:=0 to 3 do
  if PointInPolygon(Quad1,Quad2[i])
  or PointInPolygon(Quad2,Quad1[i])
  then
  result:=true;
end;
function LineInCircle(p1,p2,pC: TPoint; Rad: integer): boolean;
var
  xpl1,ypl1: single;
  K: single;
  PerimP1,PerimP2: TPoint;
begin
  if (distance_dbl(p1.X,p1.Y,0,pC.X,pC.Y,0)<=Rad)
  or (distance_dbl(p2.X,p2.Y,0,pC.X,pC.Y,0)<=Rad)
  then
  begin
    result:=true;
    exit;
  end;
  if (p2.Y-p1.Y)=0 then
  begin
    xpl1:=0;
    ypl1:=rad;
  end
  else
  if (p1.X-p2.X)=0 then
  begin
    ypl1:=0;
    xpl1:=rad;
  end
  else
  begin
    K:=1/((p2.Y-p1.Y)/(p1.X-p2.X));
    xpl1:=Sqrt(Sqr(rad)/(Sqr(k)+1));
    ypl1:=Sqrt(Sqr(rad)/(Sqr(k)+1))*k;
  end;
  PerimP1:=Point(pC.X+round(xpl1),pC.Y+round(ypl1));
  PerimP2:=Point(pC.X+round(-xpl1),pC.Y+round(-ypl1));
  result:=LinesIntersect(p1,p2,PerimP1,PerimP2);
end;

function CircleVsQuad(var Circle1: TCircle; const Quad1: TQuad): boolean;
type
  TLine = record
    Pts: array[0..1] of PD3DXVector2;
    N: PD3DXVector2; 
    Dist: single;
    CP: TD3DXVector2;
    Seg: boolean;
  end;
  function Line(v1, v2, N: PD3DXVector2): TLine;
  begin
    result.Pts[0] := v1; 
    result.Pts[1] := v2;
    result.N := N;
  end;
var
  Normals: array[0..3] of TD3DXVector2;
  Center: TD3DXVector2;
  Dir: TD3DXVector2;
  mat: TD3DXMatrix;
  i: integer;
  Lines: array[0..3] of TLine;
  LinesF: array of TLine;
  FinalLine: integer;
  MinDist: single;
begin
  Center := D3DXVector2(0,0);
  for i := 0 to 3 do
  Center := D3DXVector2(Center.x + Quad1[i].x, Center.y + Quad1[i].y);
  Center := D3DXVector2(Center.x / 4, Center.y / 4); 
  D3DXMatrixRotationZ(mat, -pi/2);
  Normals[0] := D3DXVec2Subtract(Quad1[1],Quad1[0]);
  Normals[1] := D3DXVec2Subtract(Quad1[2],Quad1[1]); 
  Normals[2] := D3DXVec2Subtract(Quad1[3],Quad1[2]); 
  Normals[3] := D3DXVec2Subtract(Quad1[0],Quad1[3]);
  for i := 0 to 3 do 
  begin
    D3DXVec2TransformCoord(Normals[i], Normals[i], mat);
    D3DXVec2Normalize(Normals[i], Normals[i]); 
  end;
  Dir := D3DXVec2Subtract(Center, D3DXVector2(Circle1.x, Circle1.y));
  D3DXVec2Normalize(Dir, Dir);
  Lines[0] := Line(@Quad1[0], @Quad1[1], @Normals[0]);
  Lines[1] := Line(@Quad1[1], @Quad1[2], @Normals[1]);
  Lines[2] := Line(@Quad1[2], @Quad1[3], @Normals[2]);
  Lines[3] := Line(@Quad1[3], @Quad1[0], @Normals[3]);
  for i := 0 to 3 do
  if D3DXVec2Dot(Dir, Lines[i].N^) < 0 then
  begin
    setlength(linesf, length(linesf) + 1);
    linesf[high(linesf)] := Line(Lines[i].Pts[0], Lines[i].Pts[1], Lines[i].N);
    linesf[high(linesf)].Dist := PointLineDistance(
      Linesf[high(linesf)].Pts[0]^, Linesf[high(linesf)].Pts[1]^,
      D3DXVector2(Circle1.x, Circle1.y), Linesf[high(linesf)].CP, Linesf[high(linesf)].Seg
    );
  end;
  FinalLine := -1;
  MinDist := high(integer);
  for i := 0 to high(Linesf) do
  if (Linesf[i].Seg) and (Linesf[i].Dist < MinDist) then
  begin
    FinalLine := i;
    MinDist := Linesf[i].Dist;
  end;
  if FinalLine > -1 then
  begin
    Dir := D3DXVec2Subtract(Linesf[FinalLine].CP, D3DXVector2(Circle1.x, Circle1.y));
    D3DXVec2Normalize(Dir, Dir);
    if (D3DXVec2Dot(Dir, Linesf[FinalLine].N^) > 0) or (Linesf[FinalLine].Dist < Circle1.radius) then
    begin
      Circle1.x := Linesf[FinalLine].CP.x + Linesf[FinalLine].N^.x * Circle1.radius;
      Circle1.y := Linesf[FinalLine].CP.y + Linesf[FinalLine].N^.y * Circle1.radius;
    end;
  end;
  for i := 0 to 3 do
  if distance_dbl(Quad1[i].x, Quad1[i].y, 0, Circle1.x, Circle1.y, 0) < Circle1.radius then
  begin
    Dir := D3DXVec2Subtract(D3DXVector2(Circle1.x, Circle1.y), Quad1[i]);
    D3DXVec2Normalize(Dir, Dir);
    Circle1.x := Quad1[i].x + Dir.x * Circle1.radius;
    Circle1.y := Quad1[i].y + Dir.y * Circle1.radius;
  end;
end;


function PointLineDistance(
    const lineV1, lineV2, pt: TD3DXVector2;
    var Intersection: TD3DXVector2;
    var InSegment: boolean
  ): single;
var
  u: single;
begin
  u := ((pt.x - lineV1.x)*(lineV2.x - lineV1.x) + (pt.y - lineV1.y)*(lineV2.y - lineV1.y)) /
  (Sqr(lineV2.x - lineV1.x) + Sqr(lineV2.y - lineV1.y));
  Intersection := D3DXVector2(
    lineV1.x + u * (lineV2.x - lineV1.x),
    lineV1.y + u * (lineV2.y - lineV1.y)
  );
  InSegment := (u>=0) and (u<=1);
  result := distance_dbl(pt.x,pt.y,0,Intersection.x,Intersection.y,0);
end;

function GetRect(const x1,y1,x2,y2: integer): TRect;
var
  L1,R1,T1,B1: integer;
begin
  if x1<=x2 then
  begin
    L1:=x1;
    R1:=x2;
  end
  else
  begin
    L1:=x2;
    R1:=x1;
  end;
  if y1<=y2 then
  begin
    T1:=y1;
    B1:=y2;
  end
  else
  begin
    T1:=y2;
    B1:=y1;
  end;
  Result:=Rect(L1,T1,R1,B1);
end;

function RectInRect(const R1,R2: TRect): boolean;
begin
  Result :=
  (R1.Right >= R2.Left) and
  (R1.Left <= R2.Right) and
  (R1.Bottom >= R2.Top) and
  (R1.Top <= R2.Bottom);
end;
function PointInRect(const x, y: single; const R: TRect): boolean;
begin
  Result :=
  (x >= R.Left) and
  (x <= R.Right) and
  (y >= R.Top) and
  (y <= R.Bottom);
end;
function PointInRect(const x, y: single; const Rleft,Rtop,Rright,Rbottom: single): boolean;
begin
  Result :=
  (x >= RLeft) and
  (x <= RRight) and
  (y >= RTop) and
  (y <= RBottom);
end;
function PointInTriangle(x,y:integer; const Triangle: array of TD3DXVector2): boolean;
var
i: byte;
x1,y1,x2,y2: single;
cnX,cnY: integer;
k: single;
cnunder, Cunder, Con, Cnon: boolean;
begin
  cnX:=round((Triangle[0].X+Triangle[1].X+Triangle[2].X)/3);
  cnY:=round((Triangle[0].Y+Triangle[1].Y+Triangle[2].Y)/3);
  for i:=0 to high(Triangle) do
  begin
    //define x's and y's
    x1:=Triangle[i].X;
    y1:=Triangle[i].Y;
    if i=high(Triangle) then
    begin
      x2:=Triangle[0].X;
      y2:=Triangle[0].Y;
    end
    else
    begin
      x2:=Triangle[i+1].X;
      y2:=Triangle[i+1].Y;
    end;
    //
    if (x1=x2)then
    begin
      Cnunder:=cnX>x1;
      Cunder:=X>x1;
      Cnon:=cnX=x1;
      Con:=X=x1;
    end
    else
    begin
      k:=(y2-y1)/(x2-x1);
      Cnunder:=(cnY-y1)>(cnX-x1)*k;
      Cunder:=(Y-y1)>(X-x1)*k;
      Con:=(Y-y1)=(X-x1)*k;
      Cnon:=(cnY-y1)=(cnX-x1)*k;
    end;
    if (Cunder<>CNunder)and not(Con and Cnon) then
    begin
      result:=false;
      exit;
    end;
  end;
  result:=true;
end;

function limit_int(num,min,max: integer):integer;
begin
  if num<min then result:=min
  else if num>max then result:=max
  else result:=num;
end;
function limit_dbl(num,min,max: double):double;
begin
  if num<min then result:=min
  else if num>max then result:=max
  else result:=num;
end;

function getAngDeg(x1,y1,x2,y2: single): single;
begin
  result := RadToDeg(ArcTan2(y2 - y1, x2 - x1));
end;

function getAngRad(x1,y1,x2,y2: single): single;
begin
  result := ArcTan2(y2 - y1, x2 - x1);
end;

function GetAng3D(v1, v2: TD3DXVector3): TD3DXQuaternion;
var
  v3: TD3DXVector3;
  m: TD3DXMatrix;
begin
  D3DXVec3Cross(v3, v1, v2);
  D3DXVec3Normalize(v3, v3);
  D3DXMatrixLookAtRH(
    m,
    D3DXVector3(0, 0, 0),
    v3,
    v2
  );
  Result.x := v3.x;
  Result.y := v3.y;
  Result.z := v3.z;
  D3DXVec3TransformCoord(v3, v1, m);
  Result.w := GetAngRad(0, 0, v3.x, v3.y) - pi / 2;
end;

function RayVsTriangle(
      RayOrigin, RayDir, TriV1, TriV2, TriV3 : TD3DXVector3;
      var t, u, v: single
    ): boolean;
var
  edge1, edge2 : TD3DXVector3;
  pvec, tvec, qvec : TD3DXVector3;
  det, invDet : single;
begin
  Result := false;

  D3DXVec3Subtract(edge1,TriV2,TriV1);
  D3DXVec3Subtract(edge2,TriV3,TriV1);

  D3DXVec3Cross(pvec, RayDir, edge2);

  det := D3DXVec3Dot(edge1, pvec);
  if (det < 0.0001) then exit;

  D3DXVec3Subtract(tvec,RayOrigin,TriV1);

  u := D3DXVec3Dot(tvec, pvec);
  if (u < 0.0) or (u > det) then exit;

  D3DXVec3Cross(qvec, tvec, edge1);

  v := D3DXVec3Dot(RayDir, qvec);
  if (v < 0.0) or (u + v > det) then exit;

  t := D3DXVec3Dot(edge2, qvec);
  invDet := 1.0 / det;
  t := t * invDet;
  u := u * invDet;
  v := v * invDet;

  Result := true;
end;

function VectorToDJXColor(Vec: TD3DXVector3): TDJXColor;
{$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
begin
  result := DJXColor(trunc(Vec.x*127+128),trunc(Vec.y*127+128),trunc(Vec.z*127+128));
end;

function ReflectVec2(Vec: TD3DXVector2; Normal: TD3DXVector2): TD3DXVector2;
var
  Norm: TD3DXVector2;
  Dir: TD3DXVector2;
  Dot: single;
begin
  D3DXVec2Normalize(Norm, Normal);
  Dot := D3DXVec2Dot(Vec, Norm);
  Result := D3DXVector2(
    (Vec.x - 2 * Norm.x * Dot),
    (Vec.y - 2 * Norm.y * Dot)
  );
end;

procedure CreateTangentSpaceVectors(
      const v1: TD3DXVector3;
      const v2: TD3DXVector3;
      const v3: TD3DXVector3;
      const v1u, v1v: single;
      const v2u, v2v: single;
      const v3u, v3v: single;
      var vTangent: TD3DXVector3;
      var vBiNormal: TD3DXVector3;
      var vNormal: TD3DXVector3
    );
var
  vDirVec_v2_to_v1,
  vDirVec_v3_to_v1: TD3DXVector3;
  vDirVec_v2u_to_v1u,
  vDirVec_v2v_to_v1v,
  vDirVec_v3u_to_v1u,
  vDirVec_v3v_to_v1v: single;
  fDenominator: single;
  fScale1,fScale2: single;
  T,B,N: TD3DXVector3;
  vTemp: TD3DXVector3;
begin
  D3DXVec3Subtract(vDirVec_v2_to_v1,v2,v1);
  D3DXVec3Subtract(vDirVec_v3_to_v1,v3,v1);

  vDirVec_v2u_to_v1u:=v2u-v1u;
  vDirVec_v2v_to_v1v:=v2v-v1v;

  vDirVec_v3u_to_v1u:=v3u-v1u;
  vDirVec_v3v_to_v1v:=v3v-v1v;

  fDenominator:=vDirVec_v2u_to_v1u * vDirVec_v3v_to_v1v - vDirVec_v3u_to_v1u * vDirVec_v2v_to_v1v;

  if( fDenominator < 0.0001) and (fDenominator > -0.0001 ) then
  begin
    vTangent  := D3DXVECTOR3( 1.0, 0.0, 0.0 );
    vBiNormal := D3DXVECTOR3( 0.0, 1.0, 0.0 );
    vNormal   := D3DXVECTOR3( 0.0, 0.0, 1.0 );
  end
  else
  begin
    fScale1:=1.0/fDenominator;

    T:=D3DXVECTOR3(
      (vDirVec_v3v_to_v1v * vDirVec_v2_to_v1.x - vDirVec_v2v_to_v1v * vDirVec_v3_to_v1.x) * fScale1,
      (vDirVec_v3v_to_v1v * vDirVec_v2_to_v1.y - vDirVec_v2v_to_v1v * vDirVec_v3_to_v1.y) * fScale1,
      (vDirVec_v3v_to_v1v * vDirVec_v2_to_v1.z - vDirVec_v2v_to_v1v * vDirVec_v3_to_v1.z) * fScale1
    );

    B:=D3DXVECTOR3(
      (-vDirVec_v3u_to_v1u * vDirVec_v2_to_v1.x + vDirVec_v2u_to_v1u * vDirVec_v3_to_v1.x) * fScale1,
      (-vDirVec_v3u_to_v1u * vDirVec_v2_to_v1.y + vDirVec_v2u_to_v1u * vDirVec_v3_to_v1.y) * fScale1,
      (-vDirVec_v3u_to_v1u * vDirVec_v2_to_v1.z + vDirVec_v2u_to_v1u * vDirVec_v3_to_v1.z) * fScale1
    );

    D3DXVec3Cross(N,T,B);

    fScale2:=1.0/(
      (T.x * B.y * N.z - T.z * B.y * N.x) +
      (B.x * N.y * T.z - B.z * N.y * T.x) +
      (N.x * T.y * B.z - N.z * T.y * B.x)
    );

    vTangent.x :=   D3DXVec3Cross(vTemp, B, N ).x * fScale2;
    vTangent.y := -(D3DXVec3Cross(vTemp, N, T ).x * fScale2);
    vTangent.z :=   D3DXVec3Cross(vTemp, T, B ).x * fScale2;
    D3DXVec3Normalize( vTangent, vTangent );

    vBiNormal.x := -(D3DXVec3Cross( vTemp, B, N ).y * fScale2);
    vBiNormal.y :=   D3DXVec3Cross( vTemp, N, T ).y * fScale2;
    vBiNormal.z := -(D3DXVec3Cross( vTemp, T, B ).y * fScale2);
    D3DXVec3Normalize( vBiNormal, vBiNormal );

    vNormal.x :=   D3DXVec3Cross( vTemp, B, N ).z * fScale2;
    vNormal.y := -(D3DXVec3Cross( vTemp, N, T ).z * fScale2);
    vNormal.z :=   D3DXVec3Cross( vTemp, T, B ).z * fScale2;
    D3DXVec3Normalize( vNormal, vNormal );
  end;
end;

function LoadVertexShaderFromFile(
      const f: string;
      const Device: IDirect3DDevice9;
      var ErrorStr: string
    ): IDirect3DVertexShader9;
var
  ShaderBuffer: ID3DXBuffer;
  ErrorBuffer: ID3DXBuffer;
begin
  ErrorStr := '';
  if FAILED(D3DXAssembleShaderFromFile(PChar(f), nil, nil, 0, @ShaderBuffer, @ErrorBuffer)) then
  begin
    setlength(ErrorStr,ErrorBuffer.GetBufferSize);
    move(Pchar(ErrorBuffer.GetBufferPointer)^, ErrorStr[1], ErrorBuffer.GetBufferSize);
    safe_release(ErrorBuffer);
    exit;
  end;
  Device.CreateVertexShader(ShaderBuffer.GetBufferPointer, result);
  safe_release(ShaderBuffer);
end;

function LoadVertexShaderFromFileC(
      const f: string;
      const Device: IDirect3DDevice9
    ): IDirect3DVertexShader9;
var
  FStream: TFileStream;
  ShaderBuffer: array of byte;
begin
  FStream := TFileStream.Create(f, fmOpenRead);
  setlength(ShaderBuffer, FStream.Size);
  FStream.Position := 0;
  FStream.ReadBuffer(ShaderBuffer[0], FStream.Size);
  Device.CreateVertexShader(@ShaderBuffer[0],result);
  FStream.Free;
end;

function LoadPixelShaderFromFile(
      const f: string;
      const Device: IDirect3DDevice9;
      var ErrorStr: string
    ): IDirect3DPixelShader9;
var
  ShaderBuffer: ID3DXBuffer;
  ErrorBuffer: ID3DXBuffer;
begin
  ErrorStr := '';
  if FAILED(D3DXAssembleShaderFromFile(PChar(f), nil, nil, 0, @ShaderBuffer, @ErrorBuffer)) then
  begin
    setlength(ErrorStr,ErrorBuffer.GetBufferSize);
    move(Pchar(ErrorBuffer.GetBufferPointer)^, ErrorStr[1], ErrorBuffer.GetBufferSize);
    safe_release(ErrorBuffer);
    exit;
  end;
  Device.CreatePixelShader(ShaderBuffer.GetBufferPointer,result);
  safe_release(ShaderBuffer);
end;

function LoadPixelShaderFromFileC(
      const f: string;
      const Device: IDirect3DDevice9
    ): IDirect3DPixelShader9;
var
  FStream: TFileStream;
  ShaderBuffer: array of byte;
begin
  FStream := TFileStream.Create(f, fmOpenRead);
  setlength(ShaderBuffer, FStream.Size);
  FStream.Position := 0;
  FStream.ReadBuffer(ShaderBuffer[0], FStream.Size);
  Device.CreatePixelShader(@ShaderBuffer[0],result);
  FStream.Free;
end;

function CreateVertexDeclarationFromFVF(
      Device: IDirect3DDevice9;
      const FVF: cardinal
    ): IDirect3DVertexDeclaration9;
var
  declaration: TFVFDeclaration;
begin
  D3DXDeclaratorFromFVF(FVF, declaration);
  Device.CreateVertexDeclaration(@declaration[0], result);
end;

function CreateVertexDeclaration(
      Device: IDirect3DDevice9;
      const Decl: TFVFDeclaration
    ): IDirect3DVertexDeclaration9;
begin
  Device.CreateVertexDeclaration(@Decl[0], result);
end;

function D3DVertexElement(
    Stream:     Word;
    Offset:     Word;
    _Type:      TD3DDeclType;
    Method:     TD3DDeclMethod;
    Usage:      TD3DDeclUsage;
    UsageIndex: byte
  ): TD3DVertexElement9;
begin
  result.Stream := Stream;
  result.Offset := Offset;
  result._Type := _Type;
  result.Method := Method;
  result.Usage := Usage;
  result.UsageIndex := UsageIndex;
end;

function GetTexCoordSetsCount(dwFVF: DWORD): DWORD;
begin
  result := 0;
  if dwFVF and D3DFVF_TEX1 = D3DFVF_TEX1 then result := 1;
  if dwFVF and D3DFVF_TEX2 = D3DFVF_TEX2 then result := 2;
  if dwFVF and D3DFVF_TEX3 = D3DFVF_TEX3 then result := 3;
  if dwFVF and D3DFVF_TEX4 = D3DFVF_TEX4 then result := 4;
  if dwFVF and D3DFVF_TEX5 = D3DFVF_TEX5 then result := 5;
  if dwFVF and D3DFVF_TEX6 = D3DFVF_TEX6 then result := 6;
  if dwFVF and D3DFVF_TEX7 = D3DFVF_TEX7 then result := 7;
  if dwFVF and D3DFVF_TEX8 = D3DFVF_TEX8 then result := 8;
  //result := ((dwFVF and D3DFVF_TEXCOUNT_MASK) shl D3DFVF_TEXCOUNT_SHIFT);
end;

function GetFVFComponentOffset(dwFVF: DWORD; dwFVFComponent: DWORD; iTexCoordIndex: byte = 0): DWORD;
var
  oCur: DWORD;
	dwPosition: DWORD;
  cTexCoords: byte;
  i: byte;
  size: byte;
const
	FloatSize: BYTE = sizeof(single);
	DWORDSize: BYTE = sizeof(DWORD);
  function GetTexCoordSetSize(dwFVF: DWORD; Index: byte): DWORD;
  const
    x_rgdwTexCoordSize: array[0..3] of DWORD = (8, 12, 16, 4);
  begin
    if dwFVF and D3DFVF_TEXCOUNT_MASK = 0 then
    begin
      result := 0;
      exit;
    end;
    result := x_rgdwTexCoordSize[(dwFVF shr (16 + Index * 2)) and $3];
  end;
begin
	if (dwFVF = 0) then
	begin
    result := $FFFFFFFF;
    exit;
  end;
	if (((dwFVFComponent and dwFVF) <> dwFVFComponent) and (dwFVFComponent <> 0)) then
	begin
  	result := $FFFFFFFF;
    exit;
  end;
	oCur := 0;
	dwPosition := dwFVF and D3DFVF_POSITION_MASK;
	if (dwFVFComponent <> 0) and (dwPosition = dwFVFComponent) then
  begin
    result := oCur;
    exit;
  end;
	case dwPosition of
	  D3DFVF_XYZ: oCur := oCur + 3 * FloatSize;
	  D3DFVF_XYZRHW: oCur := oCur + 4 * FloatSize;
	  D3DFVF_XYZB1: oCur := oCur + 3 * FloatSize + FloatSize;
	  D3DFVF_XYZB2: oCur := oCur + 3 * FloatSize + 2 * FloatSize;
	  D3DFVF_XYZB3: oCur := oCur + 3 * FloatSize + 3 * FloatSize;
	  D3DFVF_XYZB4: oCur := oCur + 3 * FloatSize + 4 * FloatSize;
	  D3DFVF_XYZB5: oCur := oCur + 3 * FloatSize + 5 * FloatSize;
	end;
	if D3DFVF_NORMAL = dwFVFComponent then
  begin
    result := oCur;
    exit;
  end;
	if dwFVF and D3DFVF_NORMAL > 0 then
  oCur := oCur + 3*FloatSize;
	if D3DFVF_PSIZE = dwFVFComponent then
  begin
    result := oCur;
    exit;
  end;
	if dwFVF and D3DFVF_PSIZE > 0 then
  oCur := oCur + FloatSize;
	if D3DFVF_DIFFUSE = dwFVFComponent then
  begin
    result := oCur;
    exit;
  end;
	if dwFVF and D3DFVF_DIFFUSE > 0 then
  oCur := oCur + DWORDSize;
	if D3DFVF_SPECULAR = dwFVFComponent then
  begin
    result := oCur;
    exit;
  end;
	if dwFVF and D3DFVF_SPECULAR > 0 then
  oCur := oCur + DWORDSize;
	cTexCoords := BYTE(GetTexCoordSetsCount(dwFVF));
	if ( cTexCoords = 0 ) then
  begin
		result :=  $FFFFFFFF;
    exit;
	end;
	for i := 0 to cTexCoords - 1 do
  begin
		Size := BYTE(GetTexCoordSetSize(dwFVF,i));
		if (Size = 0)	then
    begin
      result := $FFFFFFFF;
      exit;
    end;
		if (Size = FloatSize) then
		begin
			if DWORD(D3DFVF_TEXCOORDSIZE1(i)) = dwFVFComponent then
      begin
        result := oCur;
        exit;
      end;
			oCur := oCur + FloatSize;
		end;
		if (Size = FloatSize * 2) then
    begin
			if (i = iTexCoordIndex) then
      begin
				if DWORD(D3DFVF_TEXCOORDSIZE2(i)) = dwFVFComponent then
        begin
          result := oCur;
          exit;
        end;
			end;
			oCur := oCur + FloatSize * 2;
		end;
		if (Size = FloatSize * 3)  then
		begin
			if DWORD(D3DFVF_TEXCOORDSIZE3(i)) = dwFVFComponent then
      begin
        result := oCur;
        exit;
      end;
			oCur := oCur + FloatSize * 3;
    end;
		if (Size = FloatSize * 4) then
    begin
			if DWORD(D3DFVF_TEXCOORDSIZE4(i)) = dwFVFComponent then
      begin
        result := oCur;
        exit;
      end;
			oCur := oCur + FloatSize * 4;
		end;
	end;
	result := $FFFFFFFF;
end;

procedure GenerateTextureSpaceMatricesPerVertex(
      Mesh: ID3DXMesh;
      TextureStageIndex: integer;
      MatrixTextureStage: integer
    );
type
  TCVert = packed record
    x,y,z: single;
    nx,ny,nz: single;
    u,v: single;
  end;
var
  VB: IDirect3DVertexBuffer9;
  IB: IDirect3DIndexBuffer9;
  GetIndex: TGetIndexProc;
  IBDesc: TD3DIndexBufferDesc;
  VertexPtr: Pointer;
  IndexPtr: Pointer;
  Index16Ptr: PIndex16Arr;
  Index32Ptr: PIndex32Arr;
  BPV: DWORD;
  i: integer;
  Vertex: TCVert;
  OffsetPos: DWORD;
  OffsetNormal: DWORD;
  OffsetTex: DWORD;
  OffsetTexMatrix: DWORD;
  U, V, UxV: TD3DXVector3;
  Decl: TFVFDeclaration;
  TmpMesh: ID3DXMesh;
  Device: IDirect3DDevice9;
  function GetVertex(Index: integer): TCVert;
  begin
    CopyMemory(
      @result.x,
      Pointer(cardinal(VertexPtr) + GetIndex(IndexPtr, Index) * BPV + OffsetPos),
      sizeof(single)*3
    );
    CopyMemory(
      @result.nx,
      Pointer(cardinal(VertexPtr) + GetIndex(IndexPtr, Index) * BPV + OffsetNormal),
      sizeof(single)*3
    );
    CopyMemory(
      @result.u,
      Pointer(cardinal(VertexPtr) + GetIndex(IndexPtr, Index) * BPV + OffsetTex),
      sizeof(single)*2
    );
  end;
  procedure SetVertex(const Index: integer; const VrtU, VrtV, VrtUxV: TD3DXVector3);
  var
    mat3x3: array[0..2] of TD3DXVector3;
  begin
    move(VrtU, mat3x3[0], sizeof(TD3DXVector3));
    move(VrtV, mat3x3[1], sizeof(TD3DXVector3));
    move(VrtUxV, mat3x3[2], sizeof(TD3DXVector3));
    CopyMemory(
      Pointer(cardinal(VertexPtr) + GetIndex(IndexPtr, Index) * BPV + OffsetTexMatrix),
      @mat3x3[0],
      sizeof(mat3x3)
    );
  end;
  procedure GetUV(const Index: integer; var VrtU, VrtV: TD3DXVector3);
  var
    mat2x3: array[0..1] of TD3DXVector3;
  begin
    CopyMemory(
      @mat2x3[0],
      Pointer(cardinal(VertexPtr) + GetIndex(IndexPtr, Index) * BPV + OffsetTexMatrix),
      sizeof(mat2x3)
    );
    move(mat2x3[0], VrtU, sizeof(TD3DXVector3));
    move(mat2x3[1], VrtV, sizeof(TD3DXVector3)); 
  end;
begin
  OffsetPos := $ffffffff;
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZ);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB1);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB2);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB3);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB4);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB5);
  if OffsetPos = $ffffffff then exit;
  OffsetNormal := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_NORMAL);
  if OffsetNormal = $ffffffff then exit;
  OffsetTex := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_TEXCOORDSIZE2(TextureStageIndex),TextureStageIndex);
  if OffsetTex = $ffffffff then exit;
  OffsetTexMatrix := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_TEXCOORDSIZE3(MatrixTextureStage),MatrixTextureStage);
  if OffsetTexMatrix = $ffffffff then exit;
  Mesh.GetVertexBuffer(VB);
  Mesh.GetIndexBuffer(IB);
  BPV := Mesh.GetNumBytesPerVertex;
  VB.Lock(0,Mesh.GetNumVertices * BPV, VertexPtr, 0);
  IB.GetDesc(IBDesc);
  if IBDesc.Format = D3DFMT_INDEX16 then
  begin
    IB.Lock(0, Mesh.GetNumFaces*3*2, Pointer(Index16Ptr), D3DLOCK_READONLY);
    GetIndex := GetIndex16;
    IndexPtr := Index16Ptr;
  end
  else
  if IBDesc.Format = D3DFMT_INDEX32 then
  begin
    IB.Lock(0, Mesh.GetNumFaces*3*4, Pointer(Index32Ptr), D3DLOCK_READONLY);
    GetIndex := GetIndex32;
    IndexPtr := Index32Ptr;
  end
  else
  exit;
  Mesh.GetDeclaration(Decl);
  i := 0;
  while not (
    (Decl[i].Stream = D3DDECL_END.Stream)
    and (Decl[i].Offset = D3DDECL_END.Offset)
    and (Decl[i]._Type = D3DDECL_END._Type)
    and (Decl[i].Method = D3DDECL_END.Method)
    and (Decl[i].Usage = D3DDECL_END.Usage)
    and (Decl[i].UsageIndex = D3DDECL_END.UsageIndex)
  )
  and (i <= high(Decl)) do
  begin
    if Decl[i].UsageIndex = MatrixTextureStage then
    Decl[i].Usage := D3DDECLUSAGE_TANGENT;
    if Decl[i].UsageIndex = MatrixTextureStage + 1 then
    Decl[i].Usage := D3DDECLUSAGE_BINORMAL;
    inc(i);
  end;
  Mesh.GetDevice(Device);
  if FAILED(
    Mesh.CloneMesh(
      Mesh.GetOptions, @Decl[0], Device, TmpMesh
    )
  )
  then exit;
  safe_release(Mesh);
  Mesh := TmpMesh;
  safe_release(TmpMesh);
  if failed(
    D3DXComputeTangent(Mesh, TextureStageIndex, MatrixTextureStage, MatrixTextureStage + 1, 0, nil)
  ) then
  exit;
  for i := 0 to Mesh.GetNumVertices - 1 do
  begin
    Vertex := GetVertex(i);

    GetUV(i,U,V);

    D3DXVec3Cross(UxV, U, V);

    if D3DXVec3Dot(UxV, D3DXVector3(Vertex.nx, Vertex.ny, Vertex.nz)) < 0 then
    UxV := D3DXVector3(-UxV.x,-UxV.y,-UxV.z);

    SetVertex(i, U, V, UxV);
  end;
  VB.Unlock;
  IB.Unlock;
end;

procedure MatrixLerp(
      out OutMat: TD3DXMatrix;
      const Mat1, Mat2: TD3DXMatrix;
      const Grad: single
    );
var
  m: TD3DXMatrix;
begin
  D3DXMatrixSubtract(m, Mat2, Mat1);
  D3DXMatrixMul(m, m, Grad);
  D3DXMatrixAdd(m, Mat1, m);
  OutMat := m;
end;

procedure MatrixInterpolate(
      out OutMat: TD3DXMatrix;
      const Mat1, Mat2: TD3DXMatrix;
      const Grad: single
    );
var
  Scale, Scale1, Scale2: TD3DXVector3;
  Rotation, Rotation1, Rotation2: TD3DXQuaternion;
  Translation, Translation1, Translation2: TD3DXVector3;
  m: TD3DXMatrix;
begin
  D3DXMatrixDecompose(@Scale1, @Rotation1, @Translation1, Mat1);
  D3DXMatrixDecompose(@Scale2, @Rotation2, @Translation2, Mat2);
  D3DXVec3Lerp(Scale, Scale1, Scale2, Grad);
  D3DXQuaternionSlerp(Rotation, Rotation1, Rotation2, Grad);
  Rotation.x := -Rotation.x; Rotation.y := -Rotation.y; Rotation.z := -Rotation.z;
  D3DXVec3Lerp(Translation, Translation1, translation2, Grad);
  D3DXMatrixIdentity(OutMat);
  D3DXMatrixIdentity(m);
  D3DXMatrixScaling(m, Scale.x, Scale.y, Scale.z);
  D3DXMatrixMultiply(OutMat, OutMat, m);
  D3DXMatrixRotationQuaternion(m, Rotation);
  D3DXMatrixMultiply(OutMat, OutMat, m);
  D3DXMatrixTranslation(m, Translation.x, Translation.y, Translation.z);
  D3DXMatrixMultiply(OutMat, OutMat, m);
end;

function MatrixGenerate(
      const Scale: TD3DXVector3;
      const Rotation: TD3DXQuaternion;
      const Translation: TD3DXVector3
    ): TD3DXMatrix;
var
  m: TD3DXMatrix;
begin
  D3DXMatrixIdentity(Result);
  D3DXMatrixScaling(m, Scale.x, Scale.y, Scale.z);
  D3DXMatrixMultiply(Result, Result, m);
  D3DXMatrixRotationQuaternion(m, Rotation);
  D3DXMatrixMultiply(Result, Result, m);
  D3DXMatrixTranslation(m, Translation.x, Translation.y, Translation.z);
  D3DXMatrixMultiply(Result, Result, m);
end;

procedure GenerateTextureSpaceMatrices(
      Mesh: ID3DXMesh;
      TextureStageIndex: integer;
      MatrixTextureStage: integer
    );
type
  TCVert = packed record
    x,y,z: single;
    nx,ny,nz: single;
    u,v: single;
  end;
var
  VB: IDirect3DVertexBuffer9;
  IB: IDirect3DIndexBuffer9;
  GetIndex: TGetIndexProc;
  IBDesc: TD3DIndexBufferDesc;
  VertexPtr: Pointer;
  IndexPtr: Pointer;
  Index16Ptr: PIndex16Arr;
  Index32Ptr: PIndex32Arr;
  BPV: DWORD;
  i: integer;
  Vertex1, Vertex2, Vertex3: TCVert;
  Side1, Side2: TD3DXVector3;
  OffsetPos: DWORD;
  OffsetNormal: DWORD;
  OffsetTex: DWORD;
  OffsetTexMatrix: DWORD;
  CrossProduct: TD3DXVector3;
  U, V, UxV: TD3DXVector3;
  function GetVertex(Index: integer): TCVert;
  begin
    CopyMemory(
      @result.x,
      Pointer(cardinal(VertexPtr) + GetIndex(IndexPtr, Index) * BPV + OffsetPos),
      sizeof(single)*3
    );
    CopyMemory(
      @result.nx,
      Pointer(cardinal(VertexPtr) + GetIndex(IndexPtr, Index) * BPV + OffsetNormal),
      sizeof(single)*3
    );
    CopyMemory(
      @result.u,
      Pointer(cardinal(VertexPtr) + GetIndex(IndexPtr, Index) * BPV + OffsetTex),
      sizeof(single)*2
    );
  end;
  procedure SetVertex(Index: integer; VrtU, VrtV, VrtUxV: TD3DXVector3);
  var
    mat3x3: array[0..2] of TD3DXVector3;
  begin
    move(VrtU, mat3x3[0], sizeof(TD3DXVector3));
    move(VrtV, mat3x3[1], sizeof(TD3DXVector3));
    move(VrtUxV, mat3x3[2], sizeof(TD3DXVector3));
    CopyMemory(
      Pointer(cardinal(VertexPtr) + GetIndex(IndexPtr, Index) * BPV + OffsetTexMatrix),
      @mat3x3[0],
      sizeof(mat3x3)
    );
  end;
begin
  OffsetPos := $ffffffff;
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZ);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB1);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB2);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB3);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB4);
  if OffsetPos = $ffffffff then OffsetPos := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_XYZB5);
  if OffsetPos = $ffffffff then exit;
  OffsetNormal := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_NORMAL);
  if OffsetNormal = $ffffffff then exit;
  OffsetTex := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_TEXCOORDSIZE2(TextureStageIndex),TextureStageIndex);
  if OffsetTex = $ffffffff then exit;
  OffsetTexMatrix := GetFVFComponentOffset(Mesh.GetFVF, D3DFVF_TEXCOORDSIZE3(MatrixTextureStage),MatrixTextureStage);
  if OffsetTexMatrix = $ffffffff then exit;
  Mesh.GetVertexBuffer(VB);
  Mesh.GetIndexBuffer(IB);
  BPV := Mesh.GetNumBytesPerVertex;
  VB.Lock(0,Mesh.GetNumVertices * BPV, VertexPtr, 0);
  IB.GetDesc(IBDesc);
  if IBDesc.Format = D3DFMT_INDEX16 then
  begin
    IB.Lock(0, Mesh.GetNumFaces*3*2, Pointer(Index16Ptr), D3DLOCK_READONLY);
    GetIndex := GetIndex16;
    IndexPtr := Index16Ptr;
  end
  else
  if IBDesc.Format = D3DFMT_INDEX32 then
  begin
    IB.Lock(0, Mesh.GetNumFaces*3*4, Pointer(Index32Ptr), D3DLOCK_READONLY);
    GetIndex := GetIndex32;
    IndexPtr := Index32Ptr;
  end
  else
  exit;
  for i := 0 to Mesh.GetNumFaces - 1 do
  begin
    Vertex1 := GetVertex(i * 3 + 0);
    Vertex2 := GetVertex(i * 3 + 1);
    Vertex3 := GetVertex(i * 3 + 2);

    Side1 := D3DXVector3(
      Vertex2.x - Vertex1.x,
      Vertex2.u - Vertex1.u,
      Vertex2.v - Vertex1.v
    );

    Side2 := D3DXVector3(
      Vertex3.x - Vertex1.x,
      Vertex3.u - Vertex1.u,
      Vertex3.v - Vertex1.v
    );
    
    D3DXVec3Cross(CrossProduct, Side1, Side2);

    U.x := - CrossProduct.y / CrossProduct.x;
    V.x := - CrossProduct.z / CrossProduct.x;

    Side1 := D3DXVector3(
      Vertex2.y - Vertex1.y,
      Vertex2.u - Vertex1.u,
      Vertex2.v - Vertex1.v
    );

    Side2 := D3DXVector3(
      Vertex3.y - Vertex1.y,
      Vertex3.u - Vertex1.u,
      Vertex3.v - Vertex1.v
    );

    D3DXVec3Cross(CrossProduct, Side1, Side2);

    U.y := - CrossProduct.y / CrossProduct.x;
    V.y := - CrossProduct.z / CrossProduct.x;

    Side1 := D3DXVector3(
      Vertex2.z - Vertex1.z,
      Vertex2.u - Vertex1.u,
      Vertex2.v - Vertex1.v
    );

    Side2 := D3DXVector3(
      Vertex3.z - Vertex1.z,
      Vertex3.u - Vertex1.u,
      Vertex3.v - Vertex1.v
    );

    D3DXVec3Cross(CrossProduct, Side1, Side2);

    U.z := - CrossProduct.y / CrossProduct.x;
    V.z := - CrossProduct.z / CrossProduct.x;

    D3DXVec3Normalize(U, U);
    D3DXVec3Normalize(V, V);

    D3DXVec3Cross(UxV, U, V);

    if D3DXVec3Dot(UxV, D3DXVector3(Vertex1.nx,Vertex1.ny, Vertex1.nz)) < 0 then
    UxV := D3DXVector3(-UxV.x,-UxV.y,-UxV.z);

    SetVertex(i * 3 + 0, U, V, UxV);
    SetVertex(i * 3 + 1, U, V, UxV);
    SetVertex(i * 3 + 2, U, V, UxV);
  end;
  VB.Unlock;
  IB.Unlock;
end;

function GetIndex16(IBPtr: Pointer; Ind: DWORD): DWORD;
begin
  result := PIndex16Arr(IBPtr)^[Ind];
end;
function GetIndex32(IBPtr: Pointer; Ind: DWORD): DWORD;
begin
  result := PIndex32Arr(IBPtr)^[Ind];
end;

procedure ThrowError(ErrorMsg: string);
begin
  MessageDlg(ErrorMsg, mtError, [mbOK], 0);
end;

procedure ThrowMessage(ErrorMsg: string);
begin
  MessageDlg(ErrorMsg, mtInformation, [mbOK], 0);
end;

function ThrowYesNo(ErrorMsg: string): integer;
begin
  result := MessageDlg(ErrorMsg, mtInformation, [mbYes, mbNo], 0);
end;

function GetPITime(Amp: single = 1000): single;
begin
  result := (round(GetTickCount) mod round(pi * 2 * Amp)) / (Amp);
end;

function GetTimeInterval(Interval: DWORD = 1000): single;
begin
  result := (GetTickCount mod Interval) / Interval;
end;

function GetRandomPi: single;
begin
  Result := Random(Round(Pi * 1000)) / 1000;
end;

function GetRandom2Pi: single;
begin
  Result := Random(Round(2 * Pi * 1000)) / 1000;
end;

procedure SinCosConstants(var Vec1, Vec2: TD3DXVector4);
begin
  Vec1 := D3DXVector4(
    1 / (Factorial(7) * 128),
    1 / (Factorial(6) * 64),
    1 / (Factorial(4) * 16),
    1 / (Factorial(5) * 16)
  ); 

  Vec2 := D3DXVector4(
    1 / (Factorial(3) * 8),
    1 / (Factorial(2) * 8),
    1,
    0.5
  );
end;

function Factorial(Num: integer): integer;
var
  i: integer;
begin
  if Num < 0 then result := -1
  else
  if Num = 0 then result := 1
  else
  begin
    result := 1;
    for i := 2 to Num do
    result := result * i;
  end;
end;

function GenerateShadowMesh(
      const pd3dDevice: IDirect3DDevice9;
      const pMesh: ID3DXMesh;
      out ppOutMesh: ID3DXMesh
    ): HRESULT;
type
  PShadowVert = ^TShadowVert;
  TShadowVert = packed record
    Position: TD3DXVector3;
    Normal: TD3DXVector3;
  end;
  PEdgeMapping = ^TEdgeMapping;
  TEdgeMapping = record
    m_anOldEdge: array[0..1] of Integer;
    m_aanNewEdge: array[0..1, 0..1] of Integer;
  end;
  PShadowVertArray = ^TShadowVertArray;
  TShadowVertArray = array[0..MaxInt div SizeOf(TShadowVert)-1] of TShadowVert;
const
  TShadowVert_Decl: array [0..2] of TD3DVertexElement9 =
  (
    (Stream: 0; Offset: 0;  _Type: D3DDECLTYPE_FLOAT3; Method: D3DDECLMETHOD_DEFAULT; Usage: D3DDECLUSAGE_POSITION; UsageIndex: 0),
    (Stream: 0; Offset: 12;  _Type: D3DDECLTYPE_FLOAT3; Method: D3DDECLMETHOD_DEFAULT; Usage: D3DDECLUSAGE_NORMAL; UsageIndex: 0),
    {D3DDECL_END()}(Stream:$FF; Offset:0; _Type:D3DDECLTYPE_UNUSED; Method:TD3DDeclMethod(0); Usage:TD3DDeclUsage(0); UsageIndex:0)
  );
  ADJACENCY_EPSILON = 0.0001;
  function EdgeMapping: TEdgeMapping;
  begin
    with Result do
    begin
      FillMemory(@m_anOldEdge, SizeOf(m_anOldEdge), $FF);
      FillMemory(@m_aanNewEdge, SizeOf(m_aanNewEdge), $FF);
    end;
  end;
  function FindEdgeInMappingTable(nV1, nV2: Integer; var pMapping: array of TEdgeMapping; nCount: Integer): Integer;
  var
    i: Integer;
  begin
    for i := 0 to nCount-1 do
    begin
      // If both vertex indexes of the old edge in mapping entry are -1, then
      // we have searched every valid entry without finding a match.  Return
      // this index as a newly created entry.
      if ((pMapping[i].m_anOldEdge[0] = -1) and (pMapping[i].m_anOldEdge[1] = -1) or
          // Or if we find a match, return the index.
          (pMapping[i].m_anOldEdge[1] = nV1) and (pMapping[i].m_anOldEdge[0] = nV2)) then
      begin
        Result:= i;
        Exit;
      end;
    end;

    Result:= -1;  // We should never reach this line
  end;
var
  pInputMesh: ID3DXMesh;
  pdwAdj: PDWORD;
  pdwPtRep: PDWordArray;
  pVBData: PShadowVert;
  pdwIBData: PDWordArray;
  dwNumEdges: DWORD;
  pMapping: array of TEdgeMapping;
  nNumMaps: DWORD; // Integer;  // Number of entries that exist in pMapping
  pNewMesh: ID3DXMesh;
  pNewVBData: PShadowVertArray;
  pdwNewIBData: PDWordArray;
  nNextIndex: DWORD; // Integer;
  pNextOutVertex: PShadowVertArray;
  f: LongWord;
  v1, v2: TD3DXVector3;
  vNormal: TD3DXVector3;
  nIndex: Integer;
  nVertIndex: array[0..2] of Integer; 
  pPatchVBData: PShadowVertArray;
  pdwPatchIBData: PDWordArray;
  pPatchMesh: ID3DXMesh;
  nNextVertex: Integer;
  i, i2: Integer;
  nVertShared: Integer;
  nBefore, nAfter: Integer;
  bNeed32Bit: Boolean;
  pFinalMesh: ID3DXMesh;
  pFinalVBData: PShadowVert;
  pwFinalIBData: PWordArray;
begin
  ppOutMesh := nil;
  pMapping:= nil;

  // Convert the input mesh to a format same as the output mesh using 32-bit index.
  Result := pMesh.CloneMesh(D3DXMESH_32BIT, @TShadowVert_Decl, pd3dDevice, pInputMesh);
  if FAILED(Result) then Exit;

  // Generate adjacency information
  pdwAdj := nil;
  pdwPtRep := nil;
  try
    GetMem(pdwAdj, SizeOf(DWORD)*3*pInputMesh.GetNumFaces);
    GetMem(pdwPtRep, SizeOf(DWORD)*pInputMesh.GetNumVertices);
  except
    FreeMem(pdwAdj); FreeMem(pdwPtRep);
    Result:= E_OUTOFMEMORY;
    Exit;
  end;

  Result := pInputMesh.GenerateAdjacency(ADJACENCY_EPSILON, pdwAdj);
  if FAILED(Result) then
  begin
    FreeMem(pdwAdj); FreeMem(pdwPtRep);
    Exit;
  end;

  pInputMesh.ConvertAdjacencyToPointReps(pdwAdj, PDWORD(pdwPtRep));
  FreeMem(pdwAdj);

  pVBData:= nil; pdwIBData:= nil;
  pInputMesh.LockVertexBuffer(0, Pointer(pVBData));
  pInputMesh.LockIndexBuffer(0, Pointer(pdwIBData));

  try // "Lock" data protected block

  if Assigned(pVBData) and Assigned(pdwIBData) then
  begin
    // Maximum number of unique edges = Number of faces * 3
    dwNumEdges := pInputMesh.GetNumFaces * 3;
    try
      SetLength(pMapping, dwNumEdges);
      for i:= 0 to dwNumEdges - 1 do pMapping[i]:= EdgeMapping; // init them
    except
      pMapping:= nil;
    end;
    if Assigned(pMapping) then
    begin
      nNumMaps := 0;  // Number of entries that exist in pMapping

      // Create a new mesh
      Result := D3DXCreateMesh(pInputMesh.GetNumFaces + dwNumEdges * 2,
                               pInputMesh.GetNumFaces * 3,
                               D3DXMESH_32BIT,
                               @TShadowVert_Decl,
                               pd3dDevice,
                               pNewMesh);
      if SUCCEEDED(Result) then
      begin
        pNewVBData := nil;
        pdwNewIBData := nil;

        pNewMesh.LockVertexBuffer(0, Pointer(pNewVBData));
        pNewMesh.LockIndexBuffer(0, Pointer(pdwNewIBData));

        // nNextIndex is the array index in IB that the next vertex index value
        // will be store at.
        nNextIndex := 0;

        try // "cleanup" protected block
        
        if Assigned(pNewVBData) and Assigned(pdwNewIBData) then
        begin
          ZeroMemory(pNewVBData, pNewMesh.GetNumVertices * pNewMesh.GetNumBytesPerVertex);
          ZeroMemory(pdwNewIBData, SizeOf(DWORD) * pNewMesh.GetNumFaces * 3);

          // pNextOutVertex is the location to write the next
          // vertex to.
          pNextOutVertex := pNewVBData;

          // Iterate through the faces.  For each face, output new
          // vertices and face in the new mesh, and write its edges
          // to the mapping table.

          for f := 0 to pInputMesh.GetNumFaces - 1 do
          begin
            // Copy the vertex data for all 3 vertices
            CopyMemory(pNextOutVertex, PChar(pVBData) + pdwIBData[f * 3]*SizeOf(TShadowVert), SizeOf(TShadowVert));
            CopyMemory(@pNextOutVertex[1], PChar(pVBData) + pdwIBData[f * 3 + 1]*SizeOf(TShadowVert), SizeOf(TShadowVert));
            CopyMemory(@pNextOutVertex[2], PChar(pVBData) + pdwIBData[f * 3 + 2]*SizeOf(TShadowVert), SizeOf(TShadowVert));

            // Write out the face
            pdwNewIBData[nNextIndex] := f * 3;     Inc(nNextIndex);
            pdwNewIBData[nNextIndex] := f * 3 + 1; Inc(nNextIndex);
            pdwNewIBData[nNextIndex] := f * 3 + 2; Inc(nNextIndex);

            // Compute the face normal and assign it to
            // the normals of the vertices.
            D3DXVec3Subtract(v1, pNextOutVertex[1].Position, pNextOutVertex[0].Position);
            D3DXVec3Subtract(v2, pNextOutVertex[2].Position, pNextOutVertex[1].Position);
            D3DXVec3Cross(vNormal, v1, v2);
            D3DXVec3Normalize(vNormal, vNormal);

            pNextOutVertex[0].Normal := vNormal;
            pNextOutVertex[1].Normal := vNormal;
            pNextOutVertex[2].Normal := vNormal;

            pNextOutVertex := @pNextOutVertex[3];

            // Add the face's edges to the edge mapping table

            // Edge 1
            nVertIndex[0] :=  pdwPtRep[pdwIBData[f * 3]];
            nVertIndex[1] :=  pdwPtRep[pdwIBData[f * 3 + 1]];
            nVertIndex[2] :=  pdwPtRep[pdwIBData[f * 3 + 2]];
            nIndex := FindEdgeInMappingTable(nVertIndex[0], nVertIndex[1], pMapping, dwNumEdges);

            // If error, we are not able to proceed, so abort.
            if (-1 = nIndex) then
            begin
              Result := E_INVALIDARG;
              Exit; // goto cleanup;
            end;

            if (pMapping[nIndex].m_anOldEdge[0] = -1) and (pMapping[nIndex].m_anOldEdge[1] = -1) then
            begin
              // No entry for this edge yet.  Initialize one.
              pMapping[nIndex].m_anOldEdge[0] := nVertIndex[0];
              pMapping[nIndex].m_anOldEdge[1] := nVertIndex[1];
              pMapping[nIndex].m_aanNewEdge[0][0] := f * 3;
              pMapping[nIndex].m_aanNewEdge[0][1] := f * 3 + 1;

              Inc(nNumMaps);
            end else
            begin
              // An entry is found for this edge.  Create
              // a quad and output it.
              Assert(nNumMaps > 0);

              pMapping[nIndex].m_aanNewEdge[1][0] := f * 3;      // For clarity
              pMapping[nIndex].m_aanNewEdge[1][1] := f * 3 + 1;

              // First triangle
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[0][1]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[0][0]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[1][0]; Inc(nNextIndex);

              // Second triangle
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[1][1]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[1][0]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[0][0]; Inc(nNextIndex);

              // pMapping[nIndex] is no longer needed. Copy the last map entry
              // over and decrement the map count.

              pMapping[nIndex] := pMapping[nNumMaps-1];
              FillMemory(@pMapping[nNumMaps-1], SizeOf(pMapping[nNumMaps-1]), $ff);
              Dec(nNumMaps);
            end;

            // Edge 2
            nIndex := FindEdgeInMappingTable(nVertIndex[1], nVertIndex[2], pMapping, dwNumEdges);

            // If error, we are not able to proceed, so abort.
            if (-1 = nIndex) then
            begin
              Result := E_INVALIDARG;
              Exit; // goto cleanup;
            end;

            if (pMapping[nIndex].m_anOldEdge[0] = -1) and (pMapping[nIndex].m_anOldEdge[1] = -1) then
            begin
              pMapping[nIndex].m_anOldEdge[0] := nVertIndex[1];
              pMapping[nIndex].m_anOldEdge[1] := nVertIndex[2];
              pMapping[nIndex].m_aanNewEdge[0][0] := f * 3 + 1;
              pMapping[nIndex].m_aanNewEdge[0][1] := f * 3 + 2;

              Inc(nNumMaps);
            end else
            begin
              // An entry is found for this edge.  Create
              // a quad and output it.
              Assert(nNumMaps > 0);

              pMapping[nIndex].m_aanNewEdge[1][0] := f * 3 + 1;
              pMapping[nIndex].m_aanNewEdge[1][1] := f * 3 + 2;

              // First triangle
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[0][1]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[0][0]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[1][0]; Inc(nNextIndex);

              // Second triangle
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[1][1]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[1][0]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[0][0]; Inc(nNextIndex);

              // pMapping[nIndex] is no longer needed. Copy the last map entry
              // over and decrement the map count.

              pMapping[nIndex] := pMapping[nNumMaps-1];
              FillMemory(@pMapping[nNumMaps-1], SizeOf(pMapping[nNumMaps-1]), $ff);
              Dec(nNumMaps);
            end;

            // Edge 3
            nIndex := FindEdgeInMappingTable(nVertIndex[2], nVertIndex[0], pMapping, dwNumEdges);

            // If error, we are not able to proceed, so abort.
            if (-1 = nIndex) then
            begin
              Result := E_INVALIDARG;
              Exit; // goto cleanup;
            end;

            if (pMapping[nIndex].m_anOldEdge[0] = -1) and (pMapping[nIndex].m_anOldEdge[1] = -1) then
            begin
              pMapping[nIndex].m_anOldEdge[0] := nVertIndex[2];
              pMapping[nIndex].m_anOldEdge[1] := nVertIndex[0];
              pMapping[nIndex].m_aanNewEdge[0][0] := f * 3 + 2;
              pMapping[nIndex].m_aanNewEdge[0][1] := f * 3;

              Inc(nNumMaps);
            end else
            begin
              // An entry is found for this edge.  Create
              // a quad and output it.
              Assert(nNumMaps > 0);

              pMapping[nIndex].m_aanNewEdge[1][0] := f * 3 + 2;
              pMapping[nIndex].m_aanNewEdge[1][1] := f * 3;

              // First triangle
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[0][1]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[0][0]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[1][0]; Inc(nNextIndex);

              // Second triangle
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[1][1]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[1][0]; Inc(nNextIndex);
              pdwNewIBData[nNextIndex] := pMapping[nIndex].m_aanNewEdge[0][0]; Inc(nNextIndex);

              // pMapping[nIndex] is no longer needed. Copy the last map entry
              // over and decrement the map count.

              pMapping[nIndex] := pMapping[nNumMaps-1];
              FillMemory(@pMapping[nNumMaps-1], SizeOf( pMapping[nNumMaps-1] ), $ff);
              Dec(nNumMaps);
            end;
          end;

          // Now the entries in the edge mapping table represent
          // non-shared edges.  What they mean is that the original
          // mesh has openings (holes), so we attempt to patch them.
          // First we need to recreate our mesh with a larger vertex
          // and index buffers so the patching geometry could fit.

          // Create a mesh with large enough vertex and
          // index buffers.

          pPatchVBData := nil;
          pdwPatchIBData := nil;

          // Make enough room in IB for the face and up to 3 quads for each patching face
          Result := D3DXCreateMesh(nNextIndex div 3 + nNumMaps * 7,
                                   (pInputMesh.GetNumFaces + nNumMaps) * 3,
                                   D3DXMESH_32BIT,
                                   @TShadowVert_Decl,
                                   pd3dDevice,
                                   pPatchMesh);
          if FAILED(Result) then Exit; // goto cleanup;

          Result := pPatchMesh.LockVertexBuffer(0, Pointer(pPatchVBData));
          if SUCCEEDED(Result) then
              Result := pPatchMesh.LockIndexBuffer(0, Pointer(pdwPatchIBData));

          if Assigned(pPatchVBData) and Assigned(pdwPatchIBData) then 
          begin
            ZeroMemory(pPatchVBData, SizeOf(TShadowVert) * (pInputMesh.GetNumFaces + nNumMaps) * 3);
            ZeroMemory(pdwPatchIBData, SizeOf(DWORD) * (nNextIndex + 3 * nNumMaps * 7));

            // Copy the data from one mesh to the other

            CopyMemory(pPatchVBData, pNewVBData, SizeOf(TShadowVert) * pInputMesh.GetNumFaces * 3);
            CopyMemory(pdwPatchIBData, pdwNewIBData, SizeOf(DWORD) * nNextIndex);
          end else
          begin
            // Some serious error is preventing us from locking.
            // Abort and return error.

            pPatchMesh := nil;
            // goto cleanup;
            Exit;
          end;

          // Replace pNewMesh with the updated one.  Then the code
          // can continue working with the pNewMesh pointer.

          pNewMesh.UnlockVertexBuffer;
          pNewMesh.UnlockIndexBuffer;
          pNewVBData := pPatchVBData;
          pdwNewIBData := pdwPatchIBData;
          pNewMesh := nil;
          pNewMesh := pPatchMesh;

          // Now, we iterate through the edge mapping table and
          // for each shared edge, we generate a quad.
          // For each non-shared edge, we patch the opening
          // with new faces.

          // nNextVertex is the index of the next vertex.
          nNextVertex := pInputMesh.GetNumFaces * 3;

          for i := 0 to nNumMaps-1 do
          begin
            if (pMapping[i].m_anOldEdge[0] <> -1) and
               (pMapping[i].m_anOldEdge[1] <> -1) then
            begin
              // If the 2nd new edge indexes is -1,
              // this edge is a non-shared one.
              // We patch the opening by creating new
              // faces.
              if (pMapping[i].m_aanNewEdge[1][0] = -1) or  // must have only one new edge
                 (pMapping[i].m_aanNewEdge[1][1] = -1) then
              begin
                // Find another non-shared edge that
                // shares a vertex with the current edge.
                for i2 := i + 1 to nNumMaps - 1 do
                begin
                  if (pMapping[i2].m_anOldEdge[0] <> -1) and       // must have a valid old edge
                     (pMapping[i2].m_anOldEdge[1] <> -1) and
                     ((pMapping[i2].m_aanNewEdge[1][0] = -1) or // must have only one new edge
                      (pMapping[i2].m_aanNewEdge[1][1] = -1)) then
                  begin
                    nVertShared := 0;
                    if (pMapping[i2].m_anOldEdge[0] = pMapping[i].m_anOldEdge[1]) then Inc(nVertShared);
                    if (pMapping[i2].m_anOldEdge[1] = pMapping[i].m_anOldEdge[0]) then Inc(nVertShared);

                    if (2 = nVertShared) then 
                    begin
                      // These are the last two edges of this particular
                      // opening. Mark this edge as shared so that a degenerate
                      // quad can be created for it.

                      pMapping[i2].m_aanNewEdge[1][0] := pMapping[i].m_aanNewEdge[0][0];
                      pMapping[i2].m_aanNewEdge[1][1] := pMapping[i].m_aanNewEdge[0][1];
                      Break;
                    end
                    else
                    if (1 = nVertShared) then
                    begin
                      // nBefore and nAfter tell us which edge comes before the other.
                      if (pMapping[i2].m_anOldEdge[0] = pMapping[i].m_anOldEdge[1]) then
                      begin
                        nBefore := i;
                        nAfter := i2;
                      end else
                      begin
                        nBefore := i2;
                        nAfter := i;
                      end;

                      // Found such an edge. Now create a face along with two
                      // degenerate quads from these two edges.

                      pNewVBData[nNextVertex] := pNewVBData[pMapping[nAfter].m_aanNewEdge[0][1]];
                      pNewVBData[nNextVertex+1] := pNewVBData[pMapping[nBefore].m_aanNewEdge[0][1]];
                      pNewVBData[nNextVertex+2] := pNewVBData[pMapping[nBefore].m_aanNewEdge[0][0]];
                      // Recompute the normal
                      D3DXVec3Subtract(v1, pNewVBData[nNextVertex+1].Position, pNewVBData[nNextVertex].Position);
                      D3DXVec3Subtract(v2, pNewVBData[nNextVertex+2].Position, pNewVBData[nNextVertex+1].Position);
                      D3DXVec3Normalize(v1, v1);
                      D3DXVec3Normalize(v2, v2);
                      D3DXVec3Cross(vNormal, v1, v2);
                      pNewVBData[nNextVertex].Normal := vNormal;
                      pNewVBData[nNextVertex+1].Normal := vNormal;
                      pNewVBData[nNextVertex+2].Normal := vNormal;

                      pdwNewIBData[nNextIndex] := nNextVertex;
                      pdwNewIBData[nNextIndex+1] := nNextVertex + 1;
                      pdwNewIBData[nNextIndex+2] := nNextVertex + 2;

                      // 1st quad

                      pdwNewIBData[nNextIndex+3] := pMapping[nBefore].m_aanNewEdge[0][1];
                      pdwNewIBData[nNextIndex+4] := pMapping[nBefore].m_aanNewEdge[0][0];
                      pdwNewIBData[nNextIndex+5] := nNextVertex + 1;

                      pdwNewIBData[nNextIndex+6] := nNextVertex + 2;
                      pdwNewIBData[nNextIndex+7] := nNextVertex + 1;
                      pdwNewIBData[nNextIndex+8] := pMapping[nBefore].m_aanNewEdge[0][0];

                      // 2nd quad

                      pdwNewIBData[nNextIndex+9] := pMapping[nAfter].m_aanNewEdge[0][1];
                      pdwNewIBData[nNextIndex+10] := pMapping[nAfter].m_aanNewEdge[0][0];
                      pdwNewIBData[nNextIndex+11] := nNextVertex;

                      pdwNewIBData[nNextIndex+12] := nNextVertex + 1;
                      pdwNewIBData[nNextIndex+13] := nNextVertex;
                      pdwNewIBData[nNextIndex+14] := pMapping[nAfter].m_aanNewEdge[0][0];

                      // Modify mapping entry i2 to reflect the third edge
                      // of the newly added face.

                      if (pMapping[i2].m_anOldEdge[0] = pMapping[i].m_anOldEdge[1]) then
                      begin
                        pMapping[i2].m_anOldEdge[0] := pMapping[i].m_anOldEdge[0];
                      end else
                      begin
                        pMapping[i2].m_anOldEdge[1] := pMapping[i].m_anOldEdge[1];
                      end;
                      pMapping[i2].m_aanNewEdge[0][0] := nNextVertex + 2;
                      pMapping[i2].m_aanNewEdge[0][1] := nNextVertex;

                      // Update next vertex/index positions

                      Inc(nNextVertex, 3);
                      Inc(nNextIndex, 15);

                      Break;
                    end;
                  end;
                end;
              end else
              begin
                // This is a shared edge.  Create the degenerate quad.

                // First triangle
                pdwNewIBData[nNextIndex] := pMapping[i].m_aanNewEdge[0][1]; Inc(nNextIndex);
                pdwNewIBData[nNextIndex] := pMapping[i].m_aanNewEdge[0][0]; Inc(nNextIndex);
                pdwNewIBData[nNextIndex] := pMapping[i].m_aanNewEdge[1][0]; Inc(nNextIndex);

                // Second triangle
                pdwNewIBData[nNextIndex] := pMapping[i].m_aanNewEdge[1][1]; Inc(nNextIndex);
                pdwNewIBData[nNextIndex] := pMapping[i].m_aanNewEdge[1][0]; Inc(nNextIndex);
                pdwNewIBData[nNextIndex] := pMapping[i].m_aanNewEdge[0][0]; Inc(nNextIndex);
              end;
            end;
          end;
        end;

        finally // cleanup:;

          if Assigned(pNewVBData) then
          begin
            pNewMesh.UnlockVertexBuffer;
            pNewVBData := nil;
          end;
          if Assigned(pdwNewIBData) then 
          begin
            pNewMesh.UnlockIndexBuffer;
            pdwNewIBData := nil;
          end;

          if SUCCEEDED(Result) then
          begin
            // At this time, the output mesh may have an index buffer
            // bigger than what is actually needed, so we create yet
            // another mesh with the exact IB size that we need and
            // output it.  This mesh also uses 16-bit index if
            // 32-bit is not necessary.

            bNeed32Bit := ( pInputMesh.GetNumFaces + nNumMaps ) * 3 > 65535;
            Result := D3DXCreateMesh(nNextIndex div 3,  // Exact number of faces
                                    ( pInputMesh.GetNumFaces + nNumMaps ) * 3,
                                    IfThen(bNeed32Bit, D3DXMESH_32BIT,0),
                                    @TShadowVert_Decl,
                                    pd3dDevice,
                                    pFinalMesh);
            if SUCCEEDED(Result) then
            begin
              pNewMesh.LockVertexBuffer(0, Pointer(pNewVBData));
              pNewMesh.LockIndexBuffer(0, Pointer(pdwNewIBData));

              pFinalVBData := nil;
              pwFinalIBData := nil;

              pFinalMesh.LockVertexBuffer(0, Pointer(pFinalVBData));
              pFinalMesh.LockIndexBuffer(0, Pointer(pwFinalIBData));

              if Assigned(pNewVBData) and Assigned(pdwNewIBData) and Assigned(pFinalVBData) and Assigned(pwFinalIBData) then
              begin
                CopyMemory(pFinalVBData, pNewVBData, SizeOf(TShadowVert) * (pInputMesh.GetNumFaces + nNumMaps) * 3);

                if (bNeed32Bit) then
                  CopyMemory(pwFinalIBData, pdwNewIBData, SizeOf(DWORD) * nNextIndex)
                else
                begin
                  for i := 0 to nNextIndex - 1 do
                    pwFinalIBData[i] := pdwNewIBData[i];
                end;
              end;

              if Assigned(pNewVBData) then pNewMesh.UnlockVertexBuffer;
              if Assigned(pdwNewIBData) then pNewMesh.UnlockIndexBuffer;
              if Assigned(pFinalVBData) then pFinalMesh.UnlockVertexBuffer;
              if Assigned(pwFinalIBData) then pFinalMesh.UnlockIndexBuffer;

              // Release the old
              // pNewMesh := nil;
              pNewMesh := pFinalMesh;
            end;

            ppOutMesh := pNewMesh;
          end
          else
            pNewMesh:= nil;
        end;
      end;
      pMapping:= nil; // delete[] pMapping;
    end else
      Result := E_OUTOFMEMORY;
  end else
    Result := E_FAIL;

  finally //   try // "Lock" data protected block
    if Assigned(pVBData) then pInputMesh.UnlockVertexBuffer;
    if Assigned(pdwIBData) then pInputMesh.UnlockIndexBuffer;

    FreeMem(pdwPtRep);
    pInputMesh := nil; // not necessary in Delphi
  end;
end;

function GetFormatSize(Format: TD3DFormat): DWORD;
begin
  case Format of
    D3DFMT_R8G8B8: result := 3;
    D3DFMT_A8R8G8B8: result := 4;
    D3DFMT_X8R8G8B8: result := 4;
    D3DFMT_R5G6B5: result := 2;
    D3DFMT_X1R5G5B5: result := 2;
    D3DFMT_A1R5G5B5: result := 2;
    D3DFMT_A4R4G4B4: result := 2;
    D3DFMT_R3G3B2: result := 1;
    D3DFMT_A8: result := 1;
    D3DFMT_A8R3G3B2: result := 2;
    D3DFMT_X4R4G4B4: result := 2;
    D3DFMT_A2B10G10R10: result := 4;
    D3DFMT_A8B8G8R8: result := 4;
    D3DFMT_X8B8G8R8: result := 4;
    D3DFMT_G16R16: result := 4;
    D3DFMT_A2R10G10B10: result := 4;
    D3DFMT_A16B16G16R16: result := 8;
    D3DFMT_A8P8: result := 2;
    D3DFMT_P8: result := 1;
    D3DFMT_L8: result := 1;
    D3DFMT_A8L8: result := 2;
    D3DFMT_A4L4: result := 1;
    D3DFMT_V8U8: result := 2;
    D3DFMT_L6V5U5: result := 2;
    D3DFMT_X8L8V8U8: result := 4;
    D3DFMT_Q8W8V8U8: result := 4;
    D3DFMT_V16U16: result := 4;
    D3DFMT_A2W10V10U10: result := 4;
    D3DFMT_D16_LOCKABLE: result := 2;
    D3DFMT_D32: result := 4;
    D3DFMT_D15S1: result := 2;
    D3DFMT_D24S8: result := 4;
    D3DFMT_D24X8: result := 4;
    D3DFMT_D24X4S4: result := 4;
    D3DFMT_D16: result := 2;
    D3DFMT_D32F_LOCKABLE: result := 4;
    D3DFMT_D24FS8: result := 4;
    D3DFMT_L16: result := 2;
    D3DFMT_INDEX16: result := 2;
    D3DFMT_INDEX32: result := 4;
    D3DFMT_Q16W16V16U16: result := 8;
    D3DFMT_R16F: result := 2;
    D3DFMT_G16R16F: result := 4;
    D3DFMT_A16B16G16R16F: result := 8;
    D3DFMT_R32F: result := 4;
    D3DFMT_G32R32F: result := 8;
    D3DFMT_A32B32G32R32F: result := 16;
    else
    result := 0;
  end;
end;

function GetDesktopHandle: HWND;
  function GetDesktopHandle2: HWND;
  type
    PRefParams = ^TRefParams;
    TRefParams = record
      Handle: HWND;
      ClassName: string;
      NewHandle: boolean;
    end;
    function EnumChildWindowsProc(wnd: HWND; Params: PRefParams): bool; stdcall;
    var
      buf: array[0..255] of char;
      ClassName: string;
    begin
      Result := True;
      GetClassName(wnd, buf, SizeOf(buf) - 1);
      ClassName := string(buf);
      if (ClassName = 'Internet Explorer_Server')
      or (
        (ClassName = 'SHELLDLL_DefView')
        and
        (Params^.ClassName <> 'Internet Explorer_Server')
      )
      or (
        (ClassName = 'Progman')
        and (Params^.ClassName <> 'SHELLDLL_DefView')
        and (Params^.ClassName <> 'Internet Explorer_Server')
      ) then
      begin
        Params^.Handle := wnd;
        Params^.ClassName := ClassName;
        Params^.NewHandle := true;
      end;
    end;
  var
    Params: TRefParams;
  begin
    Params.Handle := 0;
    Params.ClassName := '';
    Params.NewHandle := true;
    while Params.NewHandle do
    begin
      Params.NewHandle := false;
      EnumChildWindows(Params.Handle, @EnumChildWindowsProc, Integer(@Params));
    end;
    if Params.ClassName = 'Internet Explorer_Server' then
    Result := Params.Handle
    else
    Result := 0;
  end; 
var
  h: HWND;
  ClassName: array[0..255] of char;
begin
  Result := GetDesktopHandle2;
  if Result = 0 then
  for h := 0 to High(integer) do
  if IsWindow(h) and IsWindowVisible(h) then
  begin
    GetClassName(h, ClassName, 255);
    if (string(ClassName) = 'Internet Explorer_Server') then
    begin
      Result := h;
      Break;
    end;
  end;
end;

end.
