unit GraphUtils;

interface

Uses
  SysUtils,
  Windows,
//  D3DX9,
  Direct3D9;

CONST

//============================================================================//
//============================================================================//
//============================================================================//
//Константы ошибок:
  ErrOk                   = 0;
  ErrUnknownError         = 1;
  ErrNotCorrectD3DVersion = 2;
  ErrNotInitD3D           = 3;
  ErrDontRestoredD3D      = 4;

//============================================================================//
//============================================================================//
//============================================================================//

TYPE

  PD3DXAttributeRange = ^TD3DXAttributeRange;
  TD3DXATTRIBUTERANGE = record
    AttribId:    DWord;
    FaceStart:   DWord;
    FaceCount:   DWord;
    VertexStart: DWord;
    VertexCount: DWord;
  end;

  TDDCOLORKEY = packed record
    dwColorSpaceLowValue: DWORD;   // low boundary of color space that is to
                                   // be treated as Color Key, inclusive
    dwColorSpaceHighValue: DWORD;  // high boundary of color space that is
                                   // to be treated as Color Key, inclusive
  end;

//============================================================================//
//============================================================================//
//============================================================================//
  TGame = Class

    protected

    private
      ExitGame  : LongBool;

      Error     : Longint;

      WHandle   : Cardinal; //Идентификатор окна программы

      ScreenW   : Cardinal; //Ширина экрана
      ScreenH   : Cardinal; //Высота экрана
      ScreenHz  : Cardinal; //Частота обновления
      ScreenBit : Cardinal; //Разрядность цвета

      FullScreen: LongBool; //Флаг полноэкранного режима

      Rendered  : LongBool; //Флаг процесса рендеринга сцены
      Processed : LongBool; //Флаг процесса обработки данных игры

      //++++++++++++++++Интерфейсы Direct3D+++++++++++++++++//
      iD3D            : IDIRECT3D9;       //Главный интерфейс Direct3D
      iD3DDevice      : IDIRECT3DDEVICE9; //Устройство вывода
      D3DCaps         : D3DCAPS9;         //Данные доступных функций устройства

      d3ddm : TD3DDISPLAYMODE;
      d3dpp : TD3DPRESENT_PARAMETERS;

      CurrentTime : Longint;
      FPSLastTickCount : Longint;
      FPSFrames        : Longint;
      FPS              : Single;

      Triangles : Longint; //Счётчик отрисованных треугольников;
      
      TextureManager : TObject; //Менеджер текстур
      Scene          : TObject; //Текущая сцена
      DirectInput    : TObject; //Объект ввода

      Procedure Reset3D;
      Procedure BeginScene;
      Procedure EndScene;
    procedure AddTriangles(const Value: Longint);

    public
      SystemFont     : TObject;

      Property GetLastError    : Longint Read Error; //Получение последней ошибки
      Property SetCurrentScene : TObject Write Scene; //Установка объекта текущей сцены
      Property GetCurrentScene : TObject Read Scene; //Получение объекта текущей сцены
      Property GetDevice       : IDIRECT3DDEVICE9 Read iD3DDevice;
      Property GetWindowHandle : Cardinal Read WHandle;
      Property GetD3DDISPLAYMODE : TD3DDISPLAYMODE Read d3ddm;
      Property GetD3DPRESENTPARAMETERS : TD3DPRESENT_PARAMETERS Read d3dpp;
      Property GetFPS          : Single Read FPS;
      Property GetCurrentTime  : Longint Read CurrentTime; //Получение текущего времени

      Property TrianglesNum : Longint Read Triangles Write AddTriangles;
      
      Constructor Create(SW,SH : Cardinal; FS : LongBool; Sinchronized : LongBool; TrueColor : LongBool; RefreshRate : Cardinal; WndHandle : Cardinal);
      Procedure Free; Virtual;

      Procedure Draw; Virtual;       //Процедура отрисовки игры
      Procedure Calculate; Virtual;  //Процедура расчёта объектов игры

      Procedure Process;

      Procedure ExitFromTheGame;     //Процедура выхода из игры

      Function KeyPressed(KeyNum : byte) : LongBool;
      Function MousePressed(KeyNum : byte) : LongBool;
      Function MouseX : Longint;
      Function MouseY : Longint;
      Function MouseWheel : Longint;
      Function MouseOfsX : Longint;
      Function MouseOfsY : Longint;

  end;

  TTexture = class
    protected
      Texture     : IDirect3DTexture9;  //Указатель на интерфейс текстуры
      Transparent : LongBool; //Использование цветового ключа
    private

    public
      Property GetTexture : IDirect3DTexture9 Read Texture;
                                                                 
      Constructor Create(Var Game : TGame; FileName : String; UseTransparent : LongBool = False; LowValue : Cardinal = 0; HighValue : Cardinal = 0); Virtual;
      Procedure Free;

  end;


  TDataTextureForManager = Record
    LastTime    : Longint;
    TextureObj  : TTexture;
    TextureName : String[15];
    FileName    : String[255];
  end;

  TTextureManager = class
    protected
    private
       Game              : TGame; //Игровой объект
       TextureList       : Array of TDataTextureForManager;
       LastSetTextureNum : Longint; //Индекс последней установленной текстуры
    public

      Constructor Create(GameObj : TGame);
      Procedure Free;

      Function LoadTexture(_FileName : String; _TextureName : String; Preload : LongBool = False) : Longint;

      Procedure SetTexture(TextureNum : Longint); //Установка текущей текстуры при рендеринге
      Function GetNumTexture(TextureName : String) : Longint; //Получение номера текстуры по названию

      Procedure UnloadUnusedTextures(TimeMSec : Longint); //Освобождение ресурсов изпод давно неиспользуемых текстур

  end;


  TCollisionRec = Record
    Up,Down,Left,Right,Front,Back : Single;
    MaxRadius : Single;
  end;

  TMesh = class
    protected
      VFV                : Longint;           //Формат вершин
      VertexBuffer       : Pointer;            //Указатель на буфер вертексов
      VertexBufferSize   : Longint;           //Размер данных буфера вертексов
      IndexBuffer        : Pointer;            //Указатель на буфер индексов
      IndexBufferSize    : Longint;           //Размер буфера индексов
      IndexDataFormat    : TD3DFormat;         //Формат индексов
      VertexCount        : Cardinal;           //Кол-во вертексов
      FacesCount         : Cardinal;           //Кол-во треугольников
      BytesPerVertex     : Cardinal;           //Кол-во байт на вертекс
      Materials          : Array of TD3Dmaterial9;  //Материалы модели
      Textures           : Array of Longint;        //Текстуры модели
      Attributes         : Array of TD3DXATTRIBUTERANGE;//Таблица атрибутов (частей меша)

      CollisionRec       : TCollisionRec; //Данные кубического размера меша и максимального радиуса

      Game               : TGame; //Игровой объект
    private

    public
      Property CollisionBox : TCollisionRec Read CollisionRec;

      Constructor Create(GameObj : TGame; FileName : String; TexturePath : String);
      Procedure Render;
      Procedure Free;

  end;

  TCharSize = packed record
    X,Y : Cardinal; //Pixel coordinates
    W,H : Cardinal; //Width and height in pixels
    TX1,TY1,TX2,TY2 : Single; //texture coordinates
  end;
  TCharSizeArr = array[0..255] of TCharSize;

  TFont = class
    protected
      Game         : TGame;        //Игровой объект
      Texture      : Longint;      //Текстура шрифта
      CharsInfo    : TCharSizeArr; //Данные символов шрифта
    private

    public
      Property GetTexture : Longint Read Texture;

      Constructor Create(GameObj : TGame; FileName : String); Virtual;
      Procedure Free; Virtual;

  end;

  TText = class
    protected
      Game         : TGame;        //Игровой объект
      Font         : TFont;        //Шрифт

      MyText             : AnsiString;
      dX,dY              : Longint;            //Первоначальные координаты текста (пригодится для сброса изменений координат текста)
      W,H                : Longint;            //Ширина и высота текста
      TextLength         : Longint;

      Rectangled         : LongBool;
      Rect               : TRect;
      StrInterval        : Longint;

      VFV                : Cardinal;           //Формат вершин
      BytesPerVertex     : Cardinal;           //Кол-во байт на вертекс

      VertexBuffer       : Pointer;            //Указатель на буфер вертексов
      VertexBufferSize   : Cardinal;           //Размер данных буфера вертексов
      IndexBuffer        : Pointer;            //Указатель на буфер индексов
      IndexBufferSize    : Cardinal;           //Размер буфера индексов
      IndexDataFormat    : _D3DFormat;         //Формат индексов
      VertexCount        : Cardinal;           //Кол-во вертексов
      FacesCount         : Cardinal;           //Кол-во треугольников

      ColorUp            : Cardinal;
      SelColorUp         : Cardinal;
      ColorDown          : Cardinal;
      SelColorDown       : Cardinal;
    private
      Procedure Clear;
      Procedure SetText(Const Str : AnsiString);
    public
      Property Text : AnsiString Read MyText Write SetText;

      Constructor Create(GameObj : TGame; UsedFont : TFont; X,Y : Longint; _Rectangled : LongBool = False; RectW : Longint = 0; RectH : Longint = 0); Virtual;
      Procedure Free; Virtual;

      Procedure SetTextColor(UpColor,DownColor,UpSelColor,DownSelColor : Cardinal);

      Procedure Scroll(OfsX,OfsY : Single);
      Procedure Draw;

      Procedure LoadFromFile(FileName : String);
  end;

  TCamera = Class
    protected
      Game : TGame;
      matWorld, matView, matProj : TD3DMatrix;
      vEyePt, vLookatPt, vUpVec, vDir : TD3DVector;

      CullMat : TD3DMatrix;

    public
      Property GetPos : TD3DVector Read vEyePt;
      Property GetLookAt : TD3DVector Read vLookatPt;

      Constructor Create(GameObj : TGame);
      Procedure SetCameraPos(Vector : TD3DVector);
      Procedure SetLookTo(Vector : TD3DVector);
      Procedure SetProjection(FOV, Aapect, NearPlane, FarPlane : Single);
      Procedure SetCamera;

      Function GetCursorVector (V : TD3DVector): TD3DVector;
  end;

//============================================================================//
//============================================================================//
//============================================================================//

implementation

Uses
  DirectInputUnit,
  SceneUnit, Types,
  MathUnit;

//============================================================================//
//============================================================================//
//============================================================================//
Constructor TGame.Create(SW,SH : Cardinal; FS : LongBool; Sinchronized : LongBool; TrueColor : LongBool; RefreshRate : Cardinal; WndHandle : Cardinal);
Var
  hRet : HRESULT;
  Flags : Cardinal;
  S : PChar;
begin
  ExitGame  := False;


  Error     := ErrUnknownError;

  WHandle   := WndHandle; //Идентификатор окна программы

  CurrentTime := GetTickCount;
  FPSLastTickCount := CurrentTime;
  FPSFrames        := 0;
  FPS              := 0;


  Rendered  := False;
  Processed := False;

  ScreenW   := SW; //Ширина экрана
  ScreenH   := SH; //Высота экрана
  ScreenHz  := RefreshRate; //Частота обновления
  if TrueColor then ScreenBit:=32 else ScreenBit:=16; //Разрядность цвета

  FullScreen:= FS; //Флаг полноэкранного режима


  //++++++++++++++++Интерфейсы Direct3D+++++++++++++++++//
  iD3D            := nil; //Главный интерфейс Direct3D
  iD3DDevice      := nil; //Устройство вывода
  FillChar(D3DCaps,SizeOf(D3DCAPS9),$00);

  TextureManager := nil;
  DirectInput    := nil;
  SystemFont     := nil;

  iD3D := Direct3DCreate9(D3D_SDK_VERSION);
  if iD3D = nil then begin
     Error := ErrNotCorrectD3DVersion;
     Exit;
  end;

  hRet := iD3D.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm);
  if hRet<>0 then begin
     Error := ErrUnknownError;
     Exit;
  end;

  FillChar(d3dpp, SizeOf(d3dpp),$00);
  with d3dpp do begin
       Windowed := not FullScreen;
       SwapEffect := D3DSWAPEFFECT_DISCARD;
       BackBufferWidth  := ScreenW;
       BackBufferHeight := ScreenH;

       if Sinchronized then
       PresentationInterval:=D3DPRESENT_INTERVAL_DEFAULT
       else
       PresentationInterval:=D3DPRESENT_INTERVAL_IMMEDIATE;

       if TrueColor then
       begin
         BackBufferFormat := D3DFMT_X8R8G8B8;
         AutoDepthStencilFormat:=D3DFMT_D24X8;
       end else
       begin
         BackBufferFormat := D3DFMT_R5G6B5;
         AutoDepthStencilFormat:=D3DFMT_D16;
       end;

       FullScreen_RefreshRateInHz := ScreenHz;

       BackBufferCount:=1;
       hDeviceWindow:=WHandle;
       EnableAutoDepthStencil:=True;
  end;

  hRet := iD3D.GetDeviceCaps(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, D3DCaps);
  if hRet<>0 then begin
     Error := ErrUnknownError;
     Exit;
  end;

  Flags := 0;
  if D3DCaps.DevCaps and D3DDEVCAPS_HWTRANSFORMANDLIGHT<>0
  then
  begin
    Flags:=Flags or D3DCREATE_HARDWARE_VERTEXPROCESSING;
    if D3DCaps.DevCaps and D3DDEVCAPS_PUREDEVICE<>0 then Flags:=Flags or D3DCREATE_PUREDEVICE;
  end
  else Flags:=Flags or D3DCREATE_SOFTWARE_VERTEXPROCESSING;

  hRet := iD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, WndHandle,
                              Flags,
                              @d3dpp, iD3DDevice);
  if hRet<>0 then begin
     Error := ErrNotInitD3D;
     Exit;
  end;

  TextureManager:= TTextureManager.Create(Self);
  Scene         := nil;
  DirectInput   := TDirectInput.Create(Self);

  SystemFont    := TFont.Create(Self,'Fonts\System.bmp');

  Error := ErrOk;

end;

//============================================================================//

Procedure TGame.Free;
begin

  if SystemFont<>nil then
  begin
    (SystemFont as TFont).Free;
    SystemFont:=nil;
  end;

  if DirectInput<>nil then
  begin
    (DirectInput as TDirectInput).Free;
    DirectInput:=nil;
  end;

  if Scene<>nil then
  begin
    (Scene as TGameScene).Free;
    Scene:=nil;
  end;

  if TextureManager<>nil then
  begin
    (TextureManager as TTextureManager).Free;
    TextureManager:=nil;         
  end;

  if iD3DDevice<>nil then
  begin
    iD3DDevice := nil;
  end;
  if iD3D<>nil then
  begin
    iD3D := nil;
  end;

  //Закрытие окна:
  CloseWindow(WHandle);

  Inherited;
end;

//============================================================================//

Procedure TGame.ExitFromTheGame;
begin
  ExitGame:=True;
  DestroyWindow(WHandle);
end;

//============================================================================//

Procedure TGame.Draw;
begin
  Triangles:=0;
  if CurrentTime - FPSLastTickCount >= 1000 then
  begin
    FPS:=FPSFrames * 1000 / (CurrentTime - FPSLastTickCount);
    FPSFrames:=0;                  //Сброс значения прошедших кадров
    FPSLastTickCount:=CurrentTime; //Установка времени последнего расчёта
  end;

  BeginScene;
  if Scene<>nil then (Scene as TGameScene).Draw;
  EndScene;

  Inc(FPSFrames);
end;

//============================================================================//

Procedure TGame.Calculate;
Var
  ParentScene : TGameScene;
begin
  CurrentTime := GetTickCount;

  (DirectInput as TDirectInput).Update;

  if Scene<>nil then
  begin
    ParentScene:=(Scene as TGameScene).Process;
    if ParentScene<>Scene then
    begin
      if Scene<>nil then
      begin
        (Scene as TGameScene).Free;
        Scene:=nil;
      end;
      SetCurrentScene:=ParentScene;
    end;
  end else ExitFromTheGame;
end;

//============================================================================//

Procedure TGame.Process;
begin
  Calculate;
  Draw;
end;

//============================================================================//

Procedure TGame.Reset3D;
Var
  hRes : Longint;
  WINDOWPLACEMENT : TWINDOWPLACEMENT;
begin
  GetWindowPlacement(WHandle,@WINDOWPLACEMENT);
  if ((WINDOWPLACEMENT.showCmd and SW_SHOW)=0) then
  begin
    Sleep(50);                                                                                  
    Exit;
  end;
  if iD3DDevice<>nil then
  begin
    hRes:=iD3DDevice.TestCooperativeLevel;
    if (hRes = D3DERR_DEVICENOTRESET) then
    begin
      if iD3DDevice.Reset(d3dpp) = D3DERR_DRIVERINTERNALERROR then
      begin
        Error := ErrDontRestoredD3D;
        ExitFromTheGame;
      end;
    end;

  end;
end;

//============================================================================//

Procedure TGame.BeginScene;
Var
  hRes : Longint;
begin
  Rendered:=True;
  if iD3DDevice=nil then Exit;
  hRes:=iD3DDevice.Clear(0, nil, D3DCLEAR_TARGET or D3DCLEAR_ZBUFFER, $00000000, 1.0, 0);
  if (hRes=D3DERR_DEVICELOST) or (hRes=D3DERR_DRIVERINTERNALERROR) then Reset3D;
  hRes:=iD3DDevice.BeginScene;
  if (hRes=D3DERR_DEVICELOST) or (hRes=D3DERR_DRIVERINTERNALERROR) then Reset3D;
end;

//============================================================================//

Procedure TGame.EndScene;
Var
  hRes : Longint;
begin

  if iD3DDevice<>nil then
  begin
    hRes:=iD3DDevice.EndScene;
    if (hRes=D3DERR_DEVICELOST) or (hRes=D3DERR_DRIVERINTERNALERROR) then Reset3D;
    hRes:=iD3DDevice.Present(nil,nil,0,nil);
    if (hRes=D3DERR_DEVICELOST) or (hRes=D3DERR_DRIVERINTERNALERROR) then Reset3D;
  end;

  //Выгрузка неиспользуемых в течении 10 секунд текстур:
  (TextureManager as TTextureManager).UnloadUnusedTextures(30000);
  Rendered:=False;
end;

//============================================================================//

Function TGame.KeyPressed(KeyNum : byte) : LongBool;
begin
  if DirectInput=nil then Result:=False else
  begin
    Result:=(DirectInput as TDirectInput).KeyDown(KeyNum);
  end;
end;

Function TGame.MousePressed(KeyNum : byte) : LongBool;
begin
  if DirectInput=nil then Result:=False else
  begin
    Result:=(DirectInput as TDirectInput).MouseDown(KeyNum);
  end;
end;

Function TGame.MouseX : Longint;
begin
  if DirectInput=nil then Result:=0 else
  begin
    Result:=(DirectInput as TDirectInput).MouseX;
  end;
end;

Function TGame.MouseY : Longint;
begin
  if DirectInput=nil then Result:=0 else
  begin
    Result:=(DirectInput as TDirectInput).MouseY;
  end;
end;

Function TGame.MouseWheel : Longint;
begin
  if DirectInput=nil then Result:=0 else
  begin
    Result:=(DirectInput as TDirectInput).MouseOfsZ;
  end;
end;

Function TGame.MouseOfsX : Longint;
begin
  if DirectInput=nil then Result:=0 else
  begin
    Result:=(DirectInput as TDirectInput).MouseOfsX;
  end;
end;

Function TGame.MouseOfsY : Longint;
begin
  if DirectInput=nil then Result:=0 else
  begin
    Result:=(DirectInput as TDirectInput).MouseOfsY;
  end;
end;

procedure TGame.AddTriangles(const Value: Longint);
begin
  Inc(Triangles,Value);
end;

//============================================================================//
//============================================================================//
//============================================================================//

Function CreateTextureFromBMP(Var iD3DDevice : IDIRECT3DDEVICE9; FileName : PChar; UseTransparent : LongBool = False; LowValue : Cardinal = 0; HighValue : Cardinal = 0) : IDirect3DTexture9;
Type
  //Описание массивов для работы с данными:
  TSrcPicture  = array[0..0] of byte;
  TDestPicture = array[0..0] of word;
Var
  hRet : Cardinal; //Переменная для возврата кода ошибки
  BMPFile : File;

  //Структуры заголовка BMP файла:
  BitmapFileHeader : TBitmapFileHeader;
  BmpInfo : TBitmapInfo;

  BMPData : Pointer;      //Указатель на данные пикселей из BMP файла
  BMPDataSize : Cardinal; //Размер выделяемой памяти для графических данных из BMP файла

  R,G,B : Byte;
  X,Y,W,H : Longint;
  P : Cardinal;
  I : Integer; //Для чтения строк графики

  BitmapPal: array [0..255] of TRGBQUAD; //палитра, для 8 битных битмапов


  D3DLOCKED_RECT : _D3DLOCKED_RECT;
  Rect           : TRect;

  ColorKey    : TDDCOLORKEY;

  Procedure EndFunc;
  begin
    CloseFile(BMPFile);
    FileMode:=fmOpenReadWrite;
    if BMPData<>nil then
    begin
      FreeMem(BMPData,BMPDataSize);
      BMPData:=nil;
    end;
  end;

begin
  Result:=Nil;
  if not FileExists(FileName) then exit; //Если файл не найден, то выйти

  BMPData:=nil;

  AssignFile(BMPFile,FileName);
  FileMode:=fmOpenRead; //Режим окрытия файла ТОЛЬКО ЧТЕНИЕ
  Reset(BMPFile,1);

  //Очищение структуры данных заголовка файла
  FillChar(BitmapFileHeader,SizeOf(TBitmapFileHeader),0);
  //Если размер файла больше размера структуры заголовка, то читаем его:
  if FileSize(BMPFile)>SizeOf(TBitmapFileHeader) then
  BlockRead(BMPFile,BitmapFileHeader,SizeOf(TBitmapFileHeader));

  //Если это файл BMP (в заголовке файла должны быть символы BM), то читаем:
  if BitmapFileHeader.bfType=$4D42 then
  begin

    BlockRead(BMPFile,BmpInfo.bmiHeader,SizeOf(TBitmapInfoHeader));
    W:=BmpInfo.bmiHeader.biWidth;
    H:=BmpInfo.bmiHeader.biHeight;

    //Если данные в файле не сжаты, то загрузать данные пикселей:
    if BmpInfo.bmiHeader.biCompression=0 then
    begin

      //Вычисление размера данных:
      BMPDataSize:=(W*H*BmpInfo.bmiHeader.biBitCount) div 8;
      GetMem(BMPData,BMPDataSize);  //Выделение памяти под данные BMP рисунка
      Case BmpInfo.bmiHeader.biBitCount of
      8  : begin
             BlockRead(BMPFile, BitmapPal, SizeOf(BitmapPal));
             Seek(BMPFile, BitmapFileHeader.bfOffBits);
             BlockRead(BMPFile, BMPData^, BMPDataSize);
           end;
      24 : begin
             Seek(BMPFile,BitmapFileHeader.bfOffBits);
             BlockRead(BMPFile,BMPData^,BMPDataSize);
           end;
      end; //Case BmpInfo.bmiHeader.biBitCount

    end else begin EndFunc; Exit; end; //if BmpInfo.bmiHeader.biCompression=0

  end else begin EndFunc; Exit; end;  //if BitmapFileHeader.bfType=$4D42


  //D3DFMT_R5G6B5 D3DFMT_R8G8B8 D3DFMT_X8R8G8B8
  iD3DDevice.CreateTexture(W,H,1,0,D3DFMT_R5G6B5,D3DPOOL_MANAGED,Result,Nil);
  if Result=nil then begin EndFunc; Exit; end;

  Rect.Left:=0;
  Rect.Top:=0;
  Rect.Right:=W;
  Rect.Bottom:=H;
  if Result.LockRect(0,D3DLOCKED_RECT, @Rect,D3DLOCK_DISCARD) = 0 then
  begin
  if D3DLOCKED_RECT.pBits=nil then Beep(1000,100);

      Case BmpInfo.bmiHeader.biBitCount of
      8  : begin
             for Y:=0 to H-1 do
             for X:=0 to W-1 do
             begin
               P:=TSrcPicture(BMPData^)[W*Y+X];
               B:=BitmapPal[p].rgbBlue shr 3;
               G:=BitmapPal[p].rgbGreen shr 2;
               R:=BitmapPal[p].rgbRed shr 3;
               if H<0 then
               TDestPicture(D3DLOCKED_RECT.pBits^)[Y*W+X]:=word((B) or (G shl 5) or (R shl 11))
               else
               TDestPicture(D3DLOCKED_RECT.pBits^)[(H-Y-1)*W+X]:=word((B) or (G shl 5) or (R shl 11))
             end;
           end;
      24 : begin
             for Y:=0 to H-1 do
             for X:=0 to W-1 do
             begin
               p:=W*Y+X;
               //Конвертирование пикселя из 24 битового в 16 битовый:
               B:=TSrcPicture(BMPData^)[p*3] shr 3;
               G:=TSrcPicture(BMPData^)[p*3+1] shr 2;
               R:=TSrcPicture(BMPData^)[p*3+2] shr 3;

               if H<0 then
               TDestPicture(D3DLOCKED_RECT.pBits^)[Y*W+X]:=word((B) or (G shl 5) or (R shl 11))
               else
               TDestPicture(D3DLOCKED_RECT.pBits^)[(H-Y-1)*W+X]:=word((B) or (G shl 5) or (R shl 11))
             end;
           end; //Case of 24
    end; //Case BmpInfo.bmiHeader.biBitCount
    Result.UnlockRect(1);
  end; //if Result.LockRect

  if UseTransparent then
  begin
    ColorKey.dwColorSpaceLowValue:=LowValue;
    ColorKey.dwColorSpaceHighValue:=HighValue;
    //Тут установка цветового ключа:
    //А вот и нету :)
  end;

//  Result.PreLoad;

  EndFunc;
end;

Constructor TTexture.Create(Var Game : TGame; FileName : String; UseTransparent : LongBool = False; LowValue : Cardinal = 0; HighValue : Cardinal = 0);
begin
  Inherited Create;

  Texture:=Nil;

  Transparent:=UseTransparent;

  if not FileExists(FileName) then exit; //Если файл не найден, то выйти
  Texture:=CreateTextureFromBMP(Game.iD3DDevice, PChar(FileName), UseTransparent, LowValue, HighValue);
end;

Procedure TTexture.Free;
begin
   if Texture<>nil then
   begin
     Texture:=nil;
   end;
   Inherited;
end;

//============================================================================//
//============================================================================//
//============================================================================//

Constructor TTextureManager.Create(GameObj : TGame);
begin
  Inherited Create;
  LastSetTextureNum :=-1; //Индекс последней установленной текстуры
  Game:=GameObj;
  SetLength(TextureList,0);
end;

Procedure TTextureManager.Free;
Var
  i : Longint;
begin
  For i:=Low(TextureList) to High(TextureList) do
  begin
    With TextureList[i] do
    begin
      if TextureObj<>nil then
      begin
        TextureObj.Free;
        TextureObj:=nil;
      end;
    end;
  end;
  SetLength(TextureList,0);
  Inherited;
end;

Function TTextureManager.LoadTexture(_FileName : String; _TextureName : String; Preload : LongBool = False) : Longint;
Var
  i : Longint;
  TempName : String[15];
begin
  TempName:=_TextureName;
  //поиск уже имеющейся текстуры под таким именем:
  for i:=Low(TextureList) to High(TextureList) do
  begin
    if TextureList[i].TextureName=TempName then
    begin
      Result:=i;
      Exit;
    end;
  end;

  SetLength(TextureList,Length(TextureList)+1);
  With TextureList[High(TextureList)] do
  begin
    FileName:=_FileName;
    TextureName:=TempName;
    if Preload then
    begin
      TextureObj:=TTexture.Create(Game,FileName);
      LastTime:=Game.CurrentTime;
    end else
    begin
      LastTime:=0;
      TextureObj:=nil;
    end;

  end;
  Result:=High(TextureList);
end;

Procedure TTextureManager.SetTexture(TextureNum : Longint);
begin
  if LastSetTextureNum<>TextureNum then
  begin

    //  Проверка на выход за границы массива:
    if (TextureNum<Low(TextureList)) or (TextureNum>High(TextureList)) then
    begin
      LastSetTextureNum:=-1;
      Game.iD3DDevice.SetTexture(0,nil);
    end else
    begin
      LastSetTextureNum:=TextureNum;
      With TextureList[TextureNum] do
      begin
        if TextureObj=nil then TextureObj:=TTexture.Create(Game,FileName);
        Game.iD3DDevice.SetTexture(0,TextureObj.GetTexture);
        LastTime:=GetTickCount;//Game.CurrentTime;
      end;
    end;

  end;

end;

Function TTextureManager.GetNumTexture(TextureName : String) : Longint; //Получение номера текстуры по названию
Var
  i       : Longint;
begin
  Result:=-1;
  For i:=Low(TextureList) to High(TextureList) do
  begin
    if TextureList[i].TextureName=TextureName then
    begin
      Result:=i;
      Exit;
    end;
  end;
end;

Procedure TTextureManager.UnloadUnusedTextures(TimeMSec : Longint);
Var
  CurTime : Longint;
  i       : Longint;
begin
  CurTime:=Game.CurrentTime;
  LastSetTextureNum:=-2;
  For i:=Low(TextureList) to High(TextureList) do
  if TextureList[i].TextureObj<>nil then
  begin
    With TextureList[i] do
    if CurTime-LastTime>=TimeMSec then
    begin
      TextureObj.Free;
      TextureObj:=nil;
    end;
  end;
end;

//============================================================================//
//============================================================================//
//============================================================================//

Constructor TMesh.Create(GameObj : TGame; FileName : String; TexturePath : String);
Var
  i : Longint;
  Size : Longint;
  F : File;
  MtrlCount          : Longint;
  TexturesCount      : Longint;
  AttributesCount    : Longint;
  TextureName        : ShortString;
  pv : Pointer;
begin
  Inherited Create;

  Game:=GameObj;
  VertexBuffer:=nil;
  VertexBufferSize:=0;;
  IndexBuffer:=nil;
  IndexBufferSize:=0;

  SetLength(Materials, 0); //Материал модели
  SetLength(Textures,  0); //Указатель на текстуры
  SetLength(Attributes, 0); //Атрибуты

  If Not FileExists(FileName) then Exit;
  //Сохранение модели:
  FileMode:=fmOpenRead;
  AssignFile(F,FileName);
  Reset(F,1);
  BlockRead(F,MtrlCount,SizeOf(MtrlCount));
  BlockRead(F,TexturesCount,SizeOf(TexturesCount));
  BlockRead(F,AttributesCount,SizeOf(AttributesCount));
  BlockRead(F,VFV,SizeOf(VFV));

  BlockRead(F,VertexBufferSize,SizeOf(VertexBufferSize));
  GetMem(VertexBuffer,VertexBufferSize);
  BlockRead(F,VertexBuffer^,VertexBufferSize);

  BlockRead(F,IndexBufferSize,SizeOf(IndexBufferSize));
  GetMem(IndexBuffer,IndexBufferSize);
  BlockRead(F,IndexBuffer^,IndexBufferSize);

  BlockRead(F,IndexDataFormat,SizeOf(IndexDataFormat));
  BlockRead(F,VertexCount,SizeOf(VertexCount));
  BlockRead(F,FacesCount,SizeOf(FacesCount));
  BlockRead(F,BytesPerVertex,SizeOf(BytesPerVertex));

  SetLength(Materials,MtrlCount);
  For i:=1 to MtrlCount do
  begin
    BlockRead(F,Materials[i-1],SizeOf(Materials[i-1]));
  end;
  SetLength(Attributes,AttributesCount);
  For i:=1 to AttributesCount do
  begin
    BlockRead(F,Attributes[i-1],SizeOf(Attributes[i-1]));
  end;
  SetLength(Textures,TexturesCount);
  For i:=1 to TexturesCount do
  begin
    BlockRead(F,Size,SizeOf(Size));
    if Size>0 then
    begin
      SetLength(TextureName,Size);
      BlockRead(F,TextureName[1],Size);
      if Length(TexturePath)>0 then
      if TexturePath[Length(TexturePath)]<>'\' then TexturePath:=TexturePath+'\';
      Textures[i-1]:=(Game.TextureManager as TTextureManager).LoadTexture(TexturePath+TextureName,TextureName);
    end else Textures[i-1]:=-1;
  end;
  CloseFile(F);
  FileMode:=fmOpenReadWrite;

  FillChar(CollisionRec,SizeOf(TCollisionRec),$00);
  pv:=VertexBuffer;
  for i:=0 to (VertexCount-1) do
  begin
    With TD3DVector(PV^) do
    begin
      //Вычисление размеров модели:
      if y>CollisionRec.Up then CollisionRec.Up:=y;
      if y<CollisionRec.Down then CollisionRec.Down:=y;
      if x<CollisionRec.Left then CollisionRec.Left:=x;
      if x>CollisionRec.Right then CollisionRec.Right:=x;
      if z>CollisionRec.Front then CollisionRec.Front:=z;
      if z<CollisionRec.Back then CollisionRec.Back:=z;
    end;
    Inc(Longint(PV),BytesPerVertex);
  end;

  //Вычисление максимального радиуса модели:
  With CollisionRec do
  begin
    if MaxRadius<Abs(Up) then MaxRadius:=Abs(Up);
    if MaxRadius<Abs(Down) then MaxRadius:=Abs(Down);
    if MaxRadius<Abs(Left) then MaxRadius:=Abs(Left);
    if MaxRadius<Abs(Right) then MaxRadius:=Abs(Right);
    if MaxRadius<Abs(Front) then MaxRadius:=Abs(Front);
    if MaxRadius<Abs(Back) then MaxRadius:=Abs(Back);
  end;

end;

Procedure TMesh.Free;
begin
  SetLength(Materials, 0); //Материал модели
  SetLength(Textures,  0); //Указатель на текстуры
  SetLength(Attributes, 0); //Указатель на текстуры

  if VertexBuffer<>nil then
  begin
    FreeMem(VertexBuffer,VertexBufferSize);
    VertexBuffer:=nil;
  end;
  if IndexBuffer<>nil then
  begin
    FreeMem(IndexBuffer,IndexBufferSize);
    IndexBuffer:=nil;
  end;

  Inherited;
end;

Procedure TMesh.Render;
Var
  i : Longint;
  ID : Cardinal;
begin
  Game.iD3DDevice.SetFVF(VFV);
  Game.TrianglesNum:=FacesCount;

//  for i:=Low(Attributes) to High(Attributes) do //По идее правильно так
  for i:=High(Attributes) downto Low(Attributes) do //но так отображается больше частей :)
  begin
    ID:=Attributes[i].AttribId;

    (Game.TextureManager as TTextureManager).SetTexture(Textures[ID]);
    Game.iD3DDevice.SetMaterial(Materials[ID]);
    Game.iD3DDevice.DrawIndexedPrimitiveUP(D3DPT_TRIANGLELIST,
                                           Attributes[ID].VertexStart,  Attributes[ID].VertexCount,
                                           Attributes[ID].FaceCount, IndexBuffer^,IndexDataFormat, VertexBuffer^, BytesPerVertex);
  end;
end;

//============================================================================//
//============================================================================//
//============================================================================//

Constructor TFont.Create(GameObj : TGame; FileName : String);
Var
  F : File;
begin
  Inherited Create;
  Game:=GameObj;
  Texture:=-1;
  if (not FileExists(FileName)) or (not FileExists(FileName+'.crd')) then Exit;
  //Загрузка текстуры при помощи менеджера текстур:
  Texture:=(Game.TextureManager as TTextureManager).LoadTexture(FileName,ExtractFileName(FileName));

  FileMode:=fmOpenRead ; //Режим окрытия файла ТОЛЬКО ЧТЕНИЕ
  AssignFile(F,FileName+'.crd');
  Reset(F,1);
  BlockRead(F,CharsInfo,SizeOf(CharsInfo));
  CloseFile(F);
  FileMode:=fmOpenReadWrite; //Режим окрытия файла ЧТЕНИЕ/ЗАПИСЬ

end;

//============================================================================//

Procedure TFont.Free;
begin
  Inherited;
end;

//============================================================================//
//============================================================================//
//============================================================================//
TYPE
  PCustomTextVertex = ^TCustomTextVertex;
  TCustomTextVertex = packed record
    x, y, z    : Single;
    RHW        : Single;
    Color      : DWORD;
    tu, tv     : Single;
  end;


Constructor TText.Create(GameObj : TGame; UsedFont : TFont; X,Y : Longint; _Rectangled : LongBool = False; RectW : Longint = 0; RectH : Longint = 0);
begin
  Inherited Create;
  Game:=GameObj;
  Font:=UsedFont;
  Rectangled:=_Rectangled;
  dX:=X;
  dY:=Y;
  W:=0;
  H:=0;
  MyText:='';
  With Rect do
  begin
    Left:=dX;
    Top :=dY;
    Right:=dx+RectW;
    Bottom:=dy+RectH;
  end;
  VFV:=D3DFVF_XYZRHW or D3DFVF_DIFFUSE or D3DFVF_TEX1;
  BytesPerVertex:=SizeOf(TCustomTextVertex);
  VertexBuffer:=nil;
  VertexBufferSize:=0;
  IndexBuffer:=nil;
  IndexBufferSize:=0;
  IndexDataFormat:=D3DFMT_INDEX16;
  VertexCount:=0;
  FacesCount:=0;

  StrInterval:=0;

  ColorUp      := $00FFFFFF;
  SelColorUp   := $00FFFFFF;
  ColorDown    := $00FFFFFF;
  SelColorDown := $00FFFFFF;

end;

//============================================================================//

Procedure TText.Free;
begin
  Clear;
  Inherited;
end;
//============================================================================//

Procedure TText.Clear;
begin
  SetLength(MyText,0);
  TextLength:=0;
  if VertexBuffer<>nil then
  begin
    FreeMem(VertexBuffer,VertexBufferSize);
    VertexBuffer:=nil;
    VertexBufferSize:=0;
  end;
  if IndexBuffer<>nil then
  begin
    FreeMem(IndexBuffer,IndexBufferSize);
    IndexBuffer:=nil;
    IndexBufferSize:=0;
  end;
  VertexCount:=0;
  FacesCount:=0;
end;


//============================================================================//

Procedure TText.SetText(Const Str : AnsiString);
Var
  tX,tY : Longint;
  p : Pointer;
  i : Longint;
  ch : Byte;

  SubstrLength : Longint;
  CurPos : Longint;

  Selected : LongBool;
begin
//  if MyText=Str then Exit;
  Clear;
  if Font=nil then Exit;
  TextLength:=Length(Str);
  MyText:=Str;
  Selected := false;

  VertexCount:=TextLength*4; //кол-во точек
  FacesCount:=TextLength*2; //кол-во треугольников

  VertexBufferSize:=VertexCount*BytesPerVertex;
  GetMem(VertexBuffer,VertexBufferSize);
  IndexBufferSize:=FacesCount*(3*2);
  GetMem(IndexBuffer,IndexBufferSize);
//Очистка данных:
  FillChar(VertexBuffer^,VertexBufferSize,$00);
  FillChar(IndexBuffer^,IndexBufferSize,$00);

  tX:=dX;
  tY:=dY;
  SubstrLength:=0;
  CurPos:=1;
  //Вертексы:
  p:=VertexBuffer;
  for i:= 1 to TextLength do
  begin

    //Если с отсечением, то рассчитываем переносы по словам:
    if Rectangled then
    begin
    if (i>=CurPos) then
    begin

      SubstrLength:=0;
      //Повторять пока не конец строки:
      While CurPos<TextLength do
      begin
        ch:=Ord(MyText[curPos]);

        Inc(SubstrLength,Font.CharsInfo[ch].W+1);

        //Если пробел, то конец слова, или длина слова превышает ширину отсечения,
        //значит длину рассчитали, выходим из цикла:
        if (ch<=32) or (ch=91) or (ch=93) or (Rect.Right-Rect.Left<SubstrLength) then
        begin
          Inc(CurPos);
          break;
        end; //if ch=32

        Inc(CurPos);

        //Если вышли за пределы отсечения, то переходим на другую строку:
        if (TX>Rect.Right-SubstrLength) then
        begin
          tX:=dX;
          Inc(tY,Font.CharsInfo[48].H+StrInterval);
        end;


      end; //While CurPos<L

    end; //if (i<=CurPos)
    end;//if Rectangled

    ch:=Ord(MyText[i]);
    if Ch<=32 then
    begin
      if Ch=10 then
      begin
        tX:=dX;
        Inc(tY,Font.CharsInfo[48].H+StrInterval);
      end else
      if Ch=32 then
      begin
        Inc(tX,Font.CharsInfo[32].W+1);
      end;
      Continue;
    end;

    if (ch=123) then
    begin
      Selected := True;
      Continue;
    end;

    if (ch=125) then
    begin
      Selected := False;
      Continue;
    end;

    if Rectangled then
    begin
      if TX>Rect.Right-Font.CharsInfo[ch].W then
      begin
        tX:=dX;
        Inc(tY,Font.CharsInfo[48].H+StrInterval);
      end;

    end; //if Rectangled

    if tX>W then W:=tX;
    if tY>H then H:=tY;

    //Левый верхний угол:
    With TCustomTextVertex(P^) do
    begin
      x:=tX;
      y:=tY;
      z:=0.0;
      RHW:=1;
      if Selected then Color:=SelColorUp else Color:=ColorUp;

      tu:=Font.CharsInfo[ch].TX1;
      tv:=Font.CharsInfo[ch].TY1;
    end;
    Inc(Longint(P),BytesPerVertex);

    //Правый верхний угол:
    With TCustomTextVertex(P^) do
    begin
      x:=tX+Font.CharsInfo[ch].W+1;
      y:=tY;
      z:=0.0;
      RHW:=1;
      if Selected then Color:=SelColorUp else Color:=ColorUp;
      tu:=Font.CharsInfo[ch].TX2;
      tv:=Font.CharsInfo[ch].TY1;
    end;
    Inc(Longint(P),BytesPerVertex);

    //Правый нижний угол:
    With TCustomTextVertex(P^) do
    begin
      x:=tX+Font.CharsInfo[ch].W+1;
      y:=tY+Font.CharsInfo[ch].H+1;
      z:=0.0;
      RHW:=1;
      if Selected then Color:=SelColorDown else Color:=ColorDown;
      tu:=Font.CharsInfo[ch].TX2;
      tv:=Font.CharsInfo[ch].TY2;
    end;
    Inc(Longint(P),BytesPerVertex);

    //Левый нижний угол:
    With TCustomTextVertex(P^) do
    begin
      x:=tX;
      y:=tY+Font.CharsInfo[ch].H+1;
      z:=0.0;
      RHW:=1;
      if Selected then Color:=SelColorDown else Color:=ColorDown;
      tu:=Font.CharsInfo[ch].TX1;
      tv:=Font.CharsInfo[ch].TY2;
    end;
    Inc(Longint(P),BytesPerVertex);

    Inc(tX,Font.CharsInfo[ch].W+1);
  end; //for i:=1 to L do

  //Индексы:
  p:=IndexBuffer;
  for i:=0 to TextLength-1 do
  begin
    //Первый треугольник:
    Word(P^):=(i*4); //Левый верхний угол
    Inc(Longint(P),2);
    Word(P^):=(i*4)+1; //Правый верхний угол
    Inc(Longint(P),2);
    Word(P^):=(i*4)+3; //Левый нижний угол
    Inc(Longint(P),2);
    //Второй треугольник:
    Word(P^):=(i*4)+3; //Левый нижний угол
    Inc(Longint(P),2);
    Word(P^):=(i*4)+1; //Правый верхний угол
    Inc(Longint(P),2);
    Word(P^):=(i*4)+2; //Правый нижний угол
    Inc(Longint(P),2);
  end; //for i:=1 to L do

  W:=W-dX;
  H:=H-dY;

end;

//============================================================================//

Procedure TText.Scroll(OfsX,OfsY : Single);
Var
  i  : Longint;
  pv : Pointer;
begin
  if VertexBuffer=nil then Exit;

  pv:=VertexBuffer;
  for i:=0 to (TextLength-1) * 4 do
  begin
    With TCustomTextVertex(PV^) do
    begin
      x:=X+OfsX;
      y:=y+OfsY;
    end;
    Inc(Longint(PV),BytesPerVertex);
  end;
end;

//============================================================================//

Procedure TText.Draw;
Var
  VP : TD3DVIEWPORT9;
begin
  if Font=nil then Exit;

  (Game.TextureManager as TTextureManager).SetTexture(Font.GetTexture);
//  (Game.TextureManager as TTextureManager).SetTexture(-1);

  With Game.iD3DDevice do
  begin

  if Rectangled then
  begin
    VP.X:=Rect.Left;
    VP.Y:=Rect.Top;
//    if VP.X<0 then VP.X:=0;
//    if VP.Y<0 then VP.Y:=0;
    VP.Width:=(Rect.Right-VP.X);
    VP.Height:=(Rect.Bottom-VP.Y);
    VP.MinZ:=0;
    VP.MaxZ:=1;
    SetViewport(VP);
  end;

    SetRenderState(D3DRS_ZENABLE, D3DZB_False);
    SetRenderState(D3DRS_ALPHABLENDENABLE,  1);
    SetRenderState(D3DRS_SRCBLEND, D3DBLEND_SRCCOLOR);
    SetRenderState(D3DRS_DESTBLEND, D3DBLEND_INVSRCCOLOR);
    SetSamplerState( 0, D3DSAMP_MAGFILTER, D3DTEXF_NONE );
    SetFVF(VFV);
    DrawIndexedPrimitiveUP(D3DPT_TRIANGLELIST, 0,  VertexCount, FacesCount, IndexBuffer^,IndexDataFormat, VertexBuffer^, BytesPerVertex);
    SetSamplerState( 0, D3DSAMP_MAGFILTER, D3DTEXF_LINEAR );

  if Rectangled then
  begin
    VP.X:=0;
    VP.Y:=0;
    VP.Width:=Game.GetD3DPRESENTPARAMETERS.BackBufferWidth;
    VP.Height:=Game.GetD3DPRESENTPARAMETERS.BackBufferHeight;
    VP.MinZ:=0;
    VP.MaxZ:=1;
    SetViewport(VP);
  end;

  end;

end;

//============================================================================//

Procedure TText.SetTextColor(UpColor,DownColor,UpSelColor,DownSelColor : Cardinal);
Var
  i  : Longint;
  pv : Pointer;
begin
  ColorUp:=UpColor;
  ColorDown:=DownColor;
  SelColorUp:=UpSelColor;
  SelColorDown:=DownSelColor;

  if TextLength<>0 then
  SetText(Copy(MyText,1,TextLength));
end;

//============================================================================//

Procedure TText.LoadFromFile(FileName : String);
Var
  F : File;
  S : AnsiString;
begin
  if FileExists(FileName) then
  begin
    FileMode:=fmOpenRead;
    AssignFile(F,FileName);
    Reset(F,1);
    SetLength(S,FileSize(F));
    BlockRead(F,S[1],Length(S));
    CloseFile(F);
    FileMode:=fmOpenReadWrite;
    Text:=S;
  end else
  begin
    Text:='Файл {'+FileName+'} не найдён!';
  end;
end;

//============================================================================//
//============================================================================//
//============================================================================//

{ TCamera }

constructor TCamera.Create(GameObj: TGame);
begin
  Game := GameObj;
  matWorld:=IdentityMatrix;

  SetCameraPos(D3DVector(0.0, 15.0,-15.0));
  SetLookTo(D3DVector(0.0, 0.0, 0.0));
  vUpVec:=D3DVector(0.0, 1.0, 0.0);

  SetProjection((PI/4), 1.0, 1.0, 400.0);

end;

function TCamera.GetCursorVector (V : TD3DVector): TD3DVector;
//Var
//  Viewport : TD3DViewport9;
begin
//  Game.iD3DDevice.GetViewport(Viewport);
//  D3DXVec3Unproject(Result, V, ViewPort, matProj,matView,matWorld);
end;

procedure TCamera.SetCamera;
begin
  CullMat:=MatrixMul(matView,matProj);
  SetViewMatrix(matView, vEyePt, vLookatPt, vUpVec);
  if Game<>nil then
  With Game.iD3DDevice do
  begin
    SetTransform(D3DTS_WORLD, matWorld);
    SetTransform(D3DTS_VIEW, matView);
    SetTransform(D3DTS_PROJECTION, matProj);
  end;
end;

procedure TCamera.SetCameraPos(Vector: TD3DVector);
begin
  vEyePt:=Vector;
end;

procedure TCamera.SetLookTo(Vector: TD3DVector);
begin
  vLookatPt:=Vector;
end;

procedure TCamera.SetProjection(FOV, Aapect, NearPlane, FarPlane : Single);
begin
  SetProjectionMatrix(matProj, FOV, Aapect, NearPlane, FarPlane);
end;

end.

//============================================================================//
//============================================================================//
//============================================================================//

