unit DGCarad8;

//  DirectGraphics enCApsulated for RAD
//
//
//  MMI (c)SANDMAN presents!!

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  D3D8,QDArc;

{ま、コンポーネントだし}
procedure Register;


(****************************************************************************
 *
 * デバッグメッセージ出力用
 *
 ****************************************************************************)
var
  DGCarad_HaltOnError:Boolean = True;        {例外が起きたらすぐにHaltする}
  DGCarad_DebugMessage:Boolean = True;       {デバッグメッセージをファイルに書き出す}
  DGCarad_DetailedLog:Boolean =  True;       {ログの出力(AllowDebugMessage:Trueでなければ出力されない)}
  DGCarad_debugIndent:Integer = 0;            //デバッグログのインデント



(****************************************************************************
 *
 * コンポーネントの骨子
 *
 ****************************************************************************)


type
  TDGCarad = class;
  TDGTexture = class;
  TDGVertexBuffer = class;
  TDGIndexBuffer = class;

  TDGNotifyEvent = procedure of Object;

  //デバッグオプション
  TDGDebugOption = set of (dgoHaltOnError, dgoDebugMessage, dgoDetailedLog);

  //リソースの情報…
  //ここで言う「リソース」というのは、D3DDeviceのロストとかに伴って無くなる可能性のあるオブジェクトの事
  TDGResourceDesc = class
    id:UINT;                      //リソース識別子
    debugName:String;             //IDだと分かりづらいので、リソース名を指定させて、デバックログに吐けるようにする
    resource:TObject;             //肝心のリソース
    OnCleanup:TDGNotifyEvent;     //イベントハンドラ
    OnRecover:TDGNotifyEvent;
    OnReset:TDGNotifyEvent;
    OnAfterReset:TDGNotifyEvent;
  end;


  //このユニットの骨子
  TDGCarad = class(TComponent)
    private
      FD3D:IDirect3D8;
      FD3DDevice:IDirect3DDevice8;
      FBackBuffers:Array of IDirect3DSurface8;
      FDepthStencilSurface:IDirect3DSurface8;
      FBackBufferCount:UINT;
      FDebugOption:TDGDebugOption;

      FUseREFDevice:Boolean;          //HELを優先的に使う
      FUseSoftwareVertexProcessing:Boolean; //SoftVPを優先的に使う

      FWindowed:Boolean;              //ウィンドウ内で実行してる？
      FBackBufferFormat:D3DFORMAT;    //バックバッファ情報
      FBackBufferWidth:UINT;
      FBackBufferHeight:UINT;

      FOwner:TForm;                   //コンポーネントの貼られているフォーム
      FLastPP:D3DPRESENT_PARAMETERS;  //最後にCreateDeviceとかResetとかした時のパラメータ
      FAdapter:UINT;                  //現在使っているアダプタ番号
      FDeviceType:D3DDEVTYPE;         //HAL? REF?

      NextResourceID:UINT;            //リソース管理
      Resources:TList;
      procedure SetDebugOption(const Value: TDGDebugOption);
    protected
      procedure SetDisplayMode(Adapter:UINT; windowed:Boolean; mode:D3DDISPLAYMODE; multiSampleType:D3DMULTISAMPLE_TYPE; depthStencilFmt:Array of D3DFORMAT; swapEffect:D3DSWAPEFFECT);  //画面モードのおまかせ設定
      function GetBackBuffers(idx:Integer):IDirect3DSurface8;

      procedure CleanupResources;                            //テクスチャ・VB・IBの全消去
      procedure RecoverResources;                            //テクスチャ・VB・IBの再生成
      procedure Loaded; override;
    public
      //コンストラクタ・デストラクタ
      constructor Create(AOwner:TComponent); override;
      destructor Destroy; override;

      //リソース管理
      function RegisterResouce(res:TObject; OnCleanup, OnRecover, OnReset,
      OnAfterReset:TDGNotifyEvent; debugName:String = ''):UINT; //リソースの登録
      procedure UnregisterResource(id:UINT);  //リソースの登録解除

      //デバイス設定
      procedure CreateDevice(Adapter:UINT; DeviceType:D3DDEVTYPE;
        hFocusWindow:HWND;  BehaviorFlags:DWord;
        var presentationParameters:D3DPRESENT_PARAMETERS); //D3DDeviceの作成と画面の初期化
      procedure ReleaseDevice;  //D3DDeviceとかの解放
      procedure WindowMode(width,height:UINT;
        depthStencilFmt:Array of D3DFORMAT;
        swapEffect:D3DSWAPEFFECT = D3DSWAPEFFECT_DISCARD;
        multiSampleType:D3DMULTISAMPLE_TYPE = D3DMULTISAMPLE_NONE;
        Adapter:UINT = D3DADAPTER_DEFAULT);     //適当に初期化
      procedure FullscreenMode(width,height:UINT; format:D3DFORMAT;
        depthStencilFmt:Array of D3DFORMAT;
        refreshRate:UINT = 0;
        presentationInterval:UINT = D3DPRESENT_INTERVAL_IMMEDIATE;
        swapEffect:D3DSWAPEFFECT = D3DSWAPEFFECT_DISCARD;
        multiSampleType:D3DMULTISAMPLE_TYPE = D3DMULTISAMPLE_NONE;
        Adapter:UINT = D3DADAPTER_DEFAULT);
      procedure Reset;  //Direct3DDeviceのリセット、最後に設定したプレゼンテーションパラメータを再設定

      //画面モードについての情報
      function GetCurrentDisplayMode(Adapter:UINT):D3DDISPLAYMODE;  //指定されたアダプタでの現在のディスプレイモードを得る
      function IsAvailableDisplayMode(Adapter:UINT; screenWidth,screenHeight:UINT; freq:UINT; fmt:D3DFORMAT):Boolean; //指定されたアダプタで、その画面モードがつかえるのかチェック

      //画面モード
      property Adapter:UINT read FAdapter;
      property DeviceType:D3DDEVTYPE read FDeviceType;
      property Windowed:Boolean read FWindowed;
      property BackBufferWidth:UINT read FBackBufferWidth;
      property BackBufferHeight:UINT read FBackBufferHeight;
      property BackBufferFormat:D3DFORMAT read FBackBufferFormat;
      property PresentationParameters:D3DPRESENT_PARAMETERS read FLastPP;

      //バッファ
      property BackBuffers[idx:Integer]:IDirect3DSurface8 read GetBackBuffers;
      property BackBufferCount:UINT read FBackBufferCount;
      property DepthStencilSurface:IDirect3DSurface8 read FDepthStencilSurface;

      //機能拡張…というより必須(^^;)
      property D3D:IDirect3D8 read FD3D;
      property D3DDevice:IDirect3DDevice8 read FD3DDevice;

    published
      //各種設定
      property UseREFDevice:Boolean read FUseREFDevice write FUseREFDevice;
      property UseSoftwareVertexProcessing:Boolean read FUseSoftwareVertexProcessing write FUseSoftwareVertexProcessing;
      property DebugOption:TDGDebugOption read FDebugOption write SetDebugOption;
  end;


  //Keep/Recoverの方法 ... Keepしない、ファイルから、QDAから、内蔵のストリームから読み直す、
  TDGKeepMethod = (kmDontKeep, kmFromFile, kmFromQDA, kmFromStream);

  //ピクセルごとの処理を登録するための関数
  TDGPerPixelOp = function (Sender:TDGTexture; srcColor:DWord; x,y:Integer; Data:Pointer):DWord;

  //テクスチャ
  TDGTexture = class
    private
      ID:UINT;                        //DGCaradが管理するためのID
      FDebugName:String;              //デバッグログに吐き出されるときの名前
      FOwner:TDGCarad;                //面倒を見てくれるDGCaradオブジェクト

      FFormat:D3DFORMAT;              //ふぉーまっと
      FormatList:Array of D3DFORMAT;  //生成されたときのフォーマットリスト。色数変更時に再生成されるときに使われる
      FWidth,FHeight:UINT;            //読み込んだ画像のサイズ
      FTotalWidth,FTotalHeight:UINT;  //テクスチャ全体のサイズ
      FU,FV:Single;                   //画像の右下を示すuv座標
      FTexture:IDirect3DTexture8;     //カブセル化しているテクスチャ
      FUsage:UINT;                    //このテクスチャの使い道
      FPool:D3DPOOL;                  //このテクスチャのプールのされ方

      FLocked:Boolean;                //ロックしてる？
      FLockedRect:D3DLOCKED_RECT;     //LOCKEDRECT情報
      FLockedRegion:TRect;            //ロックした範囲
      FLockedLevel:UINT;              //ロックしたレベル
      FPixelSize:UINT;                //1ピクセルのバイト数
      FMipLevel:UINT;                 //生成すべき(した)ミップマップのレベル

      FAutoKeep:Boolean;              //自動復元する？
      KeepMethod:TDGKeepMethod;       //読み込み方法
      KeepFilename:String;
      KeepQDAName:String;
      KeepQDAID:String;
      KeepStream:TMemoryStream;
      Recovering:Boolean;
      function GetTexels(level:UINT; x,y:Integer): DWord;
      procedure SetTexels(level:UINT; x, y:Integer; const Value: DWord);             //現在復元作業中？

    protected
      function SearchBestFormat:D3DFORMAT;             //FormatListメンバから、使える中で最も良いフォーマットを得る

      procedure Keep;                                   //現在のテクスチャの内容を保持する
      procedure CreateTexture(w,h:UINT);                //テクスチャを実際に生成する
      procedure Cleanup;                                //テクスチャを解放する(解像度変更前に呼ぶ)
      procedure Recover;                                //テクスチャを再生成して、画像を読み直す
      procedure Reset;                                  //デバイスのリセットに先立って、POOL_DEFAULTなテクスチャを解放
      procedure AfterReset;                             //デバイスのリセット後、POOL_DEFAULTなテクスチャを再生成
    public
      constructor Create(AOwner:TDGCarad; formats:Array of D3DFORMAT; _usage:UINT = 0; _pool:D3DPOOL = D3DPOOL_MANAGED; mipLevel:UINT = 0; debugName:String = ''); //フォーマットを第一希望から並べてテクスチャ生成
      destructor Destroy; override;

      //ファイルI/O
      procedure LoadFromFile(filename:String; qdaName:String = '');   //BMP読み込み
      procedure LoadFromStream(source:TStream);                    //BMPの入ったストリームから読み込み
      procedure LoadFromTBitmap(source:TBitmap);                   //TBitmapオブジェクトから読み込み

      procedure SaveToStream(dest:TStream);                        //ストリームにテクスチャの内容を32ビットBMPで保存

      //テクセル操作
      procedure PerPixelOperation(region:TRect; op:TDGPerPixelOp; data:Pointer); //全部のピクセルに、opで指定した関数によるオペレーションを行う
      procedure SetColorKey(region:TRect; col:D3DCOLOR);      //colと同じ色をα=0にする
      procedure BlueToAlpha(region:TRect);                           //B値をα値にコピーする
      procedure Fill(region:TRect; col:D3DCOLOR; maskA:Boolean);     //指定された色で塗りつぶす、maskA=Trueの時、αチャンネルは塗らない

      //サイズ操作
      procedure SetSize(w,h:UINT);        //サイズの変更

      //ロック
      function LockRect(level:UINT; rect:TRect; flags:DWORD):D3DLOCKED_RECT;
      procedure UnlockRect;

      //サイズ情報
      property Width:UINT read FWidth;
      property Height:UINT read FHeight;
      property Format:D3DFORMAT read FFormat;
      property TotalWidth:UINT read FTotalWidth;
      property TotalHeight:UINT read FTotalHeight;
      property U:Single read FU;
      property V:Single read FV;

      //ピクセル
      property Texels[level:UINT; x,y:Integer]:DWord read GetTexels write SetTexels;

      //設定
      property AutoKeep:Boolean read FAutoKeep write FAutoKeep;

      //その他
      property Texture:IDirect3DTexture8 read FTexture;
      property Pool:D3DPOOL read FPool;
      property Usage:UINT read FUsage;
  end;


  TDGVertexBuffer = class
    private
      FOwner:TDGCarad;
      FVBuf:IDirect3DVertexBuffer8;

      FLocked:Boolean;
      PLocked:Pointer;    //最後にロックしたときにゲットしたポインタ
      FVertexSize:UINT;   //一頂点当たりのサイズ
      FVertexCount:UINT;  //格納されている頂点数
      FLockStart,FLockEnd:UINT; //ロックされた範囲

      ID:UINT;            //DGCaradによって管理される際のID
      FDebugName:String;  //デバッグログに出力される名前
      KeepBuf:Pointer;    //Keepする際のバッファ

      FPool: D3DPool;
      FUsage: DWord;
      FFVF: DWORD;

      FAutoKeep: Boolean;   //Trueの時、Cleanup時に自動的にKeepする
      procedure SetVertexCount(const Value: UINT);
    protected
      procedure Cleanup;                               //VertexBufferを解放する
      procedure Recover;                               //VertexBufferを生成しなおす
      procedure Reset;                                 //デバイスのリセットに備える
      procedure AfterReset;                            //デバイスがリセットされ終わった
      procedure Keep;                         //現在の状態を次回Recover時に復元する
    public
      constructor Create(AOwner:TDGCarad; _vertexCount,_vertexSize:UINT;
        _Usage, _FVF:DWord; _Pool:D3DPool; debugName:String = '');
      destructor Destroy; override;

      //ロック
      function Lock(start,count:UINT; Flags:DWord):Pointer;
      procedure Unlock;

      //頂点の読み書き
      procedure GetVertex(idx:UINT; out v);   //頂点は型が分かんないのでプロパティに出来ないの
      procedure SetVertex(idx:UINT; const v);

      //頂点データについての情報
      property FVF:DWORD read FFVF;
      property VertexSize:UINT read FVertexSize;
      property Count:UINT read FVertexCount write SetVertexCount;

      //設定
      property AutoKeep:Boolean read FAutoKeep write FAutoKeep;

      //その他
      property VertexBuffer:IDirect3DVertexBuffer8 read FVBuf;
      property Pool:D3DPool read FPool;
      property Usage:DWORD read FUsage;
  end;


  //IndexBuffer(2バイトインデクスのみ対応)
  TDGIndexBuffer = class
    private
      FOwner:TDGCarad;
      FIBuf:IDirect3DIndexBuffer8;

      FCount:UINT;        //格納してるインデクスの数

      FLocked:Boolean;
      PLocked:Pointer;    //最後にロックしたときにゲットしたポインタ
      FLockStart,FLockEnd:UINT; //ロックされた範囲

      ID:UINT;            //DGCaradによって管理される際のID
      FDebugName:String;  //デバッグログに出力される名前
      KeepBuf:Pointer;    //Keepする際のバッファ

      FPool: D3DPool;
      FUsage: DWord;

      FAutoKeep: Boolean;   //Trueの時、Cleanup時に自動的にKeepする
      function GetIndices(idx: UINT): Word;
      procedure SetCount(const Value: UINT);
      procedure SetIndices(idx: UINT; const Value: Word);
    protected
      procedure Cleanup;                               //IndexBufferを解放する
      procedure Recover;                               //IndexBufferを生成しなおす
      procedure Reset;                                 //デバイスのリセットに備える
      procedure AfterReset;                            //デバイスがリセットされ終わった
      procedure Keep;                         //現在の状態を次回Recover時に復元する
    public
      constructor Create(AOwner:TDGCarad; _indexCount:UINT; _Usage:DWord;
       _Pool:D3DPool; debugName:String = '');
      destructor Destroy; override;

      //ロック
      function Lock(start,count:UINT; Flags:DWord):PWord;
      procedure Unlock;

      //インデクスについての情報
      property Count:UINT read FCount write SetCount;
      property Indices[idx:UINT]:Word read GetIndices write SetIndices;

      //設定
      property AutoKeep:Boolean read FAutoKeep write FAutoKeep;

      //その他
      property IndexBuffer:IDirect3DIndexBuffer8 read FIBuf;
      property Pool:D3DPool read FPool;
      property Usage:DWORD read FUsage;
  end;


(****************************************************************************
 *
 * お便利関数とか
 *
 ****************************************************************************)

  procedure DGCarad_PutDebugMessage(mes:String);  //デバッグログに出力

  //ヘルパー関数
  function D3DFORMATToString(fmt:D3DFORMAT):String;               //テクスチャフォーマットを文字列にする
  function D3DColorToPhysical(col:D3DCOLOR; fmt:D3DFORMAT):DWord; //テクスチャフォーマットにしたがって色を変換
  function ARGBToPhysical(a,r,g,b:DWord; fmt:D3DFORMAT):DWord;    //↑と同じ
  function PhysicalToARGB(pcol:DWord; fmt:D3DFORMAT):D3DCOLOR;    //テクスチャの色情報を、ARGB形式に変換
  function IsARGBFormat(fmt:D3DFORMAT):Boolean;                   //色情報を含むテクスチャフォーマットかどうか判断
  function GetPixelBits(fmt:D3DFORMAT):UINT;                      //テクスチャの１ピクセルあたりのビット数を得る

  //テクスチャにストリームからBMPを読み込む
  procedure LoadBMPStreamToTexture(texture:IDirect3DTexture8; source:TStream);

  //ロックした範囲にBMPを読み込む
  procedure LoadBMPStreamToLockedRect(LockedRect:D3DLOCKED_RECT; lockedRegion:TRect; ddsd:D3DSURFACE_DESC; source:TStream);


(****************************************************************************
 *
 * お便利定数とか
 *
 ****************************************************************************)

var

  /////テクスチャフォーマット
  //なんでもいいので適当なの、αはいらん
  DGFMT_RGB:Array[0..3] of D3DFORMAT = (D3DFMT_X8R8G8B8, D3DFMT_R8G8B8, D3DFMT_R5G6B5, D3DFMT_X1R5G5B5);
  //なんどもいいのでα付き
  DGFMT_ARGB:Array[0..2] of D3DFORMAT = (D3DFMT_A8R8G8B8, D3DFMT_A4R4G4B4, D3DFMT_A1R5G5B5);
  //16ビットので、αナシ
  DGFMT_HighColor:Array[0..1] of D3DFORMAT = (D3DFMT_R5G6B5, D3DFMT_X1R5G5B5);
  //16ビットので、αアリ
  DGFMT_HighColorA:Array[0..1] of D3DFORMAT = (D3DFMT_A4R4G4B4, D3DFMT_A1R5G5B5);
  //なんでもいいからTrueColor、αはいらん
  DGFMT_TrueColor:Array[0..1] of D3DFORMAT = (D3DFMT_X8R8G8B8, D3DFMT_R8G8B8);

  /////デプスステンシルバッファフォーマット
  //なんでもいいから安上がりの
  DGFMT_ZCheap:Array[0..2] of D3DFORMAT  = (D3DFMT_D16, D3DFMT_D16_LOCKABLE, D3DFMT_D32);
  //できれば32
  DGFMT_ZDetail:Array[0..3] of D3DFORMAT  = (D3DFMT_D32, D3DFMT_D24X8, D3DFMT_D16_LOCKABLE, D3DFMT_D16);
  //ステンシル欲しい
  DGFMT_ZStencil:Array[0..2] of D3DFORMAT  = (D3DFMT_D24S8, D3DFMT_D24X4S4, D3DFMT_D15S1);

  /////バンプマップのフォーマット
  //単なるバンプ、ルミナンス付きでもいいや
  DGFMT_Bump:Array[0..2] of D3DFORMAT  =  (D3DFMT_V8U8, D3DFMT_X8L8V8U8, D3DFMT_L6V5U5);
  //ルナミンス付きバンプ
  DGFMT_BumpL:Array[0..1] of D3DFORMAT  = (D3DFMT_X8L8V8U8, D3DFMT_L6V5U5);

implementation






(****************************************************************************
  登録
 ****************************************************************************)
procedure Register;
begin
  RegisterComponents('Quadruple D',[TDGCarad]);
end;



//ユニットローカルなグローバル変数

var
debugCount:Integer = 0;   //デバッグメッセージを今まで出力した回数


//D3Dからの返り値を文字列に
function HRESULTToString(ret:HRESULT):String;
begin
  Case DWord(ret) of
    D3D_OK: result:='D3D_OK';
    D3DERR_WRONGTEXTUREFORMAT: result:='D3DERR_WRONGTEXTUREFORMAT';
    D3DERR_UNSUPPORTEDCOLOROPERATION : result:='D3DERR_UNSUPPORTEDCOLOROPERATION ';
    D3DERR_UNSUPPORTEDCOLORARG : result:='D3DERR_UNSUPPORTEDCOLORARG ';
    D3DERR_UNSUPPORTEDALPHAOPERATION : result:='D3DERR_UNSUPPORTEDALPHAOPERATION ';
    D3DERR_UNSUPPORTEDALPHAARG : result:='D3DERR_UNSUPPORTEDALPHAARG ';
    D3DERR_TOOMANYOPERATIONS : result:='D3DERR_TOOMANYOPERATIONS ';
    D3DERR_CONFLICTINGTEXTUREFILTER: result:='D3DERR_CONFLICTINGTEXTUREFILTER';
    D3DERR_UNSUPPORTEDFACTORVALUE: result:='D3DERR_UNSUPPORTEDFACTORVALUE';
    D3DERR_CONFLICTINGRENDERSTATE: result:='D3DERR_CONFLICTINGRENDERSTATE';
    D3DERR_UNSUPPORTEDTEXTUREFILTER: result:='D3DERR_UNSUPPORTEDTEXTUREFILTER';
    D3DERR_CONFLICTINGTEXTUREPALETTE : result:='D3DERR_CONFLICTINGTEXTUREPALETTE ';
    D3DERR_DRIVERINTERNALERROR : result:='D3DERR_DRIVERINTERNALERROR ';

    D3DERR_NOTFOUND: result:='D3DERR_NOTFOUND';
    D3DERR_MOREDATA: result:='D3DERR_MOREDATA';
    D3DERR_DEVICELOST: result:='D3DERR_DEVICELOST';
    D3DERR_DEVICENOTRESET: result:='D3DERR_DEVICENOTRESET';
    D3DERR_NOTAVAILABLE: result:='D3DERR_NOTAVAILABLE';
    D3DERR_OUTOFVIDEOMEMORY: result:='D3DERR_OUTOFVIDEOMEMORY';
    D3DERR_INVALIDDEVICE : result:='D3DERR_INVALIDDEVICE ';
    D3DERR_INVALIDCALL : result:='D3DERR_INVALIDCALL ';
    D3DERR_DRIVERINVALIDCALL : result:='D3DERR_DRIVERINVALIDCALL ';
  else
    result:=Format('UNKNOWN ERROR ... $%.8x',[ret]);
  end;
end;

//デバッグメッセージの出力
procedure PutDebugMessage(mes:String);
var
  F:TextFile;
  fname:String;
  ident:String;
  i:Integer;
begin
  //デバッグメッセージの出力が禁止になっているなら、何もしない
  if not DGCarad_DebugMessage then
    Exit;

  //EXEファイルのあるディレクトリのdddd.debugというファイルに一行書き込む
  fname:=ExtractFilePath(Application.Exename) + 'DGCarad_DebugLog.txt';

  //ファイルを開く
  AssignFile(F,fname);
  //もし、プログラムの実行後、はじめての書き込みなら、ファイルをクリア
  if debugCount = 0 then
    ReWrite(F)
  else
    Append(F);

  Inc(debugCount);

  //一行書き込む
  ident:='';
  For i:=0 to DGCarad_debugIndent-1 do
    ident:=ident + '  ';

  Writeln(F,Format('#%.5d | %s%s',[debugCount,ident,mes]));

  //ファイル閉じる
  CloseFile(F);
end;

//エクスポート用
procedure DGCarad_PutDebugMessage(mes:String);
begin
  PutDebugMessage(mes);
end;

//テストビルド時のデバッグメッセージ出力
procedure PutTestMessage(mes:String);
begin
  if DGCarad_DetailedLog then
    PutDebugMessage(mes);
end;

//errがD3D_OK以外なら文句たれる
function TRYDG(err:HRESULT; failMes:String):HRESULT;
begin
  result:=err;

  if err = D3D_OK then
    exit;

  PutDebugMessage(failMes+Format('(Error Code = %s)',[HRESULTToString(err)]));
  if DGCarad_HaltOnError then
    Halt; //安全のため、Haltしちゃう
end;



{ ヘルパー関数 }

//D3DFORMAT型変数を文字列にする
function D3DFORMATToString(fmt:D3DFORMAT):String;
begin
  Case fmt of
    D3DFMT_R8G8B8:    result:='R8G8B8';
    D3DFMT_A8R8G8B8:  result:='A8R8G8B8';
    D3DFMT_X8R8G8B8:  result:='X8R8G8B8';
    D3DFMT_R5G6B5:    result:='R5G6B5';
    D3DFMT_X1R5G5B5:  result:='X1R5G5B5';
    D3DFMT_A1R5G5B5:  result:='A1R5G5B5';
    D3DFMT_A4R4G4B4:  result:='A4R4G4B4';
    D3DFMT_R3G3B2:    result:='R3G3B2';
    D3DFMT_A8:        result:='A8';
    D3DFMT_A8R3G3B2:  result:='A8R3G3B2';
    D3DFMT_X4R4G4B4:  result:='X4R4G4B4';
    D3DFMT_A8P8:      result:='A8P8';
    D3DFMT_P8:        result:='P8';
    D3DFMT_L8:        result:='L8';
    D3DFMT_A8L8:      result:='A8L8';
    D3DFMT_A4L4:      result:='A4L4';
    D3DFMT_V8U8:      result:='V8U8';
    D3DFMT_L6V5U5:    result:='L6V5U5';
    D3DFMT_X8L8V8U8:  result:='X8L8V8U8';
    D3DFMT_Q8W8V8U8:  result:='Q8W8V8U8';
    D3DFMT_V16U16:    result:='V16U16';
    D3DFMT_W11V11U10: result:='W11V11U10';
    D3DFMT_UYVY:      result:='UYVY';
    D3DFMT_YUY2:      result:='YUY2';
    D3DFMT_DXT1:      result:='DXT1';
    D3DFMT_DXT2:      result:='DXT2';
    D3DFMT_DXT3:      result:='DXT3';
    D3DFMT_DXT4:      result:='DXT4';
    D3DFMT_DXT5:      result:='DXT5';
    D3DFMT_D16_LOCKABLE:  result:='D16_LOCKABLE';
    D3DFMT_D32:       result:='D32';
    D3DFMT_D15S1:     result:='D15S1';
    D3DFMT_D24S8:     result:='D24S8';
    D3DFMT_D16:       result:='D16';
    D3DFMT_D24X8:     result:='D24X8';
    D3DFMT_D24X4S4:   result:='D24X4S4';
    D3DFMT_VERTEXDATA:result:='VERTEXDATA';
    D3DFMT_INDEX16:   result:='INDEX16';
    D3DFMT_INDEX32:   result:='INDEX32';
    else
      result:='UNKNOWN';
  end;
end;

//D3DCOLOR(ARGB)をテクスチャ上の色表現にする
function D3DColorToPhysical(col:D3DCOLOR; fmt:D3DFORMAT):DWord;
var
  a,r,g,b:DWord;
begin

  Case fmt of
    D3DFMT_R8G8B8: begin
      result:=col;
    end;

    D3DFMT_A8R8G8B8: begin
      result:=col;
    end;

    D3DFMT_X8R8G8B8: begin
      result:=col And $00FFFFFF;
    end;

    D3DFMT_R5G6B5: begin
      r:=(col And $00FF0000) Shr 19; //16+3
      g:=(col And $0000FF00) Shr 10; //8+2
      b:=(col And $000000FF) Shr 3;
      result:=(r Shl 11) Or (g Shl 5) Or b;
    end;

    D3DFMT_X1R5G5B5: begin
      r:=(col And $00FF0000) Shr 19; //16+3
      g:=(col And $0000FF00) Shr 11; //8+3
      b:=(col And $000000FF) Shr 3;
      result:=(r Shl 10) Or (g Shl 5) Or b;
    end;

    D3DFMT_A1R5G5B5: begin
      a:=col Shr 31; //24+7
      r:=(col And $00FF0000) Shr 19; //16+3
      g:=(col And $0000FF00) Shr 11; //8+3
      b:=(col And $000000FF) Shr 3;
      result:=(a shl 15) Or (r Shl 10) Or (g Shl 5) Or b;
    end;

    D3DFMT_A4R4G4B4: begin
      a:=col Shr 28; //24+4
      r:=(col And $00FF0000) Shr 20; //16+4
      g:=(col And $0000FF00) Shr 12; //8+4
      b:=(col And $000000FF) Shr 4;
      result:=(a shl 12) Or (r Shl 8) Or (g Shl 4) Or b;
    end;

    D3DFMT_R3G3B2: begin
      r:=(col And $00FF0000) Shr 21; //16+5
      g:=(col And $0000FF00) Shr 13; //8+5
      b:=(col And $000000FF) Shr 6;
      result:=(r Shl 5) Or (g Shl 2) Or b;
    end;

    D3DFMT_A8: begin
      result:=col Shr 24;
    end;

    D3DFMT_A8R3G3B2: begin
      a:=col Shr 24;
      r:=(col And $00FF0000) Shr 21; //16+5
      g:=(col And $0000FF00) Shr 13; //8+5
      b:=(col And $000000FF) Shr 6;
      result:=(a shl 8) Or (r Shl 5) Or (g Shl 2) Or b;
    end;

    D3DFMT_X4R4G4B4: begin
      r:=(col And $00FF0000) Shr 20; //16+4
      g:=(col And $0000FF00) Shr 12; //8+4
      b:=(col And $000000FF) Shr 4;
      result:=(r Shl 8) Or (g Shl 4) Or b;
    end;

    //以下、バンプマップ用
    //ARGBの、RをL(W)。GをU、BをVとして読む AはAそのままとか、Qとか
    D3DFMT_X8L8V8U8: begin
      result:=col and $00FFFFFF;
    end;

    D3DFMT_Q8W8V8U8: begin
      result:=col;
    end;

    D3DFMT_W11V11U10: begin
      //もったいないから使うな(w
      r:=(col And $00FF0000) Shr 16;
      g:=(col And $0000FF00) Shr 8;
      b:=(col And $000000FF);
      result:=(r Shl 24) Or (g Shl 13) Or (b Shl 2);
    end;

    D3DFMT_V16U16: begin
      //もったいないから使うな(w
      g:=(col And $0000FF00) Shr 8;
      b:=(col And $000000FF);
      result:=(g Shl 24) Or (b Shl 8);
    end;

    D3DFMT_L6V5U5: begin
      r:=(col And $00FF0000) Shr 18; //16+2
      g:=(col And $0000FF00) Shr 11; //8+3
      b:=(col And $000000FF) Shr 3;
      result:=(r Shl 10) Or (g Shl 5) Or b;
    end;

    D3DFMT_V8U8: begin
      result:=col And $0000FFFF;
    end;

    D3DFMT_A8L8: begin
      a:=(col And $FF000000) Shr 24;
      r:=(col And $00FF0000) Shr 16;
      result:=(a Shl 8) Or r;
    end;

    D3DFMT_L8: begin
      result:=(col And $00FF0000) shr 16;
    end;

    D3DFMT_A4L4: begin
      a:=(col And $FF000000) Shr 28;  //24 + 4;
      r:=(col And $00FF0000) Shr 20;  //16 + 4
      result:=(a shl 4) Or r;
    end;

    
    else
      result:=0;

  end;
end;

//8ビットARGB値をテクスチャ上の色表現にする
function ARGBToPhysical(a,r,g,b:DWord; fmt:D3DFORMAT):DWord;
begin

  Case fmt of
    D3DFMT_R8G8B8: begin
      result:=(r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_A8R8G8B8: begin
      result:=(a Shl 24) Or (r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_X8R8G8B8: begin
      result:=(r Shl 16) Or (g Shl 8) Or b;
    end;
    
    D3DFMT_R5G6B5: begin
      r:=r Shr 3;
      g:=g Shr 2;
      b:=b Shr 3;
      result:=(r Shl 11) Or (g Shl 5) Or b;
    end;

    D3DFMT_X1R5G5B5: begin
      r:=r Shr 3;
      g:=g Shr 3;
      b:=b Shr 3;
      result:=(r Shl 10) Or (g Shl 5) Or b;
    end;

    D3DFMT_A1R5G5B5: begin
      a:=a Shr 7;
      r:=r Shr 3;
      g:=g Shr 3;
      b:=b Shr 3;
      result:=(a shl 15) Or (r Shl 10) Or (g Shl 5) Or b;
    end;

    D3DFMT_A4R4G4B4: begin
      a:=a Shr 4;
      r:=r Shr 4;
      g:=g Shr 4;
      b:=b Shr 4;
      result:=(a shl 12) Or (r Shl 8) Or (g Shl 4) Or b;
    end;

    D3DFMT_R3G3B2: begin
      r:=r Shr 5;
      g:=g Shr 5;
      b:=b Shr 6;
      result:=(r Shl 5) Or (g Shl 2) Or b;
    end;

    D3DFMT_A8: begin
      result:=a;
    end;

    D3DFMT_A8R3G3B2: begin
      r:=r Shr 5;
      g:=g Shr 5;
      b:=b Shr 6;
      result:=(a shl 8) Or (r Shl 5) Or (g Shl 2) Or b;
    end;

    D3DFMT_X4R4G4B4: begin
      r:=r Shr 4;
      g:=g Shr 4;
      b:=b Shr 4;
      result:=(r Shl 8) Or (g Shl 4) Or b;
    end;


    //以下、バンプマップ用

    D3DFMT_X8L8V8U8: begin
      result:=(r shl 16) Or (g shl 8) Or b;
    end;

    D3DFMT_Q8W8V8U8: begin
      result:=(a shl 24) Or (r shl 16) Or (g shl 8) Or b;
    end;

    D3DFMT_W11V11U10: begin
      //もったいないから使うな(w
      result:=(r Shl 24) Or (g Shl 13) Or (b Shl 2);
    end;

    D3DFMT_V16U16: begin
      //もったいないから使うな(w
      result:=(g Shl 24) Or (b Shl 8);
    end;

    D3DFMT_L6V5U5: begin
      r:=r shr 2;
      g:=g shr 3;
      b:=b shr 3;
      result:=(r Shl 10) Or (g Shl 5) Or b;
    end;

    D3DFMT_V8U8: begin
      result:=(g shl 8) Or b;
    end;

    D3DFMT_A8L8: begin
      result:=(a Shl 8) Or r;
    end;

    D3DFMT_L8: begin
      result:=r;
    end;

    D3DFMT_A4L4: begin
      a:=a shr 4;
      r:=r shr 4;
      result:=(a shl 4) Or r;
    end;

    else
      result:=0;

  end;
end;

//物理カラーをD3DCOLORへ。
function PhysicalToARGB(pcol:DWord; fmt:D3DFORMAT):D3DCOLOR;
var
  a,r,g,b:DWord;

  //ビット数を増やして8ビットに(nBitはもとのビット数)
  function GainBit(c, nBit:DWord):DWord;
  begin
    result:=c * 255 div (1 shl nBit - 1);
  end;

begin

  Case fmt of
    D3DFMT_R8G8B8,D3DFMT_X8R8G8B8: begin
      result:=$FF000000 Or pcol;
    end;

    D3DFMT_A8R8G8B8: begin
      result:=pcol;
    end;

    D3DFMT_R5G6B5: begin
      r:=GainBit(pcol And $0000F800 Shr 11, 5);
      g:=GainBit(pcol And $000003E0 Shr 5 , 6);
      b:=GainBit(pcol And $0000001F       , 5);
      result:=$FF000000 Or (r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_X1R5G5B5: begin
      r:=GainBit(pcol And $00007C00 Shr 10 ,5);
      g:=GainBit(pcol And $000001E0 Shr 5  ,5);
      b:=GainBit(pcol And $0000001F        ,5);
      result:=$FF000000 Or (r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_A1R5G5B5: begin
      a:=pcol Shr 15 * $FF;
      r:=GainBit(pcol Shr 10 And $1F , 5);
      g:=GainBit(pcol Shr 5  And $1F , 5);
      b:=GainBit(pcol And $0000001F  , 5);

      result:=(a Shl 24) Or (r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_A4R4G4B4: begin
      a:=GainBit(pcol               Shr 12, 4);
      r:=GainBit(pcol And $00000F00 Shr 8,  4);
      g:=GainBit(pcol And $000000F0 Shr 4,  4);
      b:=GainBit(pcol And $0000000F,        4);
      result:=(a Shl 24) Or (r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_X4R4G4B4: begin
      r:=GainBit(pcol And $00000F00 Shr 8, 4);
      g:=GainBit(pcol And $000000F0 Shr 4, 4);
      b:=GainBit(pcol And $0000000F,       4);
      result:=$FF000000 Or (r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_R3G3B2: begin
      r:=GainBit(pcol Shr  5 And $000000E0, 3);
      g:=GainBit(pcol Shr  2 And $0000001C, 3);
      b:=GainBit(pcol        And $00000003, 2);
      result:=$FF000000 Or (r Shl 16) Or (g Shl 8) Or b;
    end;
    D3DFMT_A8R3G3B2: begin
      a:=pcol Shr 24;
      r:=GainBit(pcol Shr  5 And $000000E0, 3);
      g:=GainBit(pcol Shr  2 And $0000001C, 3);
      b:=GainBit(pcol        And $00000003, 2);
      result:=(a Shl 24) Or (r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_A8: begin
      result:=pcol Shl 24;
    end;

    //以下、バンプマップ用

    D3DFMT_X8L8V8U8: begin
      result:=pcol;
    end;

    D3DFMT_Q8W8V8U8: begin
      result:=pcol;
    end;

    D3DFMT_W11V11U10: begin
      //もったいないから使うな(w
      r:=pcol Shr 21;
      g:=pcol Shr 10 And $000007FF;
      b:=pcol        And $000003FF;
      result:=(r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_V16U16: begin
      //もったいないから使うな(w
      g:=pcol Shr 16;
      b:=pcol        And $000FFFF;
      result:=(g Shl 8) Or b;
    end;

    D3DFMT_L6V5U5: begin
      //符号付なので、GainBitは使えない
      r:=(pcol Shr 10 And $0000003F) Shl 2;
      g:=(pcol Shr  5 And $0000001F) Shl 3;
      b:=(pcol        And $0000001F) Shl 3;
      result:=(r Shl 16) Or (g Shl 8) Or b;
    end;

    D3DFMT_V8U8: begin
      result:=pcol;
    end;

    D3DFMT_A8L8: begin
      result:=pcol shl 16;
    end;

    D3DFMT_L8: begin
      result:=pcol shl 16;
    end;

    D3DFMT_A4L4: begin
      a:=GainBit(pcol shr 4 And $0000000F, 4);
      r:=GainBit(pcol       And $0000000F, 4);
      result:=(a shl 24) Or (r shl 16);
    end;

    else
      result:=0;

  end;
end;


//このフォーマットは色表現用のフォーマットか？
function IsARGBFormat(fmt:D3DFORMAT):Boolean;
begin
  result:=fmt in
    [
      D3DFMT_R8G8B8,
      D3DFMT_A8R8G8B8,
      D3DFMT_R5G6B5,
      D3DFMT_X1R5G5B5,
      D3DFMT_A1R5G5B5,
      D3DFMT_A4R4G4B4,
      D3DFMT_R3G3B2,
      D3DFMT_A8,
      D3DFMT_A8R3G3B2,
      D3DFMT_X4R4G4B4
    ];
end;

//１ピクセルあたりのビット数を得る
function GetPixelBits(fmt:D3DFORMAT):UINT;
begin
  Case fmt of
    D3DFMT_R8G8B8:    result:=24;
    D3DFMT_A8R8G8B8:  result:=32;
    D3DFMT_X8R8G8B8:  result:=32;
    D3DFMT_R5G6B5:    result:=16;
    D3DFMT_X1R5G5B5:  result:=16;
    D3DFMT_A1R5G5B5:  result:=16;
    D3DFMT_A4R4G4B4:  result:=16;
    D3DFMT_R3G3B2:    result:=8;
    D3DFMT_A8:        result:=8;
    D3DFMT_A8R3G3B2:  result:=16;
    D3DFMT_X4R4G4B4:  result:=16;
    D3DFMT_A8P8:      result:=16;
    D3DFMT_P8:        result:=8;
    D3DFMT_L8:        result:=8;
    D3DFMT_A8L8:      result:=16;
    D3DFMT_A4L4:      result:=8;
    D3DFMT_V8U8:      result:=16;
    D3DFMT_L6V5U5:    result:=16;
    D3DFMT_X8L8V8U8:  result:=32;
    D3DFMT_Q8W8V8U8:  result:=32;
    D3DFMT_V16U16:    result:=32;
    D3DFMT_W11V11U10: result:=32;
    D3DFMT_D16_LOCKABLE:  result:=16;
    D3DFMT_D32:       result:=32;
    D3DFMT_D15S1:     result:=16;
    D3DFMT_D24S8:     result:=32;
    D3DFMT_D16:       result:=16;
    D3DFMT_D24X8:     result:=32;
    D3DFMT_D24X4S4:   result:=32;
  else
    result:=0;
  end;
end;


//ロックした範囲にBMPを読み込む
procedure LoadBMPStreamToLockedRect(LockedRect:D3DLOCKED_RECT; lockedRegion:TRect; ddsd:D3DSURFACE_DESC; source:TStream);
var
  bih:TBitmapInfoHeader;
  bfh:TBitmapFileHeader;
  bypp:DWord;    //サーフェスのBytes/Pix
  fbypp:DWord;   //ファイルのBytes/Pix
  pal:Array[0..255] of TRGBQUAD;

  i,bpl,fbpl:DWord;
  trBytes:DWord;          //転送するバイト数/行
  trHeight,trWidth:DWord; //転送するサイズ
  pix,buf,dest:pByte;

  //ファイル＝8ビットの場合の変換ルーチン
  procedure Process8bit(pix,buf:Pointer);
  var
    i:Integer;

    pSrc,pDest:pByte;
    idx:Byte;   //パレットインデクス
    phys:DWord; //物理カラー
  begin

    pSrc:=buf;
    pDest:=pix;

    For i:=0 to trWidth-1 do begin
      idx:=pSrc^;

      phys:=ARGBToPhysical($FF, pal[idx].rgbRed, pal[idx].rgbGreen, pal[idx].rgbBlue, ddsd.Format);
      Move(phys, pDest^, bypp);

      //PutTestMessage(Format('src : %.2x ; dest : %.8x',[idx,phys]));

      Inc(pSrc);
      Inc(pDest,bypp);
    end;

  end;

  //ファイル＝16ビットの場合の変換ルーチン
  procedure Process16bit(pix,buf:Pointer);
  var
    i:Integer;

    pSrc:pWord;
    pDest:pByte;
    logi:Word;   //ファイルから読んだ論理カラー
    phys:DWord;  //サーフェスに書き込む物理カラー
  begin

    pSrc:=buf;
    pDest:=pix;

    For i:=0 to trWidth-1 do begin
      logi:=pSrc^;

      //ARGB1555として読み込み
      phys:=ARGBToPhysical(
        logi Shr 15,
        (logi And $7C00) Shr 10,
        (logi And $03E0) Shr 5,
        (logi And $001F),
        ddsd.Format);

      Move(phys, pDest^, bypp);

      Inc(pSrc);
      Inc(pDest,bypp);
    end;

  end;

  //ファイル＝24ビットの場合の変換ルーチン
  procedure Process24bit(pix,buf:Pointer);
  var
    i:Integer;

    pSrc:pByte;
    pDest:pByte;
    logi:DWord;   //ファイルから読んだ論理カラー
    phys:DWord;  //サーフェスに書き込む物理カラー
  begin

    pSrc:=buf;
    pDest:=pix;

    For i:=0 to trWidth-1 do begin
      Move(pSrc^, logi, 3);

      phys:=ARGBToPhysical(
        $FF,
        (logi And $00FF0000) Shr 16,
        (logi And $0000FF00) Shr 8,
        (logi And $000000FF),
        ddsd.Format);

      Move(phys, pDest^, bypp);

      Inc(pSrc,3);
      Inc(pDest,bypp);
    end;

  end;

  //ファイル＝32ビットの場合の変換ルーチン
  procedure Process32bit(pix,buf:Pointer);
  var
    i:Integer;

    pSrc:pDWord;
    pDest:pByte;
    logi:DWord;   //ファイルから読んだ論理カラー
    phys:DWord;  //サーフェスに書き込む物理カラー
  begin

    pSrc:=buf;
    pDest:=pix;

    For i:=0 to trWidth-1 do begin
      logi:=pSrc^;

      phys:=D3DColorToPhysical(logi, ddsd.Format);

      Move(phys, pDest^, bypp);

      Inc(pSrc);
      Inc(pDest,bypp);
    end;

  end;

  //bufの中身を、pixに変換する
  procedure ProcessLine(pix, buf: Pointer);
  begin

    Case fbypp of
      1:Process8bit(pix,buf);
      2:Process16bit(pix,buf);
      3:Process24bit(pix,buf);
      4:Process32bit(pix,buf);
    end;
  end;

begin


  try
    //BMPファイルヘッダを読む(IDのチェック)
    Source.Read(bfh,sizeof(bfh));
  except
    PutDebugMessage('ビットマップの読みこみ中に、エラーが発生しました');
    Exit;
  end;

  if bfh.bfType<> (Ord('M') shl 8 ) + Ord('B') then begin
    PutDebugMessage('不正なBMPファイルです');
    Exit;
  end;

  //BMPインフォヘッダの読み込み
  try
    Source.Read(bih,sizeof(bih));
  except
    PutDebugMessage('LoadBMP中に、読み込みエラーが発生しました');
    Exit;
  end;

  //8ビット〜32ビット以外のBMPはダメ
  if (bih.biBitCount < 8) Or (bih.biBitCount > 32) then begin
    TRYDG(1, '色数が8ビット〜32ビットの範囲のビットマップを、LoadBMPには指定してください');
    exit;
  end;


  //サーフェスの bypp を得る
  bypp:=GetPixelBits(ddsd.Format) div 8;

  //ファイルの byppを 得る
  fbypp := bih.biBitCount div 8;


  if ddsd.Format = D3DFMT_P8 then begin

    { サーフェスが8ビットパレットつきの場合 }
    { 実は未サポート、スマソ }

    if (fbypp>1) then begin
      { ファイルがハイカラー以上なら、転送できません }
      TRYDG(1, '8ビットパレット付きテクスチャに対して16ビット以上のBMPをロードする事は出来ません');
      exit;

    end else begin
      { ファイルも 1bypp なら、直接流し込む }

      try
        Source.Read(pal[0],1024);
      except
        PutDebugMessage('LoadBMP中に、読み込みエラーが発生しました');
        Exit;
      end;

      Source.Position:=bfh.bfOffBits;

      //イメージバッファの作成
      bpl := (DWord(bih.biWidth)*bypp+3) And $FFFFFFFC;
      fbpl := (DWord(bih.biWidth)*fbypp+3) And $FFFFFFFC;

      getMem(pix,bpl);
      getMem(buf,fbpl);


      //DIBを上下さかさまにコピー
      trBytes := LockedRect.Pitch;

      //転送するバイト数は、テクスチャの１ライン分の情報量と、ビットマップのそれうち、少ないほう
      if (trBytes > bpl) then
        trBytes := bpl;

      //読み込むライン数は、ロック範囲の行数と、ビットマップの行数のうち、少ないほう
      trHeight:=lockedRegion.Bottom - lockedRegion.Top;
      if trHeight > DWord(bih.biHeight) then
        trHeight := DWord(bih.biHeight);

      trWidth:=lockedRegion.Right - lockedRegion.Left;
      if trWidth > DWord(bih.biWidth) then
        trWidth:=DWord(bih.biWidth);

      dest := LockedRect.pBits;
      Inc(dest,LockedRect.Pitch * (trHeight-1));

      //読み込み元ビットマップに対して、転送範囲が小さい場合は、読み込み元をずらす(DIBが上下逆だから)
      if bih.biHeight > trHeight then
        Source.Position:=Source.Position + fbpl * (bih.biHeight - trHeight);

      try
        for i:=0 to trHeight-1 do begin
          Source.Read(buf^, fbpl);
          //if bpp=fbpp then
          Move(buf^,dest^,trBytes);
          //else begin
          //  convDIBLine(pix,buf,bih.biWidth,bpp,fbpp,pal,ddsd.ddpfPixelFormat);
          //  Move(pix^,dest^,pitch);
          //end;
          Dec(dest,LockedRect.Pitch);
        end;
      except
        PutDebugMessage('LoadBMP中に、読み込みエラーが発生しました');
        Exit;
      end;


      FreeMem(pix);
      FreeMem(buf);


    end;

  end else begin
    {サーフェスがパレット付きではない場合}

    //パレットの読み込み(読み込み元がパレット付きBMPの時)
    if fbypp = 1 then begin
      try
        Source.Read(pal[0],1024);
      except
        PutDebugMessage('LoadBMP中に、読み込みエラーが発生しました');
        Exit;
      end;
    end;

    Source.Position:=bfh.bfOffBits;

    //イメージバッファの作成
    bpl := (DWord(bih.biWidth)*bypp+3) And $FFFFFFFC;
    fbpl := (DWord(bih.biWidth)*fbypp+3) And $FFFFFFFC;

    getMem(pix,bpl);
    getMem(buf,fbpl);

    //DIBを上下さかさまにコピー
    trBytes := LockedRect.Pitch;
    if (trBytes > bpl) then
      trBytes := bpl;

    //読み込むライン数は、ロック範囲の行数と、ビットマップの行数のうち、少ないほう
    trHeight:=lockedRegion.Bottom - lockedRegion.Top;
    if trHeight > DWord(bih.biHeight) then
      trHeight := DWord(bih.biHeight);

    trWidth:=lockedRegion.Right - lockedRegion.Left;
    if trWidth > DWord(bih.biWidth) then
      trWidth:=DWord(bih.biWidth);

    dest := LockedRect.pBits;
    Inc(dest,LockedRect.Pitch * (trHeight-1));

    //読み込み元ビットマップに対して、転送範囲が小さい場合は、読み込み元をずらす(DIBが上下逆だから)
    if bih.biHeight > trHeight then
      Source.Position:=Source.Position + fbpl * (bih.biHeight - trHeight);     

    try
      for i:=0 to trHeight-1 do begin
        Source.Read(buf^, fbpl);

        ProcessLine(pix, buf);    //変換
        //if bpp=fbpp then
        Move(pix^,dest^,trBytes);
        //else begin
        //  convDIBLine(pix,buf,bih.biWidth,bpp,fbpp,pal,ddsd.ddpfPixelFormat);
        //  Move(pix^,dest^,pitch);
        //end;
        Dec(dest,LockedRect.Pitch);
      end;
    except
      PutDebugMessage('LoadBMP中に、読み込みエラーが発生しました');
      Exit;
    end;

    FreeMem(pix);
    FreeMem(buf);

  end;
end;

//テクスチャにストリームからBMPを読み込む
procedure LoadBMPStreamToTexture(texture:IDirect3DTexture8; source:TStream);
var
  ddsd:D3DSURFACE_DESC;
  lockRect:D3DLOCKED_RECT;
begin
  //読込先テクスチャのサイズをゲッチュ
  texture.GetLevelDesc(0, ddsd);

  //サーフェスのロック
  TRYDG(texture.lockRect(0, lockRect, Nil, 0), 'LoadBMP中にサーフェスがロックできませんでした');


  //読み込み
  LoadBMPStreamToLockedRect(lockRect, Rect(0,0,ddsd.Width,ddsd.Height), ddsd, source);

  //アンロック
  TRYDG(texture.UnlockRect(0),'LoadBMP中にサーフェスがアンロックできませんでした');
end;








{ TDGCarad }

constructor TDGCarad.Create(AOwner:TComponent);
var
  i,count:Integer;
begin
  inherited Create(AOwner);
  FOwner:=TForm(AOwner);

  //二重貼りのチェック
  if (csDesigning in ComponentState) then begin
    count:=0;
    for i:=0 to Owner.ComponentCount-1 do begin
      if Owner.Components[i] is TDGCarad then begin
        Inc(count);
      end;
    end;

    if count >=2 then begin
      raise Exception.Create('DGCaradコンポーネントを、同一フォームに2つ以上貼る事はできません');
      exit;
    end;
  end;


  //コンポーネントのデフォルト値をセット
  FDebugOption:=[dgoHaltOnError, dgoDetailedLog, dgoDebugMessage];
  FUseREFDevice:=False;
  FUseSoftwareVertexProcessing:=False;

end;


procedure TDGCarad.Loaded;
var
  cw:Word;  //FPUのコントロールワード指定用
begin
  inherited;

  //以下は、実行時のみ
  if not (csDesigning in ComponentState) then begin
    FD3DDevice:=Nil;
    FBackBuffers:=Nil;
    FDepthStencilSurface:=Nil;
    FBackBufferCount:=0;

    //プロパティハンドラを呼んで、各グローバル変数に適用
    DebugOption:=DebugOption;

    //8087CW($133f) と同じ、OpenGL、Direct3Dとかを使うときのおまじない
    //「不正な浮動小数演算命令」が出なくなる
    cw:=$133f;
    asm
      FNCLEX
      FLDCW cw;
    end;

    Resources:=TList.Create;
    NextResourceID:=0;

    PutTestMessage('');
    PutTestMessage('■■■起動時の初期化をします■■■');
    Inc(DGCarad_debugIndent);

    //Direct3Dの生成
    PutTestMessage('Direct3Dを生成します');
    FD3D:=Direct3DCreate8(D3D_SDK_VERSION);
    if D3D = Nil then begin
      TRYDG(1, 'Direct3Dオプジェクトすら生成できません、論外');
      exit;
    end;

    //最初はウィンドウモードで初期化しとく
    PutTestMessage('ウィンドウのクライアント領域のサイズに合わせて初期化を開始します');
    WindowMode(FOwner.ClientWidth, FOwner.ClientHeight, []);

    Dec(DGCarad_debugIndent);
    PutTestMessage('■■■DGCarad 起動しました■■■');
    PutTestMessage('');
  end;
end;



procedure TDGCarad.CreateDevice(Adapter:UINT; DeviceType:D3DDEVTYPE;
 hFocusWindow:HWND;  BehaviorFlags:DWord; var presentationParameters:D3DPRESENT_PARAMETERS);
var
  i:Integer;
begin

  //既に確保されているデバイスオブジェクトの解放
  if D3DDevice <> Nil then begin
    PutTestMessage('新しいデバイスの生成の前に、全ての関連オブジェクトを解放します');
    ReleaseDevice;
  end;

  //Direct3Dデバイスの作成
  PutTestMessage('Direct3DDeviceオブジェクトの生成を行います');
  TRYDG(D3D.CreateDevice(Adapter, DeviceType, hFocusWindow, BehaviorFlags, presentationParameters, FD3DDevice),
     'Direct3DDeviceオブジェクトの生成に失敗しました');


  //BackBuffer、ステンシルバッファをゲット
  FBackBufferCount:=presentationParameters.BackBufferCount;
  SetLength(FBackBuffers, BackBufferCount);

  For i:=0 to BackBufferCount-1 do
    D3DDevice.GetBackBuffer(i, D3DBACKBUFFER_TYPE_MONO, FBackBuffers[i]);

  if D3DDevice.GetDepthStencilSurface(FDepthStencilsurface) <> D3D_OK then
    FDepthStencilSurface:=Nil;

  //プレゼンテーションパラメータの保存
  FLastPP:=presentationParameters;

  //いろいろ覚えとく
  FDeviceType:=DeviceType;
  FAdapter:=Adapter;

  FWindowed:=FLastPP.Windowed;
  FBackBufferWidth:=FlastPP.BackBufferWidth;
  FBackBufferHeight:=FLastPP.BackBufferHeight;
  FBackBufferFormat:=FLastPP.BackBufferFormat;

  //リソースの再構築
  RecoverResources;
end;

//解放ルーチン
procedure TDGCarad.ReleaseDevice;
var
  i:Integer;
begin
  PutTestMessage('');
  PutTestMessage('■■■Direct3Dデバイスを解放します■■■');
  Inc(DGCarad_debugIndent);

  //リソースの解放
  CleanupResources;

  //デプスステンシルサーフェスの解放
  if FDepthStencilSurface <> Nil then begin
    PutTestMessage('デプスステンシルサーフェスを解放します');
    TRYDG(FDepthStencilSurface.Release, 'デプスステンシルサーフェスの解放に失敗しました');
    FDepthStencilSurface:=Nil;
  end;

  //バックバッファの解放
  if FBackBuffers <> Nil then begin
    PutTestMessage('バックバッファを解放します');
    For i:=0 to BackBufferCount-1 do
      TRYDG(BackBuffers[i].Release, 'バックバッファ #' + IntToStr(i) + '　の解放に失敗しました');
    FBackBuffers:=Nil;
  end;

  if D3DDevice <> Nil then begin
    PutTestMessage('Direct3DDeviceオブジェクトの解放を行います');
    TRYDG(D3DDevice.Release, 'Direct3DDeviceオブジェクトの解放に失敗しました');
    FD3DDevice:=Nil;
  end;

  Dec(DGCarad_debugIndent);
  PutTestMessage('■■■Direct3Dデバイスを解放しました■■■');
  PutTestMessage('');
end;

destructor TDGCarad.Destroy;
var
  i:Integer;
begin

  if  not (csDesigning in ComponentState) then begin
    PutTestMessage('');
    PutTestMessage('■■■お別れの時がやってまいりました■■■');
    Inc(DGCarad_debugIndent);

    //メモリリークのチェック
    while Resources.Count > 0 do begin
      PutTestMessage(Format('ID %d(%s) のDGCaradリソースは、明示的に解放されていません',[TDGResourceDesc(Resources[0]).id, TDGResourceDesc(Resources[0]).debugName]));
      //暗黙のうちに解放
      TDGResourceDesc(Resources[0]).resource.Free;
    end;

    PutTestMessage('DGCaradオブジェクトの解放に伴い、全ての関連オブジェクトを解放します');
    ReleaseDevice;

    PutTestMessage('Direct3Dオブジェクトの解放を行います');
    TRYDG(D3D.Release, 'Direct3Dオブジェクトの解放に失敗しました');

    {
    Textures.Free;
    VertexBuffers.Free;
    IndexBuffers.Free;
    }

    For i:=0 to Resources.Count-1 do
      TDGResourceDesc(Resources[i]).Free;

    Resources.Free;

    Dec(DGCarad_debugIndent);
    PutTestMessage('■■■それではごきげんよう■■■');
    PutTestMessage('');
  end;


  inherited;
end;


//現在設定されているディスプレイモードを得る
function TDGCarad.GetCurrentDisplayMode(Adapter: UINT): D3DDISPLAYMODE;
var
  dm:D3DDISPLAYMODE;
begin
  D3D.GetAdapterDisplayMode(Adapter, dm);
  result:=dm;
end;


//画面モードおまかせ設定
procedure TDGCarad.SetDisplayMode(Adapter:UINT; windowed:Boolean; mode:D3DDISPLAYMODE; multiSampleType:D3DMULTISAMPLE_TYPE; depthStencilFmt:Array of D3DFORMAT; swapEffect:D3DSWAPEFFECT);  //画面モードのおまかせ設定
var
  prep:D3DPRESENT_PARAMETERS;
  caps:D3DCAPS8;
  ai:D3DADAPTER_IDENTIFIER8;
  drvName:String;
  drvDesc:String;

  //一番いいDepth/Stencilバッファフォーマットを得る
  function BestZSFormat(devType:D3DDEVTYPE):D3DFORMAT;
  var
    i:Integer;
  begin
    result:=D3DFMT_UNKNOWN;
    if prep.EnableAutoDepthStencil then begin
      For i:=0 to Length(depthStencilFmt)-1 do begin
        if D3D.CheckDepthStencilMatch(Adapter, devType, prep.BackBufferFormat, prep.BackBufferFormat, depthStencilFmt[i]) = D3D_OK then begin
          result:=depthStencilFmt[i];
          exit;
        end;
      end;
    end;
    PutTestMessage('希望のデプスステンシルサーフェスのフォーマットが見つかりませんでした');
  end;

begin
  PutTestMessage('');
  PutTestMessage('■■■画面モードを初期化します■■■');
  Inc(DGCarad_debugIndent);

  //プレゼンテーションパラメータ設定
  ZeroMemory(@prep, Sizeof(prep));
  prep.Windowed:=windowed;
  prep.SwapEffect:=SwapEffect;
  prep.BackBufferWidth:=mode.Width;
  prep.BackBufferHeight:=mode.Height;
  prep.BackBufferFormat:=mode.Format;
  prep.MultiSampleType:=multiSampleType;


  //ドライバ識別情報の表示
  D3D.GetAdapterIdentifier(Adapter, D3DENUM_NO_WHQL_LEVEL, ai);
  drvName:=StrPas(ai.Driver);
  drvDesc:=StrPas(ai.Description);

  PutTestMessage(Format('Driver : %s', [drvName]));
  PutTestMessage(Format('Description : %s', [drvDesc]));
  PutTestMessage(Format('VendorID : %.8x, DeviceID : %.8x, SubSysID : %.8x, Revision : %.8x', [ai.VendorID,ai.DeviceID,ai.SubsysID,ai.Revision]));
  
  if windowed then begin
    PutTestMessage(Format('ウィンドウモード %dx%dで初期化します',[mode.Width, mode.Height]));
  end else begin
    PutTestMessage(Format('フルスクリーンモード %dx%d %dHz %s で初期化します',[mode.Width,mode.Height,mode.RefreshRate,D3DFormatToString(mode.Format)]));    prep.BackBufferWidth:=mode.Width;
    prep.FullScreen_RefreshRateInHz:=mode.RefreshRate;
  end;

  prep.hDeviceWindow:=FOwner.Handle;
  prep.EnableAutoDepthStencil := (Length(depthStencilFmt) <> 0);

  if (D3D.GetDeviceCaps(Adapter, D3DDEVTYPE_HAL, caps) = D3D_OK) And (not FUseREFDevice) then begin//= then begin// D3D_OK then begin
    //HALはつかえるらしいね
    PutTestMessage('ハードウェアアクセラレーションを利用します');

    prep.AutoDepthStencilFormat:=BestZSFormat(D3DDEVTYPE_HAL);
    PutTestMessage('デプスステンシルサーフェスのフォーマット...' + D3DFORMATToString(prep.AutoDepthStencilFormat));

    //H/W T&L に対応してるなら、H/W T&Lさせる
    if (caps.DevCaps And DWord(D3DDEVCAPS_HWTRANSFORMANDLIGHT) = 0) Or (FUseSoftwareVertexProcessing) then begin
      PutTestMessage('ソフトウェアT&Lを利用します');
      CreateDevice(Adapter, D3DDEVTYPE_HAL, FOwner.Handle, D3DCREATE_SOFTWARE_VERTEXPROCESSING, prep);
    end else begin
      PutTestMessage('ハードウェアT&Lを利用します');
      CreateDevice(Adapter, D3DDEVTYPE_HAL, FOwner.Handle, D3DCREATE_HARDWARE_VERTEXPROCESSING, prep);
    end;

  end else begin
    //HELのみ、ショボ
    PutTestMessage('ソフトウェアエミュレーションを利用します');

    prep.AutoDepthStencilFormat:=BestZSFormat(D3DDEVTYPE_REF);
    PutTestMessage('デプスステンシルサーフェスのフォーマット...' + D3DFORMATToString(prep.AutoDepthStencilFormat));

    CreateDevice(Adapter, D3DDEVTYPE_REF, FOwner.Handle, D3DCREATE_SOFTWARE_VERTEXPROCESSING, prep);
  end;

  Dec(DGCarad_debugIndent);
  PutTestMessage('■■■画面モードを初期化しました■■■');
  PutTestMessage('');
end;


//フルスクリーンモードで適当に初期化
procedure TDGCarad.FullscreenMode(width,height:UINT; format:D3DFORMAT;
  depthStencilFmt:Array of D3DFORMAT;
  refreshRate:UINT = 0;
  presentationInterval:UINT = D3DPRESENT_INTERVAL_IMMEDIATE;
  swapEffect:D3DSWAPEFFECT = D3DSWAPEFFECT_DISCARD;
  multiSampleType:D3DMULTISAMPLE_TYPE = D3DMULTISAMPLE_NONE;
  Adapter:UINT = D3DADAPTER_DEFAULT);
var
  mode:D3DDISPLAYMODE;
begin
  PutTestMessage('');
  PutTestMessage('■■■フルスクリーンモードへ移行します■■■');
  Inc(DGCarad_debugIndent);

  mode.Width:=width;
  mode.Height:=height;
  mode.RefreshRate:=refreshRate;
  mode.Format:=format;
  SetDisplayMode(Adapter, False, mode, multiSampleType, depthStencilFmt, swapEffect);

  Dec(DGCarad_debugIndent);
  PutTestMessage('■■■フルスクリーンモードへ移行しました■■■');
  PutTestMessage('');
end;

//ウィンドウモードで適当に初期化
procedure TDGCarad.WindowMode(width,height:UINT; depthStencilFmt:Array of D3DFORMAT;
  swapEffect:D3DSWAPEFFECT = D3DSWAPEFFECT_DISCARD;
  multiSampleType:D3DMULTISAMPLE_TYPE = D3DMULTISAMPLE_NONE;
  Adapter:UINT = D3DADAPTER_DEFAULT);     //適当に初期化
var
  mode:D3DDISPLAYMODE;
begin
  PutTestMessage('');
  PutTestMessage('■■■Windowモードへ移行します■■■');
  Inc(DGCarad_debugIndent);

  //初期化前にデバイスオブジェクトを全部消す…こうしないと、フルスクリーンからの変更は「現在のディスプレイモード」が得られない
  ReleaseDevice;

  mode:=GetCurrentDisplayMode(Adapter);
  mode.Width:=width;
  mode.Height:=height;

  SetDisplayMode(Adapter, True, mode, multiSampleType, depthstencilFmt, swapEffect);

  //なぜかSetWindowPosじゃないとちゃんと位置・サイズが変わってくれない(^^;)
  SetWindowPos(
    FOwner.Handle,
    HWND_NOTOPMOST,
    FOwner.Left,
    FOwner.Top,
    width - UINT(FOwner.ClientWidth - FOwner.Width),
    height - UINT(FOwner.ClientHeight - FOwner.Height),
    SWP_SHOWWINDOW);


  Dec(DGCarad_debugIndent);
  PutTestMessage('■■■Windowモードへ移行しました■■■');
  PutTestMessage('');
end;


//プロパティのアクセサ
function TDGCarad.GetBackBuffers(idx: Integer): IDirect3DSurface8;
begin
  result:=FBackBuffers[idx];
end;


//指定されたアダプタで、その画面モードがつかえるのかチェック
function TDGCarad.IsAvailableDisplayMode( Adapter,
  screenWidth,screenHeight: UINT; freq: UINT; fmt: D3DFORMAT): Boolean;
var
  i:Integer;
  nMode:UINT;
  mode:D3DDISPLAYMODE;  //入力されたディスプレイモード
  enumMode:D3DDISPLAYMODE;  //列挙されたモード
begin
  mode.Width:=screenWidth;
  mode.Height:=screenHeight;
  mode.RefreshRate:=freq;
  mode.Format:=fmt;

  nMode:=D3D.GetAdapterModeCount(Adapter);

  For i:=0 to nMode-1 do begin
    D3D.EnumAdapterModes(Adapter, i, enumMode);
    if CompareMem(@enumMode, @mode, Sizeof(D3DDISPLAYMODE)) then begin
      result:=True;
      exit;
    end;
  end;

  result:=False;
end;

procedure TDGCarad.Reset;
var
  i:Integer;
begin
  PutTestMessage('');
  PutTestMessage('■■■Direct3DDeviceをリセットします■■■');
  Inc(DGCarad_debugIndent);


  //リソースのリセット準備
  For i:=0 to Resources.Count-1 do begin
    if Assigned(TDGResourceDesc(Resources[i]).OnReset) then
      TDGResourceDesc(Resources[i]).OnReset;
  end;


  //バックバッファの解放
  For i:=0 to BackBufferCount-1 do
    BackBuffers[i].Release;
  //デプスステンシルサーフェスの解放
  DepthStencilSurface.Release;

  TRYDG(D3DDevice.Reset(FLastPP), 'リセットに失敗しました');

  For i:=0 to BackBufferCount-1 do
    D3DDevice.GetBackBuffer(i, D3DBACKBUFFER_TYPE_MONO,FBackBuffers[i]);
  D3DDevice.GetDepthStencilSurface(FDepthStencilSurface);


  //リソースのリセット後イベントを呼ぶ
  For i:=0 to Resources.Count-1 do begin
    if Assigned(TDGResourceDesc(Resources[i]).OnAfterReset) then
      TDGResourceDesc(Resources[i]).OnAfterReset;
  end;

  Dec(DGCarad_debugIndent);
  PutTestMessage('■■■Direct3DDeviceをリセットしました■■■');
  PutTestMessage('');
end;


//リソースの登録
function TDGCarad.RegisterResouce(res:TObject; OnCleanup, OnRecover, OnReset,
  OnAfterReset:TDGNotifyEvent; debugName:String = ''):UINT;
var
  p:TDGResourceDesc;
begin

  PutTestMessage(Format('DGCaradリソース(%s)を登録します ID は %d(%s) です', [res.ClassName, NextResourceID, debugName]));
  result:=NextResourceID;

  p:=TDGResourceDesc.Create;
  p.id:=NextResourceID;
  p.resource:=res;
  p.OnCleanup:=OnCleanup;
  p.OnRecover:=OnRecover;
  p.OnReset:=OnReset;
  p.OnAfterReset:=OnAfterReset;
  p.debugName:=debugName;
  Resources.Add(p);

  Inc(NextResourceID);
end;

procedure TDGCarad.UnregisterResource(id: UINT);
var
  i:Integer;
begin
  For i:=0 to Resources.Count-1 do begin
    if TDGResourceDesc(Resources[i]).id = id then begin
      PutTestMessage(Format('DGCaradリソース(%s) : ID %d(%s) を登録解除します', [TDGResourceDesc(Resources[i]).resource.ClassName, id, TDGResourceDesc(Resources[i]).debugName]));
      TDGResourceDesc(Resources[i]).Free;
      Resources.Delete(i);
      exit;
    end;
  end;
  TRYDG(1, Format('リストに入ってないDGCaradリソース(ID:%d)が、UnregisterResource手続きに渡されました',[id]));
end;

//リソースの全消去
procedure TDGCarad.CleanupResources;
var
  i:Integer;
begin
  PutTestMessage('全てのDGCaradリソースを解放します');

  For i:=0 to Resources.Count-1 do
    if Assigned(TDGResourceDesc(Resources[i]).OnCleanup) then
      TDGResourceDesc(Resources[i]).OnCleanup;

end;

//リソースの再生成
procedure TDGCarad.RecoverResources;
var
  i:Integer;
begin
  PutTestMessage('全てのDGCaradリソースを再構築します');

  For i:=0 to Resources.Count-1 do
    if Assigned(TDGResourceDesc(Resources[i]).OnRecover) then
      TDGResourceDesc(Resources[i]).OnRecover;
end;




{ TDGTexture }

//フォーマットを第一希望から並べてテクスチャ生成
constructor TDGTexture.Create(AOwner:TDGCarad; formats:Array of D3DFORMAT; _usage:UINT = 0; _pool:D3DPOOL = D3DPOOL_MANAGED; mipLevel:UINT = 0; debugName:String = '');
var
  i:Integer;
begin
  FOwner:=AOwner;
  FTexture:=Nil;
  FUsage:=_usage;
  FFormat:=D3DFMT_UNKNOWN;
  KeepStream:=Nil;
  KeepMethod:=kmDontKeep;
  Recovering:=False;
  FPool:=_pool;
  FMipLevel:=mipLevel;

  //POOL_Defaultは自動復元しない
  AutoKeep := Pool <> D3DPOOL_DEFAULT;

  //フォーマットリストをコピーする
  SetLength(FormatList, Length(formats));
  For i:=0 to High(formats) do
    FormatList[i]:=formats[i];

  //DGCaradに登録
  ID:=FOwner.RegisterResouce(Self, Cleanup, Recover, Reset, AfterReset, debugName);
  FDebugName:=debugName;
  //ID:=FOwner.RegisterTexture(Self);

end;

//テクスチャを実際に生成する
procedure TDGTexture.CreateTexture(w, h: UINT);
var
  rest:UINT;
begin
  if FTexture <> Nil then begin
    PutTestMessage('テクスチャの再生成に伴い、以前のテクスチャを解放します');
    TRYDG(FTexture.Release, 'テクスチャの解放に失敗しました');
  end;

  //フォーマットリストから一番良いフォーマットを得る
  FFormat:=SearchBestFormat;
  PutTestMessage(SysUtils.Format('使用されるフォーマットは %s です',[D3DFORMATToString(Format)]));

  TRYDG(FOwner.D3DDevice.CreateTexture(w,h, FMipLevel, Usage, Format, Pool, FTexture), 'テクスチャの生成に失敗しました');

  PutTestMessage(SysUtils.Format('残りテクスチャ容量は、約%fメガです', [FOwner.D3DDevice.GetAvailableTextureMem / (1024*1024)]));

  FPixelSize:=GetPixelBits(Format) div 8;
end;

destructor TDGTexture.Destroy;
begin
  PutTestMessage('テクスチャオブジェクトを解放します');
  if FTexture <> Nil then begin
    TRYDG(FTexture.Release, 'テクスチャの解放に失敗しました');
  end;

  if KeepStream <> Nil then
    KeepStream.Free;

  //登録解除
  FOwner.UnregisterResource(Self.ID);

  FormatList:=Nil;

  inherited;
end;



//FormatListメンバから、使える中で最も良いフォーマットを得る
function TDGTexture.SearchBestFormat: D3DFORMAT;
var
  i:Integer;
  desc:D3DSURFACE_DESC;
begin
  //デフォルトでは、バックバッファのフォーマット
  FOwner.BackBuffers[0].GetDesc(desc);
  result:=desc.Format;

  //使えるフォーマットを第一希望から探索
  if Length(FormatList) <> 0 then begin
    For i:=0 to High(FormatList) do begin
      if FOwner.D3D.CheckDeviceFormat(FOwner.Adapter, FOwner.DeviceType, desc.Format, usage, D3DRTYPE_TEXTURE, FormatList[i]) = D3D_OK then begin
        result:=FormatList[i];
        exit;
      end;
    end;
  end;
end;


procedure TDGTexture.LoadFromFile(filename: String; qdaName:String = '');
var
  fs:TFileStream;
  bi:TBitmapInfoHeader;
  ms:TMemoryStream;
begin

  if qdaName = '' then begin
    //アーカイブ名が略されたなら、ファイルから読み込む

    PutTestMessage(Sysutils.Format('ID %d(%s) のテクスチャに、%s を読み込みます',[ID, FDebugName, filename]));

    try
      fs:=TFileStream.Create(filename, fmOpenRead);

      //ヘッダを読む
      fs.Seek(sizeof(TBitmapFileHeader), soFromBeginning);
      fs.Read(bi,sizeof(TBitmapInfoHeader));
      SetSize(bi.biWidth, bi.biHeight);

      //巻き戻し
      fs.Seek(0, soFromBeginning);
      LoadBMPStreamToTexture(FTexture, fs);
      fs.Free;
    except
      TRYDG(1, filename + 'からの、読み込みエラー');
    end;


    //自動復元情報を更新
    KeepMethod:=kmFromFile;
    KeepFilename:=filename;
  end else begin
    //アーカイブから読み込む

    PutTestMessage(Sysutils.Format('ID %d(%s) のテクスチャに、QDAファイル%s から ID %s を読み込みます',[ID, FDebugName, qdaName, filename]));

    try
      ms:=ExtractFromQDAFile(qdaName, filename);

      //ヘッダを読む
      ms.Seek(sizeof(TBitmapFileHeader), soFromBeginning);
      ms.Read(bi,sizeof(TBitmapInfoHeader));
      SetSize(bi.biWidth, bi.biHeight);

      //巻き戻し
      ms.Seek(0, soFromBeginning);
      LoadBMPStreamToTexture(FTexture, ms);
      ms.Free;
    except
      TRYDG(1, filename + ' ＠ ' + qdaName + 'からの、読み込みエラー');
    end;


    //自動復元情報を更新
    KeepMethod:=kmFromQDA;
    KeepQDAName:=qdaName;
    KeepQDAID:=filename;

  end;
end;


procedure TDGTexture.LoadFromStream(source: TStream);
var
  bi:TBitmapInfoHeader;
  pos:Int64;    //読み出し前の位置
begin

  PutTestMessage(Sysutils.Format('ID %d のテクスチャに、ストリームから読み込みます',[ID]));

  try
    //ヘッダを読む
    pos:=source.Position;
    source.Seek(sizeof(TBitmapFileHeader), soFromCurrent);
    source.Read(bi,sizeof(TBitmapInfoHeader));
    SetSize(bi.biWidth, bi.biHeight);

    //巻き戻して読み込み
    source.Position:=pos;
    LoadBMPStreamToTexture(FTexture, source);

    //自動復元情報を更新…必要になったら内蔵ストリームに勝手に保存＆復元
    keepMethod:=kmFromStream;

  except
    TRYDG(1, 'ストリームからの、読み込みエラー');
  end;


end;


//TBitmapから読み込み
procedure TDGTexture.LoadFromTBitmap(source: TBitmap);
var
  tmpStream:TMemoryStream;
begin
  PutTestMessage(Sysutils.Format('ID %d のテクスチャに、TBitmapから読み込みます',[ID]));

  //一旦BMPオブジェクトをtmpStreamにセーブ
  tmpStream:=TMemoryStream.Create;
  source.SaveToStream(tmpStream);

  //tmpStreamから読み込む
  tmpStream.Position:=0;
  LoadFromStream(tmpStream);
  tmpStream.Free;

  KeepMethod:=kmFromStream;

end;


//ストリームにテクスチャの内容を32ビットBMP形式で書き出す
procedure TDGTexture.SaveToStream(dest: TStream);
var
  bf:TBitmapFileHeader;
  bi:TBitmapInfoHeader;
  pLine:PByte;
  pPix:PByte;
  col:DWord;
  x,y:Integer;
  lineBuf:Array of DWord;
begin

  //ヘッダ作成
  bf.bfType:=Ord('B') + Ord('M') Shl 8;
  bf.bfSize:=Sizeof(bf) + Sizeof(bi) + (Width * Height) * 4;
  bf.bfReserved1:=0;
  bf.bfReserved2:=0;
  bf.bfOffBits:=sizeof(bf) + sizeof(bi);

  bi.biSize:=Sizeof(bi);
  bi.biWidth:=Width;
  bi.biHeight:=Height;
  bi.biPlanes:=1;
  bi.biBitCount:=32;
  bi.biCompression:=BI_RGB;
  bi.biSizeImage:=Width*Height*4;
  bi.biXPelsPerMeter:=0;
  bi.biYPelsPerMeter:=0;
  bi.biClrUsed:=0;
  bi.biClrImportant:=0;

  //ヘッダ書き込み
  dest.WriteBuffer(bf, Sizeof(bf));
  dest.WriteBuffer(bi, Sizeof(bi));

  SetLength(lineBuf, Width);

  //変換。上下逆に書き込み
  LockRect(0, Rect(0,0,Width,Height), D3DLOCK_READONLY);
  For y:=Height-1 downto 0 do begin
    pLine:=FLockedRect.pBits;
    Inc(pLine, y*FLockedRect.Pitch);
    pPix:=Pointer(pLine);

    //一ライン変換して
    For x:=0 to Width-1 do begin
      col:=0;
      Move(pPix^, col, FPixelSize);
      lineBuf[x]:=PhysicalToARGB(col, Format);
      Inc(pPix, FPixelSize);
    end;
    //書き込み
    dest.WriteBuffer(lineBuf[0], Width*4);

  end;
  UnlockRect;

  lineBuf:=Nil;

end;



procedure TDGTexture.SetSize(w, h: UINT);
var
  caps:D3DCAPS8;

  //2の整数べき、かつ、x以上の中で最も小さい数を得る
  function AlignP2(x:UINT):UINT;
  begin
    result:=1;
    while result < x do
      result := result Shl 1;
  end;
begin
  //Widthとして、最初に指定されたw,hを記録
  FWidth:=w;
  FHeight:=h;

  FOwner.D3D.GetDeviceCaps(FOwner.Adapter, FOwner.DeviceType, caps);

  if (caps.MaxTextureWidth < w) Or (caps.MaxTextureHeight < h) then
    PutTestMessage(SysUtils.Format('要求されたテクスチャのサイズは大きすぎます。%d x %d 以内にして下さい',[caps.MaxTextureWidth, caps.MaxTextureHeight]));

  //SQUAREONLYの場合、一辺のサイズをデカい方に合わせる
  if (caps.TextureCaps And D3DPTEXTURECAPS_SQUAREONLY) <> 0 then begin
    if w > h then
      h:=w
    else
      w:=h;
  end;

  //POW2なら、2の整数べきにそろえる
  if (caps.TextureCaps And D3DPTEXTURECAPS_POW2) <> 0 then begin
    w:=AlignP2(w);
    h:=AlignP2(h);
  end;

  //TotalWidth,TotalHeightとして、加工後のw,hを記録
  FTotalWidth:=w;
  FTotalHeight:=h;

  //右下隅のuv座標を算出
  FU:=FWidth / FTotalWidth;
  FV:=FHeight / FTotalHeight;

  //テクスチャ生成
  CreateTexture(w, h);

  //キープ情報の削除(リカバー中を除く)
  if not Recovering then begin
    if KeepStream<>Nil then
      KeepStream.Free;
    KeepMethod:=kmFromStream;
  end;
end;


//現在のテクスチャの内容を保持する
procedure TDGTexture.Keep;
begin
  if KeepStream <> Nil then
    KeepStream.Free;

  KeepStream:=TMemoryStream.Create;
  SaveToStream(KeepStream);
  KeepStream.Position:=0;
end;

//テクスチャを解放する、必要なら保存
procedure TDGTexture.Cleanup;
begin
  if FTexture <> Nil then begin
    //現在の状態を保存(kmFromStreamの時)
    //kmFromFile,kmFromQDAの時は、ファイルから読み込む
    if (KeepMethod = kmFromStream) And AutoKeep then
      Keep;

    FTexture.Release;
    FTexture:=Nil;
  end;
end;

//テクスチャを再生成して、Keepした内容を復元
procedure TDGTexture.Recover;
begin
  Recovering:=True;

  if AutoKeep then begin
    Case KeepMethod of
      kmDontKeep:     //中身は復元しなくていい
        SetSize(Width, Height);

      kmFromFile: begin //ファイルから読み直し(テクスチャの生成は、読み込みメソッド内で行われる)
        LoadFromFile(KeepFilename);
      end;

      kmFromQDA: begin  //QDAから
        LoadFromFile(KeepQDAName, KeepQDAID);
      end;

      kmFromStream: begin
        LoadFromStream(KeepStream); //復元して、それまで使ってたKeepStreamは消す
        KeepStream.Free;
        KeepStream:=Nil;
      end;

    end;
  end else begin
    //オブジェクトだけは復元
    SetSize(Width, Height);
  end;

  Recovering:=False;
end;



//デバイスのリセット後、POOL_DEFAULTなテクスチャを再生成
procedure TDGTexture.AfterReset;
begin
  if Pool = D3DPOOL_DEFAULT then
    SetSize(Width, Height);
end;

//デバイスのリセットに先立って、POOL_DEFAULTなテクスチャを解放
procedure TDGTexture.Reset;
begin
  if Pool = D3DPOOL_DEFAULT then
    Cleanup;
end;



//ロック
function TDGTexture.LockRect(level: UINT; rect: TRect;
  flags: DWORD): D3DLOCKED_RECT;
begin
  FLocked:=True;

  //ロックして書き換えたテクスチャは、ファイルからの自動復元の対象にしない
  if (flags And D3DLOCK_READONLY) = 0 then
    if KeepMethod <> kmDontKeep then
      KeepMethod:=kmFromStream;

  if FTexture = Nil then begin
    TRYDG(1, 'テクスチャが確保されていません。LockRectの前にSetSizeするか、BMPを読み込んでください');
    Exit;
  end;

  FLockedRegion:=rect;
  TRYDG(FTexture.LockRect(level, FLockedRect, @rect, flags), 'LockRectに失敗しました');
  result:=FLockedRect;
end;

//アンロック
procedure TDGTexture.UnlockRect;
begin
  TRYDG(FTexture.UnlockRect(FLockedLevel), 'アンロックに失敗しました');
  FLocked:=False;
end;

//テクセルゲッチュ
function TDGTexture.GetTexels(level:UINT; x, y:Integer): DWord;
var
  p:PByte;
begin
  result:=0;

  if FLocked then begin
    if (x >= FLockedRegion.Right) Or (x < FLockedRegion.Left) Or (y < FLockedRegion.Top) Or (y >= FLockedRegion.Bottom) then begin
      TRYDG(1, 'ロックした範囲外のテクセルを操作ようとしました');
      exit;
    end;

    if FLockedLevel <> level then begin
      TRYDG(1, 'ロックしたレベルと同じレベルでテクセルを操作してください');
      exit;
    end;

    p:=FLockedRect.pBits;
    Inc(p,(y-FLockedRegion.Top)*FLockedRect.Pitch + (x-FLockedRegion.Left)*FPixelSize);
    Move(p^, result, FPixelSize);
  end else begin
    LockRect(level, Rect(x,y,x,y), D3DLOCK_READONLY);
    Move(FLockedRect.pBits^, result, FPixelSize);
    UnlockRect;
  end;

end;

//テクセルセット
procedure TDGTexture.SetTexels(level:UINT; x, y:Integer; const Value: DWord);
var
  p:PByte;
begin

  if FLocked then begin
    if (x >= FLockedRegion.Right) Or (x < FLockedRegion.Left) Or (y < FLockedRegion.Top) Or (y >= FLockedRegion.Bottom) then begin
      TRYDG(1, 'ロックした範囲外のテクセルを操作ようとしました');
      exit;
    end;

    if FLockedLevel <> level then begin
      TRYDG(1, 'ロックしたレベルと同じレベルでテクセルを操作してください');
      exit;
    end;

    p:=FLockedRect.pBits;
    Inc(p, (y-FLockedRegion.Top)*FLockedRect.Pitch + (x-FLockedRegion.Left)*FPixelSize);
    Move(Value, p^, FPixelSize);
  end else begin
    LockRect(level, Rect(x,y,x,y), 0);
    Move(Value, FLockedRect.pBits^, FPixelSize);
    UnlockRect;
  end;
end;



//全部のピクセルに、opで指定した関数によるオペレーションを行う
procedure TDGTexture.PerPixelOperation(region:TRect; op: TDGPerPixelOp; data:Pointer);
var
  x,y:Integer;
  pPix:PByte;
  src,dest:DWord;
begin

  LockRect(0, region, 0);

  For y:=region.Top to region.Bottom-1 do begin
    pPix:=FLockedRect.pBits;
    Inc(pPix, (y - region.Top)*FLockedRect.Pitch);
    For x:=region.Left to region.Right-1 do begin
      src:=0;

      Move(pPix^, src, FPixelSize);
      dest:=op(Self, src, x,y, data);
      Move(dest, pPix^, FPixelSize);

      Inc(pPix, FPixelSize);
    end;
  end;

  UnlockRect;

end;



procedure TDGTexture.Fill(region:TRect; col: D3DCOLOR; maskA:Boolean);
var
  x,y:Integer;
  pPix:pByte;
  phys:DWord; //実際に書き込む色
  srcCol:D3DCOLOR;
begin

  LockRect(0, region, 0);

  if not maskA then begin
    phys:=D3DColorToPhysical(col, Format);

    //最初の一ラインは転送しまくりでなんとかする
    pPix:=FLockedRect.pBits;
    For x:=region.Left to region.Right-1 do begin
      Move(phys, pPix^, FPixelSize);
      Inc(pPix, FPixelSize);
    end;

    //あとはコピー
    pPix:=FLockedRect.pBits;
    For y:=region.Top+1 to region.Bottom-1 do begin
      Inc(pPix, FLockedRect.Pitch);
      Move(FLockedRect.pBits^, pPix^, Width * FPixelSize);
    end;

  end else begin

    //マスク付き…単に転送というわけにはいかんのよ
    For y:=region.Top to region.Bottom-1 do begin
      pPix:=FLockedRect.pBits;
      Inc(pPix, (y-region.Top)  * FLockedRect.Pitch);
      For x:=region.Left to region.Right-1 do begin
        //ゲッチュ
        phys:=0;
        Move(pPix^, phys, FPixelSize);

        srcCol:=PhysicalToARGB(phys, Format);
        srcCol:=(srcCol And $FF000000) Or (col And $00FFFFFF); 

        //変換してかきこ
        phys:=D3DColorToPhysical(srcCol, Format);
        Move(phys, pPix^, FPixelSize);

        Inc(pPix,FPixelSize);
      end;
    end;


  end;

  UnlockRect;
end;



//青の輝度をα値へ(変換ルーチン本体)
function BlueToAlphaOP( Sender:TDGTexture; src:DWord; x,y:Integer; data:Pointer):DWord;
var
  col:D3DCOLOR;
begin
  col:=PhysicalToARGB(src, Sender.Format);
  col:=(col And $00FFFFFF) Or (col And $FF Shl 24);  //B を A にコピー
  result:=D3DColorToPhysical(col, Sender.Format);
end;

//青の輝度をα値へ
procedure TDGTexture.BlueToAlpha(region:TRect);
begin
  PerPixelOperation(region, BlueToAlphaOP, Nil);
end;



//カラーキーの設定、変換ルーチン
function SetColorKeyOP( Sender:TDGTexture; src:DWord; x,y:Integer; data:Pointer):DWord;
var
  col:D3DCOLOR;
begin
  col:=PhysicalToARGB(src, Sender.Format) And $00FFFFFF;

  if col <> PDWord(data)^ then
    col:=col Or $FF000000;

  result:=D3DColorToPhysical(col, Sender.Format);
end;

//カラーキーの設定
procedure TDGTexture.SetColorKey(region:TRect; col: D3DCOLOR);
var
  ck:DWord;
begin
  ck:=D3DColorToPhysical(col, Format) And $00FFFFFF;  //α値を一旦ゼロにしてOPに渡す
  PerPixelOperation(region, SetColorKeyOP, @ck);
end;


//コンポーネントロード時の処理
//デバッグオプション
procedure TDGCarad.SetDebugOption(const Value: TDGDebugOption);
begin
  FDebugOption := Value;

  DGCarad_HaltOnError := dgoHaltOnError in Value;
  DGCarad_DetailedLog := dgoDetailedLog in Value;
  DGCarad_DebugMessage := dgoDebugMessage in Value;
end;




{ TDGVertexBuffer }

constructor TDGVertexBuffer.Create(AOwner:TDGCarad; _vertexCount,_vertexSize:UINT; _Usage, _FVF:DWord; _Pool:D3DPool; debugName:String = '');
begin
  FOwner:=AOwner;
  FLocked:=False;
  FVBuf:=Nil;
  KeepBuf:=Nil;
  FAutoKeep:=True;
  FDebugName:=debugName;

  FVertexSize:=_vertexSize;
  FUsage:=_Usage;
  FFVF:=_FVF;
  FPool:=_Pool;

  Count:=_vertexCount; //これでVBufが出来る

  //登録
  ID:=FOwner.RegisterResouce(Self, Cleanup, Recover, Reset, AfterReset, debugName);
end;

destructor TDGVertexBuffer.Destroy;
begin
  if KeepBuf <> Nil then
    FreeMem(KeepBuf);

  TRYDG(FVBuf.Release, 'VertexBufferの解放に失敗しました');

  FOwner.UnregisterResource(ID);
  inherited;
end;

procedure TDGVertexBuffer.GetVertex(idx: UINT; out v);
var
  p:Pointer;
  ofs:UINT;
begin
  if not FLocked then begin
    //未ロックならロックしてから

    if idx >= Count then
      TRYDG(1, 'VertexBufferの範囲外を読み込もうとしました');
    p:=Lock(idx*VertexSize, VertexSize, D3DLOCK_READONLY);
    Move(p^, v, VertexSize);
    Unlock;
  end else begin
    //範囲チェックして読み込み
    if (idx < FLockStart) Or (idx > FLockEnd) then begin
      TRYDG(1, 'VertexBufferのロックされた範囲の外を読もうとしました');
      exit;
    end;

    ofs:=idx * VertexSize;
    p:=PLocked;
    asm
      mov   eax, ofs;
      add   p, eax;
    end;
    Move(p^, v, VertexSize);

  end;

end;

procedure TDGVertexBuffer.SetVertex(idx: UINT; const v);
var
  p:Pointer;
  ofs:UINT;
begin
  //未ロックならロックする
  if not FLocked then begin
    if idx >= Count then
      TRYDG(1, 'VertexBufferの範囲外に書き込もうとしました');
    p:=Lock(idx*VertexSize, VertexSize, 0);
    Move(v, p^, VertexSize);
    Unlock;
  end else begin
    //範囲チェックして書き込み
    if (idx < FLockStart) Or (idx > FLockEnd) then begin
      TRYDG(1, 'VertexBufferのロックされた範囲の外へ書き込もうとしました');
      exit;
    end;

    ofs:=(idx-FLockStart) * VertexSize;
    p:=PLocked;
    asm
      mov   eax, ofs;
      add   p, eax;
    end;
    Move(v, p^, VertexSize);

  end;


end;

function TDGVertexBuffer.Lock(start, count: UINT; Flags: DWord): Pointer;
begin
  TRYDG( FVBuf.Lock(start*VertexSize, count*VertexSize, PByte(PLocked), Flags), 'VertexBufferのロックに失敗しました');

  FLocked:=True;
  FLockStart:=start;
  FLockEnd:=start + count-1;

  result:=PLocked;
end;

procedure TDGVertexBuffer.Unlock;
begin
  TRYDG(FVBuf.Unlock, 'VertexBufferのアンロックに失敗しました');
  FLocked:=False;
end;

procedure TDGVertexBuffer.Cleanup;
begin
  if AutoKeep then
    Keep;

  if FVBuf <> Nil then begin
    TRYDG(FVBuf.Release, 'VertexBufferの解放に失敗しました');
    FVBuf:=Nil;
  end;

end;

//内容の保存
procedure TDGVertexBuffer.Keep;
begin
  //D3DPOOL_DEFAULTだったら、内容は毎フレームフラッシュされても良いことが前提
  //なので、キープしない
  if FPool = D3DPOOL_DEFAULT then
    exit;

  if KeepBuf <> Nil then
    FreeMem(KeepBuf);

  GetMem(KeepBuf, VertexSize*Count);
  Lock(0,0, D3DLOCK_READONLY);
  Move(PLocked^, KeepBuf^, VertexSize*Count);
  Unlock;
end;

procedure TDGVertexBuffer.Recover;
begin
  Count:=FVertexCount;  //プロパティハンドラの呼び出しで、VBuf再生成

  //書き戻し
  //D3DPOOL_DEFAULTだったら、内容は毎フレームフラッシュされても良いことが前提
  //なので、書き戻さない
  if (KeepBuf <> Nil) And (FPool <> D3DPOOL_DEFAULT) then begin
    Lock(0,0, 0);
    Move(KeepBuf^, PLocked^, VertexSize*Count);
    Unlock;
  end;
end;

//デバイスのリセットに備える
procedure TDGVertexBuffer.Reset;
begin
  if FPool = D3DPOOL_DEFAULT then
    Cleanup;
end;

//デバイスがリセットされ終わった
procedure TDGVertexBuffer.AfterReset;
begin
  if FPool = D3DPOOL_DEFAULT then
    Recover;    
end;


procedure TDGVertexBuffer.SetVertexCount(const Value: UINT);
begin
  if FVBuf <> Nil then
    TRYDG(FVBuf.Release, 'VertexBufferの解放に失敗しました');

  if (KeepBuf <> Nil) And (Value <> FVertexCount) then begin
    //Value = FVertexCountの場合は、特にKeepBufを消さない(Recover中のことがある)
    FreeMem(KeepBuf);
    KeepBuf:=Nil;
  end;

  FVertexCount := Value;
  TRYDG( FOwner.D3DDevice.CreateVertexBuffer(VertexSize*Count, Usage, FVF, Pool, FVBuf), 'VertexBufferの生成に失敗しました');
end;


{ TDGIndexBuffer }

constructor TDGIndexBuffer.Create(AOwner: TDGCarad; _indexCount, _Usage:Dword; _Pool: D3DPool; debugName:String = '');
begin
  FOwner:=AOwner;
  FLocked:=False;
  FIBuf:=Nil;
  KeepBuf:=Nil;
  FAutoKeep:=True;
  FDebugName:=debugName;

  FUsage:=_Usage;
  FPool:=_Pool;

  Count:=_indexCount; //これでIBufが出来る

  //登録
  ID:=FOwner.RegisterResouce(Self, Cleanup, Recover, Reset, AfterReset, debugName);
end;

destructor TDGIndexBuffer.Destroy;
begin

  if KeepBuf <> Nil then
    FreeMem(KeepBuf);

  TRYDG(FIBuf.Release, 'IndexBufferの解放に失敗しました');

  FOwner.UnregisterResource(ID);

  inherited;
end;

function TDGIndexBuffer.Lock(start, count: UINT; Flags: DWord): PWord;
begin
  TRYDG( FIBuf.Lock(start*Sizeof(Word), count*Sizeof(Word), PByte(PLocked), Flags), 'IndexBufferのロックに失敗しました');

  FLocked:=True;
  FLockStart:=start;
  FLockEnd:=start + count-1;

  result:=PLocked;
end;

procedure TDGIndexBuffer.Unlock;
begin
  TRYDG(FIBuf.Unlock, 'IndexBufferのアンロックに失敗しました');
  FLocked:=False;
end;

function TDGIndexBuffer.GetIndices(idx: UINT): Word;
var
  p:PWord;
begin
  if not FLocked then begin
    //未ロックならロックしてから

    if idx >= Count then
      TRYDG(1, 'IndexBufferの範囲外を読み込もうとしました');
    Lock(idx*Sizeof(Word), Sizeof(Word), D3DLOCK_READONLY);
    result:=PWord(PLocked)^;
    Unlock;
  end else begin
    //範囲チェックして読み込み
    if (idx < FLockStart) Or (idx > FLockEnd) then begin
      TRYDG(1, 'IndexBufferのロックされた範囲の外を読もうとしました');
      result:=0;
      exit;
    end;

    p:=PLocked;
    Inc(p, idx);
    result:=p^;

  end;
end;


procedure TDGIndexBuffer.SetIndices(idx: UINT; const Value: Word);
var
  p:PWord;
begin
  if not FLocked then begin
    //未ロックならロックしてから

    if idx >= Count then
      TRYDG(1, 'IndexBufferの範囲外へ書き込もうとしました');
    Lock(idx*Sizeof(Word), Sizeof(Word), D3DLOCK_READONLY);
    PWord(PLocked)^:=Value;
    Unlock;
  end else begin
    //範囲チェックして読み込み
    if (idx < FLockStart) Or (idx > FLockEnd) then begin
      TRYDG(1, 'IndexBufferのロックされた範囲の外へ書こうとしました');
      exit;
    end;

    p:=PLocked;
    Inc(p, idx);
    p^:=Value;

  end;
end;

procedure TDGIndexBuffer.Keep;
begin
  //D3DPOOL_DEFAULTだったら、内容は毎フレームフラッシュされても良いことが前提
  //なので、キープしない
  if FPool = D3DPOOL_DEFAULT then
    exit;

  if KeepBuf <> Nil then
    FreeMem(KeepBuf);

  GetMem(KeepBuf, Count*Sizeof(Word));
  Lock(0,0, D3DLOCK_READONLY);
  Move(PLocked^, KeepBuf^, Count*Sizeof(Word));
  Unlock;
end;

procedure TDGIndexBuffer.Cleanup;
begin
  if AutoKeep then
    Keep;

  if FIBuf <> Nil then begin
    TRYDG(FIBuf.Release, 'IndexBufferの解放に失敗しました');
    FIBuf:=Nil;
  end;

end;

procedure TDGIndexBuffer.Recover;
begin
  Count:=FCount;  //プロパティハンドラの呼び出しで、IBuf再生成

  //書き戻し
  //D3DPOOL_DEFAULTだったら、内容は毎フレームフラッシュされても良いことが前提
  //なので、書き戻さない
  if (KeepBuf <> Nil) And (FPool <> D3DPOOL_DEFAULT) then begin
    Lock(0,0, 0);
    Move(KeepBuf^, PLocked^, Count*Sizeof(Word));
    Unlock;
  end;
end;

//デバイスのリセットに備える
procedure TDGIndexBuffer.Reset;
begin
  if FPool = D3DPOOL_DEFAULT then begin
    Cleanup;
  end;
end;

//デバイスがリセットされ終わった
procedure TDGIndexBuffer.AfterReset;
begin
  if FPool = D3DPOOL_DEFAULT then begin
    Recover;
  end;
end;

procedure TDGIndexBuffer.SetCount(const Value: UINT);
begin
  if FIBuf <> Nil then
    TRYDG(FIBuf.Release, 'IndexBufferの解放に失敗しました');

  if (KeepBuf <> Nil) And (Value <> FCount) then begin
    //Value = FIndexCountの場合は、特にKeepBufを消さない(Recover中のことがある)
    FreeMem(KeepBuf);
    KeepBuf:=Nil;
  end;

  FCount := Value;
  TRYDG( FOwner.D3DDevice.CreateIndexBuffer(Count*Sizeof(Word), Usage, D3DFMT_INDEX16, Pool, FIBuf), 'IndexBufferの生成に失敗しました');
end;

end.
