// Ｑｕａｄｒｕｐｌｅ　Ｄ
// encapsulated DDraw & Initialization of D3D
//
// MCMXCVII,MCMXCVIII,MCMXCIX,MM (c) SANDMAN  presents!!
//
//
// for DirectX7
//

unit dddd;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ExtCtrls,
  QDArc,
  DDraw, OLE2, d3d,d3dcaps,d3dtypes,d3drm,d3drmobj,d3drmwin,d3drmdef;//,s_3DNow;



//3DNow!を使用する…でも今のところメリットはほぼ無いよ

//{$DEFINE USE_3DNOW}



//C++Builder3.0, 4.0では、シンボル FOR_CPPBUILDER が定義される
{$IFDEF VER110}
  {$DEFINE FOR_CPPBUILDER}
{$ENDIF}

{$IFDEF VER125}
  {$DEFINE FOR_CPPBUILDER}
{$ENDIF}



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

(****************************************************************************
 *
 * デバッグメッセージ出力用
 *
 ****************************************************************************)
var
  DDDD_HaltOnError:Boolean = True;        {例外が起きたらすぐにHaltする}
  DDDD_DebugMessage:Boolean = True;       {デバッグメッセージをファイルに書き出す}
  DDDD_DetailedLog:Boolean = False;         {ログの出力(AllowDebugMessage:Trueでなければ出力されない)}

(****************************************************************************
 *
 * 互換性をチェックするための定数、変えちゃダメ
 * 今の所未使用だけど
 ****************************************************************************)
const
  DDDD_COMPATIBLEID = 212;


(****************************************************************************
 *
 * ちょっと型宣言
 *
*****************************************************************************)
type
  pTPALETTEENTRY = ^TPALETTEENTRY;

type
  ExDDDD = class(Exception);

type
  //Direct3Dデバイスの種類
  TD3DDeviceType = (dtTnLHAL, dtHAL,dtMMX,dtRGB,dtRamp,dtRef);
  TD3DDeviceTypeSet = Set of TD3DDeviceType;

  TD3DOptions = Set of (DontUseTnLHAL,DontUseHAL,DontUseMMX,DontUseRGBEmulation,MakeZBuffer,MakeStencilBuffer);

  //サーフェス確保時の配置に関する定数
  TDDDDSurfaceMemoryType =(smtDefault, smtCompatible, smtSystemMemory, smtVideoMemory, smtNonLocalVideoMemory);
  TDDDDBackBufferMemoryType = (bmtDefault, bmtCompatible, bmtSystemMemory, bmtVideoMemory);

  //αチャンネルについてのオプション
  TDDDDAlphaFormat = (afNone, afBinary, afLess, afMore);  // なし / 1ビット / 2ビット以上少なめ / なるべく多く


  //色変換用のシフトファクタ
  TDDDDColorShiftInfo = record
    am,ar,al, rm,rr,rl, gm,gr,gl, bm,br,bl :DWord;  //色変換用シフト係数、各色のマスク・右シフト・左シフト係数
  end;

  //デバッグオプション
  TDDDDDebugOption = set of (ddoHaltOnError, ddoDebugMessage, ddoDetailedLog);

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

type
  TDDDD = class;
  TDDDDGenSurface = class;
  TDDDDSurface = class;
  TDDDDCanvas = class;
  TDDDDTexture = class;
  TDDDDSurfaceKeeper = class;
  TDDDDTextureKeeper = class;

//複数のBltを一挙にやるときの情報
TDDDDBltBatch = record
  destR:TRect;
  srcR:TRect;
  srcSurface:TDDDDGenSurface;
end;

PDDDDBltBatch = ^TDDDDBltBatch;

//IDirectDrawSurfaceをカプセル化するクラス
TDDDDGenSurface = class
  protected
    FSurf : IDirectDrawSurface7;
    FWidth,FHeight:Integer;
    //FDepth:Integer;
    FDC : HDC;
    FDesc: DDSURFACEDESC2;
    FOwner: TObject;
    FCk : DWORD;
    FClipRect:TRect;
    FClipping:Boolean;
    FLockedDesc:DDSURFACEDESC2;              //最後にロックされたときのddsd
    FLocked:Boolean;                        //既にロックされているか？

    Shifter:TDDDDColorShiftInfo;

    procedure InitColorConverter(ddpf:DDPIXELFORMAT);
    function getDesc:DDSURFACEDESC2;
    function getIsLost:BOOL;
    procedure setColorKey(ck:DWORD);
    procedure setPixel(x,y:Integer; p:DWORD);
    function  getPixel(x,y:Integer):DWORD;
    procedure LoadFromBMPStream(Source:TStream);            //BMPファイルを入れたストリームから画像の読みこみ
  public
    constructor Create(AOwner:TObject; Surf:IDirectDrawSurface7; x,y:Integer);  //surfには、既に作られたサーフェス
    destructor Destroy; override;

    //色変換
    function  ColorMatch(rgb:TColor):DWORD;           //ddutilから移植、TColorから物理カラーを導出、8ビットでも可
    function  PhysicalToTColor(dw:DWord):TColor;      //物理カラーからTColorに変換
    function  TColorToPhysical(col:TColor):DWord;     //TColorを物理カラーに変換
    function  ARGBToPhysical(a,r,g,b:Byte):DWord;     //ARGB値を物理カラーに変換

    //DC
    function  GetDC:HDC;
    procedure ReleaseDC;

    //システム
    procedure Lock(var ddsd:DDSURFACEDESC2);
    procedure UnLock;
    procedure Restore;

    //ファイル I/O
    procedure LoadBMP(fname:String); virtual;
    procedure LoadFromQDA(FName:String; ID:String); virtual;
    procedure SaveBMP(fname:String);

    //BLT
    function  Blt(SrcSurf:TDDDDGenSurface; const destRect,srcRect:TRect; dwFlags:DWORD; const fx:DDBLTFX):HRESULT;
    function  BltFast(SrcSurf:TDDDDGenSurface; dx,dy:Integer; const srcRect:TRect; dwFlags:DWORD):HRESULT;
    function  Put(const destRect,srcRect:TRect; dwFlags:DWORD; const fx:DDBLTFX):HRESULT;
    function  PutFast(dx,dy:Integer; const srcRect:TRect; dwFlags:DWORD):HRESULT;
    procedure BitBlt(dx,dy,width,height:Integer; hd:HDC; sx,sy:Integer);

    //おまけ？
    function  BltFastAdd(SrcSurf:TDDDDGenSurface; bx,by:Integer; const rect:TRect; dwFlags:DWORD):HRESULT;
    function  PutFastAdd(bx,by:Integer; const rect:TRect; dwFlags:DWORD):HRESULT;
    procedure PutFastAddBatch(count:Integer; batch:PDDDDBltBatch);
    procedure FillRect(r:TRect; col:DWord); //塗りつぶし

    //プロパティ
    property IsLost:BOOL read getIsLost;
    property Width:Integer read FWidth;
    property Height:Integer read FHeight;
    //property Depth:Integer read FDepth;
    property Surface:IDirectDrawSurface7 read FSurf;
    property Desc:DDSURFACEDESC2 read getDesc;
    property Owner:TObject read FOwner;
    property ColorKey:DWORD read FCk write setColorKey;
    property ClipRect:TRect read FClipRect write FClipRect;
    property Clipping:Boolean read FClipping write FClipping;
    property Pixels[x,y:Integer]:DWORD read GetPixel write SetPixel;

  end;


//最後に何からサーフェスの内容を読んだか
TDDDDSourceType = (ddsBMP,ddsQDA);


//TDDDDGenSurfaceにオフスクリーンサーフェスの生成・内容の自動保存/再生を付加
TDDDDSurface = class(TDDDDGenSurface)
  private
    FSourceType:TDDDDSourceType;  //何から画像を読みこんだか
    FBMPName:String;              //最後に読み込んだBMPの名前
    FQDAName:String;
    FQDAID:String;
    procedure CreateSurface(AOwner:TObject; width,height:Integer; colorKey:DWORD; where:TDDDDSurfaceMemoryType);
  public
    //Delphi用コンストラクタ
    {$IFNDEF FOR_CPPBUILDER}
    constructor Create(AOwner:TObject; width,height:Integer; colorKey:DWORD);
    constructor CreateOnSystemMemory(AOwner:TObject; width,height:Integer; colorKey:DWORD);
    constructor CreateOnVideoMemory(AOwner:TObject; width,height:Integer; colorKey:DWORD);
    constructor CreateOnNonLocalVideoMemory(AOwner:TObject; width,height:Integer; colorKey:DWORD);
    {$ELSE}
    //C++Builder用コンストラクタ
    constructor Create(AOwner:TObject; width,height:Integer; colorKey:DWord; where:TDDDDSurfaceMemoryType);
    {$ENDIF}

    destructor Destroy; override;
    procedure LoadBMP(fname:String);  override;
    procedure LoadFromQDA(FName:String; ID:String); override;
  end;

//付けキャンバス
TDDDDCanvas = class(TCanvas)
  private
    FSurf : IDirectDrawSurface7;
    FDC   : HDC;
    FEnabled : Boolean;
  protected
    procedure CreateHandle; override;
  public
    constructor Create(Surf:TDDDDGenSurface);
    destructor Destroy; override;
    property Enabled:boolean read FEnabled;
  end;


//SurfaceKeeper
TDDDDSurfaceKeeper = class
  private
    FOwner:TObject;
    FTarget:TDDDDSurface;     //保存の対象となるサーフェス
    FWidth,FHeight:Integer;   //サーフェスの大きさ
    FDepth:Integer;           //色数
    FID:Integer;              //このサーフェスキーパーのID
  public
    constructor Create(owner:TObject; surf:TDDDDSurface);  //保存
    procedure  Restore;     //OnRestore用の復元
    procedure  Recover;     //OnChangeDisplayMode用の再生成
    procedure  Release;     //解放
    destructor Destroy; override;
end;


//IMテクスチャ
TDDDDTexture = class(TDDDDGenSurface)
  private
    FSourceType:TDDDDSourceType;  //何から画像を読みこんだか
    FBMPName:String;              //最後に読み込んだBMPの名前
    FQDAName:String;
    FQDAID:String;

    FPixelFormatStr:String;         //Recover時に使用、フォーマット指定文字列
    procedure CreateSurface(width,height:Integer; colorKey:DWORD; pixFmt:String); //サーフェスを作る・作り直す
  public
    constructor Create(AOwner:TObject; width,height:Integer; colorKey:DWORD; pixFmt:String);
    destructor Destroy; override;
    procedure LoadBMP(fname:String);  override;
    procedure LoadFromQDA(FName:String; ID:String); override;
end;

{
TDDDDTexture = class
  private
    FDevSurf,FWorkSurf:TDDDDGenSurface;     //デバイスサーフェスと作業サーフェス
    dSurf,wSurf:IDirectDrawSurface7;
    FDDPalette:IDirectDrawPalette;
    FHandle:THandle;
    FOwner:TDDDD;
    FInitialized:Boolean;       //「画像が読み込まれた」フラグ
    FSurfaceCreated:Boolean;  //サーフェスがすでに作られているか？ TextureKeeperによって変更
    FColorKeyPos:TPoint;    //カラーキーを取ってきた位置
    //function   GetHandle:THandle;
    FSourceType:TDDDDSourceType;            //なにから読みこんだ?

    FUseAlpha:Boolean;      //α付きで読みこんだ
    FBMPName:String;        //最後に読みこんだビットマップの名前
    FAlphaName:String;      //最後に読みこんだαチャンネルの名前
    FQDAName:String;        //最後に読みこんだQDAの名前
    FAlphaQDAName:String;   //αチャンネルはどのQDAから取り出した？
    FQDAID:String;          //最後に読みこんだQDAのID
    FAlphaQDAID:String;     //最後に読みこんだαチャンネルのQDAでのID

    //FBinaryAlpha:Boolean;   //α値は2値でも構わない
    FWidth,FHeight:Integer; //幅・高さ
    procedure SetColorKeyPos(pos:TPoint); //カラーキーの由来位置を再設定
    function getIsLost:Boolean;
    procedure LoadFromStreamPlusAlpha(filename:String; pixS,alphaS:TStream; key_x,key_y:Integer);  //ストリームオブジェクトからαチャンネル付きで読みこみ
  public
    FPalette:Array[0..255] of DWORD;  //パレット
    property Handle:THandle read FHandle;
    property WorkSurface:TDDDDGenSurface read FWorkSurf;
    property DevSurface:TDDDDGenSurface read FDevSurf;
    property IsLost:Boolean read getIsLost;
    property Width:Integer read FWidth;
    property Height:Integer read FHeight;
    property ColorKeyPos:TPoint read FColorKeyPos write SetColorKeyPos; //爆裂プログラマン氏に感謝(^^)
    procedure  Restore;
    procedure  ForceRestore;  //WorkSurfの中身をDevSurfに読み直す
    constructor Create(owner:TDDDD);
    destructor  Destroy; override;
    procedure   LoadFromFile(fname:String; key_x,key_y:Integer);
    procedure   LoadFromQDA(QDAName:String; id:String; key_x,key_y:Integer);
    procedure   LoadFromFilePlusAlpha(fileName:String; alphaName:String; key_x,key_y:Integer);  //αチャンネル付き
    procedure   LoadFromQDAPlusAlpha(bmpQDA,alphaQDA, bmpID,alphaID:String; key_x,key_y:Integer);  //αチャンネル付き
  end;
}

//TextureKeeper
TDDDDTextureKeeper = class
  private
    FOwner:TObject;
    FTarget:TDDDDtexture;     //保存の対象となるテクスチャ
    FID:Integer;              //このテクスチャキーパーのID
  public
    constructor Create(owner:TObject; tex:TDDDDTexture);  //保存
    procedure  Restore;   //OnRestore用の復元
    procedure  Recover;   //OnChangeDisplayMode用の再生成
    procedure  Release;   //解放
    destructor Destroy; override;
end;



//DDDDそのもの
TDDDDInitEvent = procedure(Sender:TObject; fNeedChange:Boolean) of object;

TDDDDBorderStyleCanChangeEvent
  = procedure(Sender:TObject; fFull:Boolean; width,height,depth,freq:Integer; DDDriverName:String) of object;



(*
(dmWin640x480x8 ,  dmWin800x600x8,   dmWin1024x768x8,
 dmWin640x480x16,   dmWin800x600x16,  dmWin1024x768x16,
 dmWin640x480x24,   dmWin800x600x24,  dmWin1024x768x24,
 dmFull640x480x8,   dmFull800x600x8,  dmFull1024x768x8,
 dmFull640x480x16,  dmFull800x600x16, dmFull1024x768x16,
 dmFull640x480x24,  dmFull800x600x24, dmFull1024x768x24,
 dmWinVariable
);
*)






TDDDD = class(TComponent)
  private
    //プロパティ用
    FDebugOption:TDDDDDebugOption;

    FInitialScreenWidth:Integer;          //最初の解像度・色数
    FInitialScreenHeight:Integer;
    FInitialBitDepth:Integer;
    FInitializeFullScreen:Boolean;

    FBitDepth:Integer;              //色数
    FFullScreen:Boolean;            //フルスクリーンモードで動いているか?
    FScrWidth,FScrHeight: Integer;  //スクリーンの大きさ
    FFreq:DWord;                    //リフレッシュレート
    FBackColor:DWORD;               //Clear用の色
    FAutoDisplayModeInitialize:Boolean; //解像度の変更を勝手にやって良いか
    FDisableScreenSaver:Boolean;    //スクリーンセーバーの起動を禁止するか
    //FAllowRakugaki:Boolean;         //Windowモードでプライマリ・サーフェスにClipperを付ける？
    FSurfaceLocation:TDDDDSurfaceMemoryType;       //デフォルトではサーフェスをどこに確保する?
    FBackBufferLocationAtWindowed:TDDDDBackBufferMemoryType; //バックバッファをどこに配置する?
    FVsyncAtWindowed:Boolean;     //WindowモードでもFlipの度にVBlank待ちをするか

    //固有イベント
    FOnInit:TDDDDInitEvent;         //DDDD初期化イベント…オーナーのCreate直後
    FOnRestore:TNotifyEvent;        //DDDD復元イベント…オーナーのPaint直後
    FOnCleanUp:TNotifyEvent;        //DDDD廃棄イベント…解像度の変更直前
    FOnChangeDisplayMode:TNotifyEvent;  //DDDD解像度変更イベント…解像度の変更直後

    //FOnBorderStyleCanChange:TDDDDBorderStyleCanChangeEvent; //いまならBorderStyleとかの変更が出来るぜ！イベント
    FOnDestroy:TNotifyEvent;    //DDDD終了イベント

    //オーナーイベントのフック
    FOnEnterMenuLoop:TNotifyEvent;  //オーナーのWM_ENTERMENULOOPのフック
    FOnExitMenuLoop:TNotifyEvent;   //オーナーのWM_EXITMENULOOPのフック
    FOwnerHWnd:THandle;             //オーナーのHWnd
    FOwnerOnPaint:TNotifyEvent;     //オーナーイベントのフック用
    FOwnerOnCreate:TNotifyEvent;    //オーナーイベントのフック用
    FOwnerWndProc:TFarProc;         //オーナーイベントのフック用
    FNewProc:TFarProc;              //オーナーイベントのフック用
    FAtFirst:Boolean;               //初期化前フラグ
    FAtLast:Boolean;                //終了前フラグ
    FAfterInit:Boolean;             //OnInitイベントが既に呼ばれた
    FSuppressRestore:Boolean;       //解像度の変更時のOnRestoreイベントの抑制
    FScreenSaverWasActive:Boolean;  //起動時のスクリーンセーバーの状態

    //DirectDraw関連
    FFrontBuffer,FBackBuffer:TDDDDGenSurface;
    FDDraw:IDirectDraw7;
    FClipper:IDirectDrawClipper;    //ウィンドウ用クリッパー
    FDDDriverList:TStrings;         //DirectDrawドライバのリスト

    //Direct3D関連
    FUse3D:Boolean;       //Direct3DRMを使うか

    //FD3DRM1:IDirect3DRM;  //ここからDirect3D必須オブジェクト
    FD3DRM:IDirect3DRM3;
    FD3DRMDevice:IDirect3DRMDevice3;
    FD3D:IDirect3D7;
    FD3DDevice:IDirect3DDevice7;
    FZBuffer:TDDDDGenSurface;       //Zバッファ兼ステンシルバッファ
    FD3DDeviceType:TD3DDeviceType;  //HAL? MMX? RGB/RAMPエミュ？
    FValidD3DDeviceType:TD3DDeviceTypeSet; //この環境で使用可能なデバイス
    FD3DOptions:TD3DOptions;        //Direct3D使用時のオプション
    FViewPort:IDirect3DRMViewPort2;
    FEye:IDirect3DRMFRAME3;       //選択されているカメラフレーム

    //FD3DDeviceList:TStrings;      //ドライバ名・GUIDの組み
    FCanUseHAL:Boolean;           //Direct3DHALが、現在使っているDirectDrawドライバでサポートされるか？
    FHALEnabled:Boolean;          //Direct3DHALを使っているか？

    //SurfaceKeeper用
    SurfaceKeepList:TList;
    //TextureKeeper用
    TextureKeepList:TList;

    NSurfaceCreated:Integer;  //今まで通算で何枚サーフェスを作った？
    NTextureCreated:Integer;

    procedure WndProc(var Msg: TMessage); //オーナーイベントのフック用
    procedure ReleaseAll; //DirectDraw関連オブジェクトを全解放
    function getBitDepth:Integer;
    function getFreq:Integer;
    procedure DoRestore(Sender:TObject);
    procedure DoInit(Sender:TObject);
    function  GetClipRect:TRect;
    procedure SetClipRect(const r:TRect);
    function  GetClipping:Boolean;
    procedure SetClipping(v:Boolean);
    function  getVBlankStatus:BOOL;
    procedure setDisableScreenSaver(v:Boolean);
    procedure SetAutoDisplaymodeInitialize(fVal:Boolean);
    function  getEye:IDirect3DRMFrame3;
    procedure setEye(v:IDirect3DRMFrame3);

    procedure KeepSurface(Sender:TDDDDSurface);      //サーフェスのコンストラクタで呼び出す
    procedure SurfaceDestroyed(Sender:TDDDDSurface); //サーフェスのデストラクタで呼び出す

    procedure KeepTexture(Sender:TDDDDTexture);      //テクスチャのコンストラクタで呼び出す
    procedure TextureDestroyed(Sender:TDDDDTexture); //テクスチャのデストラクタで呼び出す

    procedure RestoreSurfaces;    //保存されているサーフェス・テクスチャの復元
    procedure CleanUpSurfaces;    //クリーンナップ通知
    procedure RecoverSurfaces;    //保存されているサーフェス・テクスチャの再生成・復元

    procedure SetDisplayMode(fFull:Boolean; width,height,depth,freq:Integer;DDDriverName:String);
    procedure SetDebugOption(const Value: TDDDDDebugOption);
  protected
    procedure Loaded; override;
  public
    Palette:Array[0..255] of TPALETTEENTRY;
    DDPalette:IDirectDrawPalette;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Flip;
    procedure Clear;
    procedure Restore;
    procedure FullScreenMode(width,height,depth,freq:DWord; DDDriverName:String);
    procedure WindowMode(width,height:DWord);
    function EnumDisplayModes(dwFlags:DWORD; const rule:DDSURFACEDESC2; var ddsds:Array of DDSURFACEDESC2):Integer;
    function  isAvailableDisplayMode(x,y,depth,freq:DWord):Boolean;
    //procedure EnumDisplayModes(ddsds:LPDDSURFACEDESC2; nEnum:Integer);
    procedure ReadPalette(fname:String);
    procedure ReadPaletteFromQDA(qdaName:String; bmpID:String);
    procedure UpdatePalette;
    procedure WaitVBlank;
    procedure DispMenu;  //全画面モードで必要な、メニュー描画
    procedure HideMenu;
    procedure Update3D(FrScene:IDirect3DRMFrame3);  //3D画面のアップデート

    function  PhysicalToTColor(dw:DWord):TColor;
    function  TColorToPhysical(col:TColor):DWORD;
    function  ARGBToPhysical(a,r,g,b:BYTE):DWORD;

    property ClipRect:TRect read GetClipRect write SetClipRect;
    property Clipping:Boolean read GetClipping write SetClipping;
    property FrontBuffer:TDDDDGenSurface read FFrontBuffer;
    property BackBuffer:TDDDDGenSurface read FBackBuffer;
    property ScreenWidth:Integer read FScrWidth;
    property ScreenHeight:Integer read FScrHeight;
    property BitDepth:Integer read getBitDepth;
    property VBlankStatus:BOOL read getVBlankStatus;
    property FullScreen:Boolean read FFullscreen;
    property Freq:Integer read getFreq;
    property DDDriverList:TStrings read FDDDriverList;
    property DDraw : IDirectDraw7 read FDDraw;
    property D3DRM:IDirect3DRM3 read FD3DRM;
    property D3DRMDevice:IDirect3DRMDevice3 read FD3DRMDevice;
    property D3D:IDirect3D7 read FD3D;
    property D3DDevice:IDirect3DDevice7 read FD3DDevice;
    property D3DDeviceType:TD3DDeviceType read FD3DDeviceType;
    //property ValidD3DDeviceType:TD3DDeviceTypeSet read FValidD3DDeviceType;
    property Viewport:IDirect3DRMViewport2 read FViewport;
    property Eye:IDirect3DRMFrame3 read getEye write setEye;
    //property D3DDeviceList:TStrings read FD3DDeviceList;
    property ZBuffer:TDDDDGenSurface read FZBuffer;
    property HALEnabled:Boolean read FHALEnabled;
    property Clipper:IDirectDrawClipper read FClipper;
  published

    property DebugOption:TDDDDDebugOption read FDebugOption write SetDebugOption;

    property InitialScreenWidth:Integer read FInitialScreenWidth write FInitialScreenWidth default 640;
    property InitialScreenHeight:Integer read FInitialScreenHeight write FInitialScreenHeight default 480;
    property InitialBitDepth:Integer read FInitialBitDepth write FInitialBitDepth default 0;
    property InitializeFullScreen:Boolean read FInitializeFullScreen write FInitializeFullScreen default false;

    property BackColor:DWORD read FBackColor write FBackColor;
    property AutoDisplayModeInitialize:Boolean read FAutoDisplayModeInitialize write SetAutoDisplayModeInitialize default True;
    property DisableScreenSaver:Boolean read FDisableScreenSaver write setDisableScreenSaver;
    property Use3D:Boolean read FUse3D write FUse3D;
    property D3DOptions:TD3DOptions read FD3DOptions write FD3DOptions;
    property VsyncAtWindowed:Boolean read FVsyncAtWindowed write FVsyncAtWindowed;
    //property AllowRakugaki:Boolean read FAllowRakugaki write FAllowRakugaki;
    property SurfaceLocation:TDDDDSurfaceMemoryType read FSurfaceLocation write FSurfaceLocation default smtDefault;
    property BackBufferLocationAtWindowed:TDDDDBackBufferMemoryType read FBackBufferLocationAtWindowed write FBackBufferLocationAtWindowed default bmtDefault;
    property OnInit:TDDDDInitEvent read FOnInit write FOnInit;
    property OnRestore:TNotifyEvent read FOnRestore write FOnRestore;
    property OnChangeDisplayMode:TNotifyEvent read FOnChangeDisplayMode write FOnChangeDisplayMode;
    property OnCleanUp:TNotifyEvent read FOnCleanUp write FOnCleanUp;
    property OnEnterMenuLoop:TNotifyEvent read FOnEnterMenuLoop write FOnEnterMenuLoop;
    property OnExitMenuLoop:TNotifyEvent read FOnExitMenuLoop write FOnExitMenuLoop;
    property OnDestroy:TNotifyEvent read FOnDestroy write FOnDestroy;

    //property OnBorderStyleCanChange:TDDDDBorderStyleCanChangeEvent read FOnBorderStyleCanChange write FOnBorderStyleCanChange;
  end;




 (****************************************************************************
 *
 * グローバル変数
 *
 ****************************************************************************)

var
  EDDDD : ExDDDD;


 (****************************************************************************
 *
 * ヘルパー関数
 *
 ****************************************************************************)

procedure DDDD_PutDebugMessage(mes:String);   //dddd.debugに一行出力


implementation


//ユニットローカルな型宣言

//論理パレット
type TLogPal = record
  Version:WORD;
  NumberOfEntries:WORD;
  aEntries:Array[0..255] of TPaletteEntry;
end;


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

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


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

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

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

  Inc(debugCount);

  //一行書き込む
  Writeln(F,Format('debug#%.5d ... %s',[debugCount,mes]));

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

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

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




(****************************************************************************
  返り値がDD_OKでないなら、
  デバッグメッセージを出力してHaltする
  (HaltOnError = True時の処理)
 ****************************************************************************)
function TRYDD(err:HRESULT; failMes:String):HRESULT;
begin
  result:=err;

  if err = DD_OK then
    exit;

	{
  case err of
    DDERR_ALREADYINITIALIZED:   PutDebugMessage(failMes+'(DDERR_ALREADYINITIALIZED)');
    DDERR_BLTFASTCANTCLIP:      PutDebugMessage(failMes+'(DDERR_BLTFASTCANTCLIP)');
    DDERR_CANNOTATTACHSURFACE:  PutDebugMessage(failMes+'DDERR_CANNOTATTACHSURFACE');
    DDERR_CANNOTDETACHSURFACE:  PutDebugMessage(failMes+'DDERR_CANNOTDETACHSURFACE');
    DDERR_CANTCREATEDC:         PutDebugMessage(failMes+'DDERR_CANTCREATEDC');
    DDERR_CANTDUPLICATE:        PutDebugMessage(failMes+'DDERR_CANTDUPLICATE');
    DDERR_CANTLOCKSURFACE:      PutDebugMessage(failMes+'DDERR_CANTLOCKSURFACE');
    DDERR_CANTPAGELOCK:         PutDebugMessage(failMes+'DDERR_CANTPAGELOCK');
    DDERR_CANTPAGEUNLOCK:       PutDebugMessage(failMes+'DDERR_CANTPAGEUNLOCK');
    DDERR_CLIPPERISUSINGHWND:   PutDebugMessage(failMes+'DDERR_CLIPPERISUSINGHWND');
    DDERR_COLORKEYNOTSET:       PutDebugMessage(failMes+'DDERR_COLORKEYNOTSET');
    DDERR_CURRENTLYNOTAVAIL:    PutDebugMessage(failMes+'DDERR_CURRENTLYNOTAVAIL');
    DDERR_DCALREADYCREATED:     PutDebugMessage(failMes+'DDERR_DCALREADYCREATED');
    DDERR_DIRECTDRAWALREADYCREATED: PutDebugMessage(failMes+'DDERR_DIRECTDRAWALREADYCREATED');
    DDERR_EXCEPTION:            PutDebugMessage(failMes+'DDERR_EXCEPTION');
    DDERR_EXCLUSIVEMODEALREADYSET: PutDebugMessage(failMes+'DDERR_EXCLUSIVEMODEALREADYSET');
    DDERR_GENERIC:              PutDebugMessage(failMes+'(DDERR_GENERIC)');
    DDERR_HEIGHTALIGN:          PutDebugMessage(failMes+'DDERR_HEIGHTALIGN');
    DDERR_HWNDALREADYSET:       PutDebugMessage(failMes+'DDERR_HWNDALREADYSET');
    DDERR_HWNDSUBCLASSED:       PutDebugMessage(failMes+'DDERR_HWNDSUBCLASSED');
    DDERR_INCOMPATIBLEPRIMARY:	PutDebugMessage(failMes+'(INCOMPATIBLEPRIMARY)');
    DDERR_IMPLICITLYCREATED:    PutDebugMessage(failMes+'DDERR_IMPLICITLYCREATED');
    DDERR_INVALIDCAPS:          PutDebugMessage(failMes+'(DDERR_INVALIDCAPS)');
    DDERR_INVALIDCLIPLIST:      PutDebugMessage(failMes+'DDERR_INVALIDCLIPLIST');
    DDERR_INVALIDDIRECTDRAWGUID: PutDebugMessage(failMes+'DDERR_INVALIDDIRECTDRAWGUID');
    DDERR_INVALIDMODE:          PutDebugMessage(failMes+'DDERR_INVALIDMODE');
    DDERR_INVALIDOBJECT:     	  PutDebugMessage(failMes+'(DDERR_INVALIDOBJECT)');
    DDERR_INVALIDPARAMS:	      PutDebugMessage(failMes+'(DDERR_INVALIDPARAMS)');
    DDERR_INVALIDPIXELFORMAT:	  PutDebugMessage(failMes+'(DDERR_INVALIDPIXELFORMAT)');
    DDERR_INVALIDPOSITION:      PutDebugMessage(failMes+'DDERR_INVALIDPOSITION');
    DDERR_INVALIDRECT:          PutDebugMessage(failMes+'DDERR_INVALIDRECT');
    DDERR_INVALIDSURFACETYPE:   PutDebugMessage(failMes+'DDERR_INVALIDSURFACETYPE');
    DDERR_LOCKEDSURFACES:       PutDebugMessage(failMes+'DDERR_LOCKEDSURFACES');
    DDERR_NO3D:                 PutDebugMessage(failMes+'DDERR_NO3D');
    DDERR_NOALPHAHW:     			  PutDebugMessage(failMes+'(DDERR_NOALPHAHW)');
    DDERR_NOBLTHW:              PutDebugMessage(failMes+'DDERR_NOBLTHW');
    DDERR_NOCOLORCONVHW:        PutDebugMessage(failMes+'DDERR_NOCOLORCONVHW');
    DDERR_NOCLIPLIST:           PutDebugMessage(failMes+'DDERR_NOCLIPLIST');
    DDERR_NOCLIPPERATTACHED:    PutDebugMessage(failMes+'DDERR_NOCLIPPERATTACHED');
    DDERR_NOCOOPERATIVELEVELSET: PutDebugMessage(failMes+'(DDERR_NOCOOPERATIVELEVELSET)');
    DDERR_NOCOLORKEY:           PutDebugMessage(failMes+'DDERR_NOCOLORKEY');
    DDERR_NOCOLORKEYHW:         PutDebugMessage(failMes+'DDERR_NOCOLORKEYHW');
    DDERR_NODC:                 PutDebugMessage(failMes+'DDERR_NODC');
    DDERR_NODIRECTDRAWHW: 		  PutDebugMessage(failMes+'(DDERR_NODIRECTDRAWHW)');
    DDERR_NODIRECTDRAWSUPPORT:  PutDebugMessage(failMes+'DDERR_NODIRECTDRAWSUPPORT');
    DDERR_NODDROPSHW:           PutDebugMessage(failMes+'DDERR_NODDROPSHW');
    DDERR_NOEMULATION:   			  PutDebugMessage(failMes+'(DDERR_NOEMULATION)');
    DDERR_NOEXCLUSIVEMODE:		  PutDebugMessage(failMes+'(DDERR_NOEXCLUSIVEMODE)');
    DDERR_NOFLIPHW:        		  PutDebugMessage(failMes+'(DDERR_NOFLIPHW)');
    DDERR_NOGDI:                PutDebugMessage(failMes+'DDERR_NOGDI');
    DDERR_NOHWND:               PutDebugMessage(failMes+'DDERR_NOHWND');
    DDERR_NOMIPMAPHW:    			  PutDebugMessage(failMes+'(DDERR_NOMIPMAPHW)');
    DDERR_NOMIRRORHW:           PutDebugMessage(failMes+'DDERR_NOMIRRORHW');
    DDERR_NOOVERLAYHW:          PutDebugMessage(failMes+'DDERR_NOOVERLAYHW');
    DDERR_NOPALETTEATTACHED: 	  PutDebugMessage(failMes+'(DDERR_NOPALETTEATTACHED)');
    DDERR_NOPALETTEHW:   			  PutDebugMessage(failMes+'(DDERR_NOPALETTEHW)');
    DDERR_NORASTEROPHW:         PutDebugMessage(failMes+'DDERR_NORASTEROPHW');
    DDERR_NOROTATIONHW:         PutDebugMessage(failMes+'DDERR_NOROTATIONHW');
    DDERR_NOSTRETCHHW:          PutDebugMessage(failMes+'DDERR_NOSTRETCHHW');
    DDERR_NOT4BITCOLOR:         PutDebugMessage(failMes+'DDERR_NOT4BITCOLOR');
    DDERR_NOT4BITCOLORINDEX:    PutDebugMessage(failMes+'DDERR_NOT4BITCOLORINDEX');
    DDERR_NOT8BITCOLOR:  			  PutDebugMessage(failMes+'(DERR_NOT8BITCOLOR)');
    DDERR_NOTAOVERLAYSURFACE:   PutDebugMessage(failMes+'DDERR_NOTAOVERLAYSURFACE');
    DDERR_NOTEXTUREHW:          PutDebugMessage(failMes+'DDERR_NOTEXTUREHW');
    DDERR_NOTFLIPPABLE:         PutDebugMessage(failMes+'DDERR_NOTFLIPPABLE');
    DDERR_NOTFOUND:             PutDebugMessage(failMes+'DDERR_NOTFOUND');
    DDERR_NOTINITIALIZED:       PutDebugMessage(failMes+'DDERR_NOTINITIALIZED');
    DDERR_NOTLOCKED:            PutDebugMessage(failMes+'DDERR_NOTLOCKED');
    DDERR_NOTPAGELOCKED:        PutDebugMessage(failMes+'DDERR_NOTPAGELOCKED');
    DDERR_NOTPALETTIZED:        PutDebugMessage(failMes+'DDERR_NOTPALETTIZED');
    DDERR_NOVSYNCHW:            PutDebugMessage(failMes+'DDERR_NOVSYNCHW');
    DDERR_NOZBUFFERHW:   			  PutDebugMessage(failMes+'(DDERR_NOZBUFFERHW)');
    DDERR_OUTOFCAPS:            PutDebugMessage(failMes+'DDERR_OUTOFCAPS');
    DDERR_OUTOFMEMORY:   			  PutDebugMessage(failMes+'(DDERR_OUTOFMEMORY)');
    DDERR_OUTOFVIDEOMEMORY:		  PutDebugMessage(failMes+'(DDERR_OUTOFVIDEOMEMORY)');
    DDERR_OVERLAYCANTCLIP:      PutDebugMessage(failMes+'DDERR_OVERLAYCANTCLIP');
    DDERR_OVERLAYCOLORKEYONLYONEACTIVE:  PutDebugMessage(failMes+'DDERR_OVERLAYCOLORKEYONLYONEACTIVE');
    DDERR_NOOVERLAYDEST:        PutDebugMessage(failMes+'DDERR_NOOVERLAYDEST');
    DDERR_OVERLAYNOTVISIBLE:    PutDebugMessage(failMes+'DDERR_OVERLAYNOTVISIBLE');
    DDERR_PALETTEBUSY:          PutDebugMessage(failMes+'DDERR_PALETTEBUSY');
    DDERR_PRIMARYSURFACEALREADYEXISTS:	PutDebugMessage(failMes+'(DDERR_PRIMARYSURFACEALREADYEXISTS)');
    DDERR_REGIONTOOSMALL:       PutDebugMessage(failMes+'DDERR_REGIONTOOSMALL');
    DDERR_SURFACEALREADYATTACHED: PutDebugMessage(failMes+'DDERR_SURFACEALREADYATTACHED');
    DDERR_SURFACEALREADYDEPENDENT: PutDebugMessage(failMes+'DDERR_SURFACEALREADYDEPENDENT');
    DDERR_SURFACEBUSY:   			  PutDebugMessage(failMes+'(SURFACEBUSY)');
    DDERR_SURFACEISOBSCURED:    PutDebugMessage(failMes+'DDERR_SURFACEISOBSCURED');
    DDERR_SURFACELOST:   			  PutDebugMessage(failMes+'(SURFACELOST)');
    DDERR_SURFACENOTATTACHED:   PutDebugMessage(failMes+'DDERR_SURFACENOTATTACHED');
    DDERR_TOOBIGHEIGHT:         PutDebugMessage(failMes+'DDERR_TOOBIGHEIGHT');
    DDERR_TOOBIGSIZE:           PutDebugMessage(failMes+'DDERR_TOOBIGSIZE');
    DDERR_TOOBIGWIDTH:          PutDebugMessage(failMes+'DDERR_TOOBIGWIDTH');
    DDERR_UNSUPPORTED:          PutDebugMessage(failMes+'DDERR_UNSUPPORTED');
    DDERR_UNSUPPORTEDFORMAT:    PutDebugMessage(failMes+'DDERR_UNSUPPORTEDFORMAT');
    DDERR_UNSUPPORTEDMASK:      PutDebugMessage(failMes+'DDERR_UNSUPPORTEDMASK');
    DDERR_UNSUPPORTEDMODE:      PutDebugMessage(failMes+'DDERR_UNSUPPORTEDMODE');
    DDERR_VERTICALBLANKINPROGRESS: PutDebugMessage(failMes+'DDERR_VERTICALBLANKINPROGRESS');
    DDERR_WASSTILLDRAWING: 		  PutDebugMessage(failMes+'(WASSTILDRAWING)');
    DDERR_WRONGMODE:            PutDebugMessage(failMes+'DDERR_WRONGMODE');
    DDERR_XALIGN:               PutDebugMessage(failMes+'DDERR_XALIGN');
  else}
		PutDebugMessage(failMes+Format('(Error Code(%x))',[err]));
  //end;

  if DDDD_HaltOnError then
    Halt; //安全のため、Haltしちゃう

end;

(****************************************************************************
  DirectDrawDriverの列挙用コールバック
 ****************************************************************************)
 function EnumDirectDrawDriver(lpGUID: PGUID ; lpDriverDescription: LPSTR ;
      lpDriverName: LPSTR ; lpContext: Pointer ): BOOL ;stdcall;
var
  drvList:TStrings;
  drvSym:String;    //DirectX SDKにならって、ドライバ名を保存しておく
begin
  drvSym:=Format('%s (%s)',[StrPas(lpDriverDescription),StrPas(lpDriverName)]);

  PutTestMessage(Format('Enumerated DDraw Driver ... %s',[drvSym]));

  drvList:=lpContext;
  drvList.Add(drvSym);

	Result:= BOOL(DDENUMRET_OK);
end;


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

(****************************************************************************
  キャンバス
 ****************************************************************************)
constructor TDDDDCanvas.Create(Surf:TDDDDGenSurface);
begin
  inherited Create;
  FSurf:=Surf.Surface;
  FDC:=0;

  //もしも、サーフェスがロストしていたらFEnabledにFalse
  if Surf.IsLost then
    FEnabled:=False
  else
    FEnabled:=True;
end;

destructor TDDDDCanvas.Destroy;
begin
  if FDC<>0 then begin
    Handle:=0;
    FSurf.ReleaseDC(FDC);
    FDC:=0;
  end;
  inherited Destroy;
end;

procedure TDDDDCanvas.CreateHandle;
begin
  if FDC=0 then begin
    FEnabled:=(FSurf.GetDC(FDC) = DD_OK);
    handle:=FDC;
  end;
end;

(****************************************************************************
  IMテクスチャ
 ****************************************************************************)
{
type TDDDDTexture = class
  private
    FDDSurf:TDDDDGenSurface;  //テクスチャ用サーフェス
    FBMPName:String;    //読み込むBMPファイルの名前
  public
    FPalette:Array[0..255] of DWORD;  //パレット
    property DDSurface:TDDDDGenSurface read FDDSurf;
    property Handle:THandle read FHandle;
    constructor Create(fname:String);
    destructor  Destroy;
    procedure   Restore;
  end;
}


//テクスチャ列挙用情報
type TTextureSearchInfo = record
  bestDDPF:DDPIXELFORMAT; //見つかった中で一番良いピクセルフォーマット
  wantBPP:Integer;        //所望するビットデプス(推奨フォーマット列挙用)

  index:Integer;          //第何希望のピクセルフォーマットか(カスタムフォーマット列挙用)
  strs:TStrings;          //使いたいテクスチャフォーマット(カスタムフォーマット列挙用)
end;


//おすすめのテクスチャフォーマット列挙(αなし、バックバッファのBit/Pixelに近い、8ビット以上
function FindDefaultTextureCallBack (lpDDPixFmt: LPDDPIXELFORMAT; lpContext: Pointer): HRESULT; stdcall;
var
  tsi:TTextureSearchInfo;
  ddpf:DDPixelFormat;
begin

  //どんなのが探したいの？
  Move(lpContext^, tsi, Sizeof(TTextureSearchInfo));

  //列挙されたピクセルフォーマットをコピー
  Move(lpDDPixFmt^, ddpf, Sizeof(DDPIXELFORMAT));

  result:=DDENUMRET_OK;


  //バンプとかはいらん
  if (ddpf.dwFlags And (DDPF_LUMINANCE Or DDPF_BUMPLUMINANCE Or DDPF_BUMPDUDV)) <> 0 then
    exit;

  //α情報もいらんですよ
  if (ddpf.dwFlags And (DDPF_ALPHA Or DDPF_ALPHAPIXELS)) <> 0 then
    Exit;

  //8ビット以下ならば、パレット付きじゃないなんて却下
  if (ddpf.dwRGBBitCount<=8) And (not ((ddpf.dwFlags And (DDPF_PALETTEINDEXED8 Or DDPF_PALETTEINDEXED4)<>0))) then
    Exit;

  //16ビット以上なのにRGB形式じゃないなんて却下
  if (ddpf.dwRGBBitCount > 8) And (not ((ddpf.dwFlags And DDPF_RGB)<>0)) then
    Exit;

  //4bit以下は却下
  if (ddpf.dwRGBBitCount < 8) then
    Exit;

  PutTestMessage(Format('列挙されたテクスチャフォーマット...BitCount=%d Mask=(%.8x,%.8x,%.8x,%.8x)',[ddpf.dwRGBBitCount,ddpf.dwRGBAlphaBitMask,ddpf.dwRBitMask,ddpf.dwGBitMask,ddpf.dwBBitMask]));

  //はじめて見つかったフォーマットなら、とりあえず採用
  //そうでない場合は、要求されたBPPに近いものを選択
  if (tsi.bestDDPF.dwRGBBitCount = 0) Or
      ((ddpf.dwRGBBitCount>=tsi.bestDDPF.dwRGBBitCount) And
        (abs(ddpf.dwRGBBitCount - tsi.wantBPP)  <  abs(tsi.bestDDPF.dwRGBBitCount - tsi.wantBPP))) then begin
    tsi.bestDDPF := ddpf;
    Move(tsi, lpContext^, Sizeof(tsi));
    PutTestMessage('このフォーマットは良さそうですね');
  end else begin
    PutTestMessage('このフォーマットは不要ですね');
  end;
end;


//テクスチャフォーマット列挙
function FindTextureCallBack (lpDDPixFmt: LPDDPIXELFORMAT; lpContext: Pointer): HRESULT; stdcall;
var
  i:Integer;
  ddpf:DDPIXELFORMAT;
  tsi:TTextureSearchInfo;


  function isMatch(s:String):Boolean; //sで示されるピクセルフォーマットは、ddpfに合致する？
  var
    ofs,a,r,g,b:Integer;
    rest:String;

    function maskLength(m:DWord):Integer; //マスクビットの1が連続している長さを求める
    var
      i,b:DWord;
    begin
      result:=0;
      b:=1;

      for i:=0 to 31 do begin
        if (m And b) <> 0 then
          result:=result + 1;
        b:=b Shl 1;
      end;

    end;

  begin

    result:=False;

    //PAL8
    if s='PAL8' then begin
      result := (ddpf.dwFlags And DDPF_PALETTEINDEXED8) <> 0;
      exit;
    end;

    //ARGB
    ofs:=Pos('ARGB',s);
    if ofs <> 0 then begin
      rest:=Copy(s,ofs+4,Length(s));

      //ARGBの後は、4文字続かないとダメ
      if Length(rest) <> 4 then
        exit;

      a:=StrToInt(rest[1]);
      r:=StrToInt(rest[2]);
      g:=StrToInt(rest[3]);
      b:=StrToInt(rest[4]);

      result:=
        (maskLength(ddpf.dwRBitMask) = r) And
        (maskLength(ddpf.dwGBitMask) = g) And
        (maskLength(ddpf.dwBBitMask) = b) And
        (maskLength(ddpf.dwRGBAlphaBitMask) = a);
    end;

    //RGB
    ofs:=Pos('RGB',s);
    if ofs <> 0 then begin
      rest:=Copy(s,ofs+3,Length(s));

      //RGBの後は、3文字続かないとダメ
      if Length(rest) <> 3 then
        exit;

      r:=StrToInt(rest[1]);
      g:=StrToInt(rest[2]);
      b:=StrToInt(rest[3]);

      result:=
        (maskLength(ddpf.dwRBitMask) = r) And
        (maskLength(ddpf.dwGBitMask) = g) And
        (maskLength(ddpf.dwBBitMask) = b);
    end;



  end;

begin


  //どんなのが探したいの？
  Move(lpContext^, tsi, Sizeof(TTextureSearchInfo));

  //列挙されたピクセルフォーマットをコピー
  Move(lpDDPixFmt^, ddpf, Sizeof(DDPIXELFORMAT));

  //そもそもバンプとかははじく。
  if (ddpf.dwFlags And (DDPF_LUMINANCE Or DDPF_BUMPLUMINANCE Or DDPF_BUMPDUDV)) <> 0 Then begin
    result:=DDENUMRET_OK;
    exit;
  end;

  //圧縮テクスチャ用フォーマットとかには対応してない
  if (ddpf.dwFlags And DDPF_FOURCC) <> 0 then begin
    result:=DDENUMRET_OK;
    exit;
  end;

  PutTestMessage(Format('列挙されたテクスチャフォーマット...BitCount=%d Mask=(%.8x,%.8x,%.8x,%.8x)',[ddpf.dwRGBBitCount,ddpf.dwRGBAlphaBitMask,ddpf.dwRBitMask,ddpf.dwGBitMask,ddpf.dwBBitMask]));


  For i:=0 to tsi.strs.Count-1 do begin

    if isMatch(tsi.strs[i]) then begin
      if (i < tsi.index) Or (tsi.index = -1) then begin
        tsi.index:=i;
        tsi.bestDDPF:=ddpf;
        PutTestMessage('第' + IntToStr(i+1) + '希望 : ' + tsi.strs[i] + ' に合致');
        Move(tsi, lpContext^, Sizeof(tsi));
      end;
    end;
  end;


  if tsi.index = 0 then
    result:=DDENUMRET_CANCEL  //第一希望のが見つかった
  else
    result:=DDENUMRET_OK;     //もっとくれ

end;


//テクスチャのヨリシロとするサーフェスを作る
procedure TDDDDTexture.CreateSurface(width, height: Integer;
  colorKey: DWORD; pixFmt: String);
var
  ddck:DDCOLORKEY;
  tsi:TTextureSearchInfo;

  //セミコロンで区切られた 文字列の要素数を勘定し、分解後の文字列をtsi.strsに加える
  function GetNElem(s:String):Integer;
  var
    buf:String;
    i:Integer;
  begin
    result:=0;

    for i:=1 to Length(s) do begin

      if s[i] = ';' then begin
        if trim(buf) <> '' then begin
          result:=result + 1;
          tsi.strs.Add(trim(buf));
        end;
        buf:='';
      end else
        buf:=buf + s[i];

    end;

    if trim(buf) <> '' then begin
      result:=result + 1;
      tsi.strs.Add(trim(buf));
    end;

  end;

  function abs(x:Integer):Integer;
  begin
    if x < 0 then
      result:= -x
    else
      result:= x;
  end;

begin

  //DDSURFACEDESC2の作成
  ZeroMemory(@FDesc,Sizeof(FDesc));
  with FDesc do begin
    dwSize:=Sizeof(FDesc);

	  dwWidth := width;
	  dwHeight := height;
  	dwFlags := DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT Or DDSD_TEXTURESTAGE Or DDSD_PIXELFORMAT;

    if TDDDD(FOwner).HALEnabled then
      ddsCaps.dwCaps := DDSCAPS_TEXTURE Or DDSCAPS_VIDEOMEMORY
    else
      ddsCaps.dwCaps := DDSCAPS_TEXTURE Or DDSCAPS_SYSTEMMEMORY;
  end;


  if pixFmt <> '' then begin
    //指定があるなら、ピクセルフォーマットの列挙
    PutTestMessage('指定のテクスチャフォーマットを探索します…');

    //下準備
    tsi.strs:=TStringList.Create;
    getNElem(pixFmt);

    tsi.index:=-1;

    //列挙せい
    TDDDD(FOwner).D3DDevice.EnumTextureFormats(Pointer(@FindTextureCallBack),@tsi);

    //最後まで見つからなかったなら、デフォルトでGO!
    if tsi.index = -1 then begin
    	//FDesc.dwFlags := DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT Or DDSD_TEXTURESTAGE;
      PutTestMessage('希望のテクスチャフォーマットが見つかりませんでした。Quadruple D 推奨のフォーマットを列挙します');

      TDDDD(FOwner).D3DDevice.EnumTextureFormats(Pointer(@FindDefaultTextureCallBack),@tsi);
    end;

    tsi.strs.Free;
  end else begin
    PutTestMessage('Quadruple D 推奨のテクスチャフォーマットを探索します…');

    //指定が無いから、推奨フォーマットの列挙
    tsi.wantBPP:=TDDDD(FOwner).BitDepth;
    ZeroMemory(@tsi.bestDDPF, Sizeof(tsi.bestDDPF));
    tsi.bestDDPF.dwSize:=Sizeof(tsi.bestDDPF);

    TDDDD(FOwner).D3DDevice.EnumTextureFormats(Pointer(@FindDefaultTextureCallBack),@tsi);
  end;

  FDesc.ddpfPixelFormat:=tsi.bestDDPF;




  if FDesc.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY <> 0 then
    if FDesc.ddsCaps.dwCaps And DDSCAPS_NONLOCALVIDMEM <> 0 then
      PutTestMessage('テクスチャをノンローカルビデオメモリに配置します')
    else
      PutTestMessage('テクスチャをビデオメモリに配置します')
  else if FDesc.ddsCaps.dwCaps And DDSCAPS_SYSTEMMEMORY  <> 0 then
    PutTestMessage('テクスチャをシステムメモリに配置します')
  else
    PutTestMessage('テクスチャをドライバのデフォルトの位置(おそらくビデオメモリ)に配置します');


  //実際にSurfaceを作る
  TRYDD( TDDDD(FOwner).DDraw.CreateSurface(@FDesc, FSurf, Nil), 'テクスチャ用サーフェスを作れませんでした');


	//カラーキーの設定
	ddck.dwColorSpaceLowValue := colorKey;
	ddck.dwColorSpaceHighValue := colorKey;
	FSurf.SetColorKey(DDCKEY_SRCBLT, @ddck);

  //FDescの更新
  GetDesc;

  //メンバの設定
  FWidth:=width;
  FHeight:=height;
  FCk:=colorKey;
  FClipping:=False;
  ClipRect:=Rect(0,0,FWidth,FHeight);

  //色変換ルーチンの初期化
  InitColorConverter(FDesc.ddpfPixelFormat);

end;



constructor TDDDDtexture.Create(AOwner:TObject; width,height:Integer; colorKey:DWORD; pixFmt:String);
begin
  FOwner:=AOwner;
  FPixelFormatStr:=pixFmt;

  CreateSurface(width, height, colorkey, pixFmt);
  TDDDD(FOwner).KeepTexture(Self);  //自分が作られたことを、DDDDに知らせる
end;


destructor TDDDDtexture.Destroy;
begin
  Clipping:=False;

  if FSurf <> Nil then begin
    TRYDD(FSurf.Release,'テクスチャの解放に失敗しました');
  end;

  TDDDD(FOwner).TextureDestroyed(Self); //自分が破棄されたことを、DDDDに知らせる

  inherited Destroy;
end;

procedure  TDDDDtexture.LoadBMP(fname:String);
begin
  PutTestMessage(fname + ' をテクスチャに読み込みます');
  FBMPname:=fname;
  FSourceType:=ddsBMP;

  inherited;
end;

procedure  TDDDDtexture.LoadFromQDA(FName:String; ID:String);
begin
  PutTestMessage('アーカイブ '+fname+' から、テクスチャに '+ ID +' を読み込みます');

  FQDAName:=FName;
  FQDAID:=ID;
  FSourceType:=ddsQDA;

  inherited;
end;



{
type BITMAP = record
  bmType:Integer;
  bmWidth:Integer;
  bmHeight:Integer;
  bmWidthBytes:Integer;
  bmPlanes:Word;
  bmBitsPixel:Word;
  bmBits:Pointer;
end;

//コンストラクタ
constructor TDDDDTexture.Create(owner:TDDDD);
begin
  inherited Create;
  FOwner:=owner;

  FInitialized:=False;
  FSurfaceCreated:=False;
  FWidth:=0;
  FHeight:=0;
  FBMPname:='';

  FOwner.KeepTexture(Self);
end;


//ビットマップ読み込み手続き
procedure TDDDDTexture.LoadFromFile(fname:String; key_x,key_y:Integer);
var
  ftd:FindTextureData;
  //bbDesc:DDSURFACEDESC2; //バックバッファのDesc
  ddsd:DDSURFACEDESC2;
  adw:Array[0..255] of DWORD; //パレットエントリ
  colors,i:Integer;
  WorkDC:HDC;  //作業サーフェスのDC
  Texture:IDirect3DTexture2;

  hBmp:HBitmap;
  bmp:BITMAP;
  bmpDC:HDC;

  ddck:DDCOLORKEY;  //カラーキー
  ck:DWORD;         //カラーキー指定用

  mask:DWord;       //未使用ビットマスキング用
  x,y:Integer;
begin

  //もし、すでにロードされていたら、その内容は解放
  if FInitialized then begin
    FWorkSurf.Free;
    FDevSurf.Free;
    if FSurfaceCreated then begin
      dSurf.Release;
      wSurf.Release;
    end;
  end;


  //BMPのリソースかファイルからメモリへの読み込み
  hBmp:=LoadImage(GetModuleHandle(Nil),PChar(fname),IMAGE_BITMAP,0,0,LR_CREATEDIBSECTION);
  if hBmp=0 then
    hBmp:=LoadImage(0,PChar(fname),IMAGE_BITMAP,0,0,LR_LOADFROMFILE Or LR_CREATEDIBSECTION);

  if hBmp=0 then begin
    PutDebugMessage(fname + 'がビットマップファイルとして開けません');
    if DDDD_HaltOnError then
      Halt;
  end;

  GetObject(hBmp,sizeof(bmp),@bmp); //ビットマップの情報を取得

  //テクスチャフォーマットの選択
  ZeroMemory(@ftd,sizeof(ftd));
  ftd.bpp:=bmp.bmBitsPixel;

  FOwner.FD3DDevice.EnumTextureFormats(Pointer(@FindTextureCallBack), @ftd);  //列挙

  PutTestMessage(Format('テクスチャフォーマットが決定されました...BitCount=%d Mask=(%.8x,%.8x,%.8x,%.8x)',[ftd.ddpf.dwRGBBitCount,ftd.ddpf.dwRGBAlphaBitMask,ftd.ddpf.dwRBitMask,ftd.ddpf.dwGBitMask,ftd.ddpf.dwBBitMask]));

  //デバイス用サーフェスの作成…バックバッファと同じ場所に置く
  ZeroMemory(@ddsd,sizeof(ddsd));
  ddsd.dwSize:=sizeof(ddsd);
  ddsd.dwFlags:=DDSD_CAPS Or DDSD_PIXELFORMAT Or DDSD_WIDTH Or DDSD_HEIGHT;
  ddsd.dwWidth:=bmp.bmWidth;
  ddsd.dwHeight:=bmp.bmHeight;

  ddsd.ddpfPixelFormat:=ftd.ddpf;
  //bbDesc:=FOwner.BackBuffer.Desc;

  //if (bbDesc.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY)<>0 then
  if FOwner.FD3DDeviceType = dtHAL then begin
    PutTestMessage('ビデオメモリに配置します');
    ddsd.ddsCaps.dwCaps:=DDSCAPS_VIDEOMEMORY Or DDSCAPS_TEXTURE Or DDSCAPS_ALLOCONLOAD
  end else begin
    PutTestMessage('システムメモリに配置します');
    ddsd.ddsCaps.dwCaps:=DDSCAPS_SYSTEMMEMORY Or DDSCAPS_TEXTURE;
  end;
  TRYDD(FOwner.DDraw.CreateSurface(@ddsd,dSurf,Nil),'テクスチャ用デバイスサーフェスの作成に失敗しました');

  //作業用サーフェスの作成
  //if (bbDesc.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY)<>0 then begin
  if FOwner.FD3DDeviceType = dtHAL then begin
    ddsd.ddsCaps.dwCaps := DDSCAPS_SYSTEMMEMORY Or DDSCAPS_TEXTURE;
    TRYDD(FOwner.DDraw.CreateSurface(@ddsd, wSurf, Nil),'テクスチャ用作業サーフェスの作成に失敗しました');
  end else begin
    wSurf:=dSurf;  //システムメモリにデバイスサーフェスがあるなら、そのまま使える
    dSurf.AddRef;
  end;


  //必要ならパレットを作成
  if ddsd.ddpfPixelFormat.dwRGBBitCount <= 8 then begin
    bmpDC:=CreateCompatibleDC(0);
    SelectObject(bmpDC,hBmp);
    colors:=GetDIBColorTable(bmpDC,0,256,adw); //パレットエントリをゲット
    DeleteDC(bmpDC);
    if (colors<>0) then begin //パレットをRGB形式へ変換
      for i:=0 to colors-1 do
        adw[i] := RGB(GetBValue(adw[i]),GetGValue(adw[i]),GetRValue(adw[i]));
    end;
    TRYDD(FOwner.DDraw.CreatePalette(DDPCAPS_8BIT,Pointer(@adw),FDDPalette,Nil),'テクスチャ用パレットの作成に失敗しました');
    wSurf.SetPalette(FDDPalette);
    dSurf.SetPalette(FDDPalette);
  end;

  //ビットマップを作業用サーフェスへコピー
  TRYDD(wSurf.GetDC(workDC),'テクスチャ用作業サーフェスのデバイスコンテキスト取得に失敗しました');
  bmpDC:=CreateCompatibleDC(0);
  SelectObject(bmpDC,hBmp);
  BitBlt(workDC,0,0,bmp.bmWidth,bmp.bmHeight,bmpDC,0,0,SRCCOPY);
  DeleteDC(bmpDC);
  wSurf.ReleaseDC(workDC);

  //TDDDDGenSurfaceにしておく
  FWorkSurf:=TDDDDGenSurface.Create(FOwner,wSurf,bmp.bmWidth,bmp.bmHeight);
  FDevSurf:=TDDDDGenSurface.Create(FOwner,dSurf,bmp.bmWidth,bmp.bmHeight);


  //パレット付きじゃないなら、作業用サーフェスの「未使用ビット」に0を代入する
  if ddsd.ddpfPixelFormat.dwRGBBitCount > 8 then begin
    //マスク作成
    with ddsd.ddpfPixelFormat do
      mask:=dwRBitMask Or dwGBitMask Or dwBBitMask;

    //ロック
    FWorkSurf.Lock(ddsd);

    //どんどんAndしちゃうよ
    For y:=0 to ddsd.dwHeight-1 do begin
      For x:=0 to ddsd.dwWidth-1 do begin
        FWorkSurf.Pixels[x,y]:=FWorkSurf.Pixels[x,y] And mask;
      end;
    end;

    //アンロック
    FWorkSurf.UnLock;

  end;

  //必要ならカラーキーを設定
  if (key_x>=0) And (key_y>=0) then begin
    ck:=FWorkSurf.Pixels[key_x,key_y];
  	ddck.dwColorSpaceLowValue := ck;
    ddck.dwColorSpaceHighValue := ck;
   	dSurf.SetColorKey(DDCKEY_SRCBLT, @ddck);
  end;

  //作業サーフェスからデバイスサーフェスへ転送
  Restore;

  //テクスチャハンドルの取得
  dSurf.QueryInterFace(IID_IDirect3DTexture2, Texture);
  //TRYDD(Texture.GetHandle(FOwner.D3DDevice,FHandle),'テクスチャのハンドルが得られませんでした');
  Texture.Release;

  //これでラストォ！！
  DeleteObject(hBmp);
  FInitialized:=True;
  FSurfaceCreated:=True;


  //復元用情報の格納
  FWidth:=bmp.bmWidth;
  FHeight:=bmp.bmHeight;

  FColorKeyPos.x:=key_x;
  FColorKeyPos.y:=key_y;

  FUseAlpha:=False;
  FSourceType:=ddsBMP;
  FBMPName:=fname;
end;

//QDAからテクスチャを読み込む
procedure   TDDDDTexture.LoadFromQDA(QDAName:String; id:String; key_x,key_y:Integer);
var
  TempPath:Array[0..MAX_PATH] of Char;
  TempName:Array[0..MAX_PATH] of Char;
  ms:TMemoryStream; //解凍結果を入れたストリーム
  fs:TFileStream;
begin
  try
    ms:=ExtractFromQDAFile(QDAName,id);
  except
    PutDebugMessage(Format('アーカイブファイル %s からの %s のオープンに失敗しました',[QDAName,id]));
    exit;
  end;

  //テンポラリファイルの作成
  try
    GetTempPath(MAX_PATH,PChar(@TempPath));
    GetTempFileName(PChar(@TempPath),PChar('tmp'),0,PChar(@TempName));

    fs:=TFileStream.Create(StrPas(TempName), fmCreate);
    fs.Write(ms.Memory^,ms.Size);
    fs.Free;
  except
    PutDebugMessage(Format('テクスチャデータの展開に失敗しました',[QDAName,id]));
    exit;
  end;

  ms.Free;
  //テンポラリから読みこむ
  LoadFromFile(StrPas(TempName),key_x,key_y);

  //テンポラリの削除
  DeleteFile(StrPas(TempName));


  //復元用の情報を書きなおす
  FUseAlpha:=False;
  FSourceType:=ddsQDA;
  FQDAName:=QDAName;
  FQDAID:=id;
end;




//テクスチャフォーマット列挙(αビット付き版)
function FindAlphaTextureCallBack( const lpDdsd: DDSURFACEDESC2 ; lpUserArg: Pointer ): HRESULT ; stdcall ;
var
  ftd:^FindTextureData;
  ddpf:DDPixelFormat;

  function AlphaDepth(mask:DWord):DWord;
  begin
    result:=0;
    while (mask And 1) = 0 do begin
      mask := mask Shr 1;
    end;
    while (mask And 1) = 1 do begin
      mask := mask Shr 1;
      Inc(result);
    end;
  end;

begin
  ftd:=lpUserArg;
  ddpf:=lpDDsd.ddpfPixelformat;

  result:=DDENUMRET_OK;


  //α無し、α専用は却下
  if (ddpf.dwFlags And (not DDPF_ALPHA) And DDPF_ALPHAPIXELS) = 0 then
    Exit;

  //16bpp以下だったりARGBじゃ無い奴は却下
  if (ddpf.dwRGBBitCount<16) Or (not ((ddpf.dwFlags And DDPF_RGB)<>0)) then
    Exit;


  PutTestMessage(Format('列挙されたテクスチャフォーマット...BitCount=%d Mask=(%.8x,%.8x,%.8x,%.8x)',[ddpf.dwRGBBitCount,ddpf.dwRGBAlphaBitMask,ddpf.dwRBitMask,ddpf.dwGBitMask,ddpf.dwBBitMask]));



  //はじめて見つかったフォーマットなら、とりあえず採用
  if (ftd^.ddpf.dwRGBBitCount = 0) then begin
    ftd^.ddpf := ddpf;
    exit;
  end;

  //要求されたbppに最も近いものを選ぶ
  if abs(ftd^.bpp - ddpf.dwRGBBitCount) < abs(ftd^.bpp - ftd^.ddpf.dwRGBBitCount) then begin
    ftd^.ddpf := ddpf;
    exit;
  end;

  //今まで見つかった中では最も要求されたbppに近いフォーマットならば、αビットが多いほうが良い
  if abs(ftd^.bpp - ddpf.dwRGBBitCount) = abs(ftd^.bpp - ftd^.ddpf.dwRGBBitCount) then
    if AlphaDepth(ftd^.ddpf.dwRGBAlphaBitMask) < AlphaDepth(ddpf.dwRGBAlphaBitMask) then
      ftd^.ddpf := ddpf;

end;


//ストリームオブジェクトからαチャンネル付きで読みこみ…LoadFromFileから呼ばれる
procedure TDDDDTexture.LoadFromStreamPlusAlpha(filename:String; pixS,alphaS:TStream; key_x,key_y:Integer);
var
  x,y:Integer;
  a,r,g,b:Byte;                       //αマップ・ピクセルマップから取り出された値
  pixBI,alphaBI:TBitmapInfoHeader;    //各ビットマップの情報
  bfh:TBitmapFileHeader;

  ftd:FindTextureData;                //テクスチャフォーマット探索用コールバック
  ddsd:DDSURFACEDESC2;                 //サーフェス情報
  Texture:IDirect3DTexture2;          //テクスチャオブジェクト
  ck:DWord;                           //カラーキー指定用
  ddck:DDCOLORKEY;                    //同上

  Lr,Lg,Lb,La, Rr,Rg,Rb,Ra:Integer;   //各色に対するシフト係数

  //マスクからシフト係数を算出
  procedure CalcShiftFactor(mask:DWord; var l:Integer; var r:Integer);
  begin
    l:=0;
    while (mask And 1) = 0 do begin
      Inc(l);
      mask := mask Shr 1;
    end;
    r:=0;
    while (mask And 1) = 1 do begin
      Inc(r);
      mask:=mask Shr 1;
    end;
    r:=8-r;
  end;

  //サーフェスに合うように輝度の変換
  function ConvARGB(a,r,g,b:DWord):DWORD;
  begin
    result:= (a Shr Ra Shl La) Or
              (r Shr Rr Shl Lr) Or
              (g Shr Rg Shl Lg) Or
              (b Shr Rb Shl Lb);
  end;
begin

  //ヘッダを検閲
  pixS.Read(bfh,Sizeof(TBitmapFileHeader));
  pixS.Read(pixBI,Sizeof(TBitmapInfoHeader));
  if pixBI.biBitCount <> 24 then begin
    pixS.Free;
    TRYDD(1,'ピクセルマップは、24ビットのビットマップで頼みます');
    exit;
  end;
  pixS.Seek(bfh.bfOffBits,soFromBeginning);

  alphaS.Read(bfh,Sizeof(TBitmapFileHeader));
  alphaS.Read(alphaBI,Sizeof(TBitmapInfoHeader));
  if alphaBI.biBitCount <> 8 then begin
    alphaS.Free;
    TRYDD(1,'αチャンネルは、8ビットのビットマップで頼みます');
    exit;
  end;
  alphaS.Seek(bfh.bfOffBits,soFromBeginning);

  if (pixBI.biWidth <> alphaBI.biWidth) Or (pixBI.biHeight <> alphaBI.biHeight) then begin
    pixS.Free;
    alphaS.Free;
    TRYDD(1,'αチャンネルと、ピクセルマップのサイズが違います');
    exit;
  end;



  (*  よ〜し、それじゃ始めるとすっか *)


  //もし、すでにロードされていたら、その内容は解放
  if FInitialized then begin
    FWorkSurf.Free;
    FDevSurf.Free;
    if FSurfaceCreated then begin
      dSurf.Release;
      wSurf.Release;
    end;
  end;

  //テクスチャフォーマットの選択
  ZeroMemory(@ftd,sizeof(ftd));
  ftd.bpp:=FOwner.BitDepth;
  FOwner.FD3DDevice.EnumTextureFormats(Pointer(@FindAlphaTextureCallBack), @ftd);  //列挙

  PutTestMessage(Format('テクスチャフォーマットを決定しました...BitCount=%d Mask=(%.8x,%.8x,%.8x,%.8x)',[ftd.ddpf.dwRGBBitCount,ftd.ddpf.dwRGBAlphaBitMask,ftd.ddpf.dwRBitMask,ftd.ddpf.dwGBitMask,ftd.ddpf.dwBBitMask]));

  //もしも、αサポートなテクスチャフォーマットが見つからなかったなら、α無しでロード
  if ftd.ddpf.dwRGBBitCount = 0 then begin
    pixS.Free;
    alphaS.Free;
    PutTestMessage('αをサポートしたテクスチャフォーマットが見つからないので、α無しで読みこみます');
    LoadFromFile(fileName,key_x,key_y);
    Exit;
  end;



  //デバイス用サーフェスの作成…バックバッファと同じ場所に置く
  ZeroMemory(@ddsd,sizeof(ddsd));
  ddsd.dwSize:=sizeof(ddsd);
  ddsd.dwFlags:=DDSD_CAPS Or DDSD_PIXELFORMAT Or DDSD_WIDTH Or DDSD_HEIGHT;
  ddsd.dwWidth:=pixBI.biWidth;
  ddsd.dwHeight:=pixBI.biHeight;

  ddsd.ddpfPixelFormat:=ftd.ddpf;
  //bbDesc:=FOwner.BackBuffer.Desc;

  //if (bbDesc.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY)<>0 then
  if FOwner.FD3DDeviceType = dtHAL then begin
    PutTestMessage('ビデオメモリに配置します');
    ddsd.ddsCaps.dwCaps:=DDSCAPS_VIDEOMEMORY Or DDSCAPS_TEXTURE Or DDSCAPS_ALLOCONLOAD
  end else begin
    PutTestMessage('ビデオメモリに配置します');
    ddsd.ddsCaps.dwCaps:=DDSCAPS_SYSTEMMEMORY Or DDSCAPS_TEXTURE;
  end;

  TRYDD(FOwner.DDraw.CreateSurface(@ddsd,dSurf,Nil),'テクスチャ用デバイスサーフェスの作成に失敗しました');

  //作業用サーフェスの作成
  //if (bbDesc.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY)<>0 then begin
  if FOwner.FD3DDeviceType = dtHAL then begin
    ddsd.ddsCaps.dwCaps := DDSCAPS_SYSTEMMEMORY Or DDSCAPS_TEXTURE;
    TRYDD(FOwner.DDraw.CreateSurface(@ddsd, wSurf, Nil),'テクスチャ用作業サーフェスの作成に失敗しました');
  end else begin
    wSurf:=dSurf;  //システムメモリにデバイスサーフェスがあるなら、そのまま使える
    dSurf.AddRef;
  end;


  (* pixSとalphaSの中身をガリガリ転送しちゃいます *)

  //色変換用変数の算出
  CalcShiftFactor(ftd.ddpf.dwRGBAlphaBitMask, La,Ra);
  CalcShiftFactor(ftd.ddpf.dwRBitMask, Lr,Rr);
  CalcShiftFactor(ftd.ddpf.dwGBitMask, Lg,Rg);
  CalcShiftFactor(ftd.ddpf.dwBBitMask, Lb,Rb);

  //TDDDDSurfaceオブジェクトにして、扱いやすくしましょ
  FWorkSurf:=TDDDDGenSurface.Create(FOwner,wSurf,pixBI.biWidth,pixBI.biHeight);
  FDevSurf:=TDDDDGenSurface.Create(FOwner,dSurf,pixBI.biWidth,pixBI.biHeight);

  //ロック
  FWorkSurf.Lock(ddsd);

  //変換しまくれ
  For y:=0 to pixBI.biHeight-1 do begin
    For x:=0 to pixBI.biWidth-1 do begin
      pixS.Read(b,Sizeof(Byte));
      pixS.Read(g,Sizeof(Byte));
      pixS.Read(r,Sizeof(Byte));
      alphaS.Read(a,Sizeof(Byte));
      FWorkSurf.Pixels[x,(pixBI.biHeight-y-1)]:=ConvARGB(a, r,g,b);
    end;
  end;

  //アンロック
  FWorkSurf.UnLock;


  (* 必要ならカラーキーを設定 *)
  if (key_x>=0) And (key_y>=0) then begin
    ck:=FWorkSurf.Pixels[key_x,key_y];
  	ddck.dwColorSpaceLowValue := ck;
    ddck.dwColorSpaceHighValue := ck;
   	dSurf.SetColorKey(DDCKEY_SRCBLT, @ddck);
  end;


  (* 仕事納め *)

  //DevSurfにロードしましょ
  Restore;
  ForceRestore;

  //テクスチャハンドルの取得
  dSurf.QueryInterFace(IID_IDirect3DTexture2, Texture);

  //TRYDD(Texture.GetHandle(FOwner.D3DDevice,FHandle),'テクスチャのハンドルが得られませんでした');
  Texture.Release;

  //これでラストォ！！
  FInitialized:=True;
  FSurfaceCreated:=True;

  //復元用情報の格納
  FWidth:=pixBI.biWidth;
  FHeight:=pixBI.biHeight;

  FColorKeyPos.x:=key_x;
  FColorKeyPos.y:=key_y;
end;


//ビットマップ読み込み手続き、αチャネル付き
procedure TDDDDTexture.LoadFromFilePlusAlpha(fileName:String; alphaName:String; key_x,key_y:Integer);
var
  pixS:TMemoryStream;                 //ピクセルマップ格納用(24bpp限定)
  alphaS:TMemoryStream;               //αチャンネル格納用(8bpp限定)
begin

  (* まずはBMPファイルを読みこむ *)

  pixS:=TMemoryStream.Create;
  alphaS:=TMemoryStream.Create;

  //ピクセルマップの読みこみ
  try
    pixS.LoadFromFile(fileName);
  except
    TRYDD(1,fileName + 'が、開けません');
    exit;
  end;

  //αチャンネルの読みこみ
  try
    alphaS.LoadFromFile(alphaName);
  except
    TRYDD(1,alphaName + 'が、開けません');
    exit;
  end;

  LoadFromStreamPlusAlpha(fileName, pixS,alphaS,key_x,key_y);


  //メモリストリームの解放
  pixS.Free;
  alphaS.Free;

  //復元用情報の格納
  FUseAlpha:=True;
  FSourceType:=ddsBMP;
  FBMPName:=fileName;
  FAlphaName:=alphaName;
end;


//αチャンネル付き
procedure   TDDDDTexture.LoadFromQDAPlusAlpha(bmpQDA,alphaQDA, bmpID,alphaID:String; key_x,key_y:Integer);
var
  pixS:TMemoryStream;                 //ピクセルマップ格納用(24bpp限定)
  alphaS:TMemoryStream;               //αチャンネル格納用(8bpp限定)
  fs:TFileStream;
  TempPath,TempName:Array[0..MAX_PATH] of Char;
begin

  //QDAファイルから解凍
  try
    pixS:=ExtractFromQDAFile(bmpQDA,bmpID);
  except
    TRYDD(1, Format('%sからの%sの展開に失敗しました',[bmpQDA,bmpID]));
    exit;
  end;

  try
    alphaS:=ExtractFromQDAFile(alphaQDA,alphaID);
  except
    TRYDD(1, Format('%sからの%sの展開に失敗しました',[alphaQDA,alphaID]));
    exit;
  end;

  //αチャンネルが使えない場合のために、ピクセル部分だけテンポラリファイルの作成
  try
    GetTempPath(MAX_PATH,PChar(@TempPath));
    GetTempFileName(PChar(@TempPath),PChar('tmp'),0,PChar(@TempName));

    fs:=TFileStream.Create(StrPas(TempName), fmCreate);
    fs.Write(pixS.Memory^,pixS.Size);
    fs.Free;
  except
    PutDebugMessage('テンポラリファイルの作成に失敗しました');
    exit;
  end;


  //読め読め〜
  LoadFromStreamPlusAlpha('', pixS,alphaS, key_x,key_y);
  DeleteFile(StrPas(TempName));


  //解放
  pixS.Free;
  alphaS.Free;

  //復元用の情報を書きなおす
  FUseAlpha:=True;
  FSourceType:=ddsQDA;
  FQDAName:=bmpQDA;
  FQDAID:=bmpID;
  FAlphaQDAName:=alphaQDA;
  FAlphaQDAID:=alphaID;
end;


procedure TDDDDTexture.ForceRestore;
var
  DevTexture,WorkTexture:IDirect3DTexture2;
  ret:HRESULT;
begin
  //DevSurfaceかWorkSurfaceのどちらかが割り当てられてないなら、この作業は必要なし
  if not (Assigned(dSurf) And Assigned(wSurf)) then
    Exit;

  //作業サーフェスがデバイスサーフェスと同じなら何もしない
 if (dSurf = wSurf) then
    Exit;

 //デバイス用サーフェスがロストしているなら何もしない
 if FDevSurf.isLost then
    Exit;

  //Direct3DTextureに進化させる
  dSurf.QueryInterFace(IID_IDirect3DTexture2, DevTexture);
  wSurf.QueryInterFace(IID_IDirect3DTexture2, WorkTexture);

  //ロード
  ret := DevTexture.Load(WorkTexture);

  DevTexture.Release;
  WorkTexture.Release;

  TRYDD(ret,'テクスチャの転送に失敗しました');

end;

procedure TDDDDTexture.Restore;
var
  DevTexture,WorkTexture:IDirect3DTexture2;
  ret:HRESULT;
begin
  PutTestMessage('テクスチャを復元します');

  //DevSurfaceかWorkSurfaceのどちらかが割り当てられてないなら、この作業は必要なし
  if not (Assigned(dSurf) And Assigned(wSurf)) then
    Exit;

  //デバイスサーフェスをリストア
  if dSurf.Islost <> DD_OK then
    TRYDD(dSurf.Restore,'テクスチャ用作業サーフェスの復元に失敗しました');

  //作業サーフェスがデバイスサーフェスと同じなら何もしない
  if (dSurf = wSurf) then
    Exit;

  //既にデータが読み込まれていて、かつ、デバイスサーフェスがロストして無いなら、何もしない
  if FInitialized And (dSurf.IsLost = DD_OK) then
    Exit;

  //メモリの復旧
  TRYDD(dSurf.Restore,'テクスチャ用デバイスサーフェスの復元に失敗しました');

  //Direct3DTextureに進化させる
  dSurf.QueryInterFace(IID_IDirect3DTexture2, DevTexture);
  wSurf.QueryInterFace(IID_IDirect3DTexture2, WorkTexture);

  //ロード
  ret := DevTexture.Load(WorkTexture);

  DevTexture.Release;
  WorkTexture.Release;

  TRYDD(ret,'テクスチャの転送に失敗しました');

end;

//ロストしているかのチェック
function TDDDDTexture.getIsLost:Boolean;
begin
  Restore;
  result:= dSurf.IsLost <> DD_OK;
end;


function TDDDDTexture.GetHandle:THandle;
begin
  Restore;
  result:=FHandle;
end;

procedure TDDDDTexture.SetColorKeyPos(pos:TPoint);
var
  ddck:DDCOLORKEY;  //カラーキー
  ck:DWORD;         //カラーキー指定用
  Texture:IDirect3DTexture2;
begin
  FColorKeyPos:=pos;

  if not FInitialized then
    Exit;

  //必要ならカラーキーを設定
  if (pos.X>=0) And (pos.Y>=0) then begin
    ck:=FWorkSurf.Pixels[pos.x,pos.y];
  	ddck.dwColorSpaceLowValue := ck;
    ddck.dwColorSpaceHighValue := ck;
   	dSurf.SetColorKey(DDCKEY_SRCBLT, @ddck);

    //テクスチャハンドルの取得
    dSurf.QueryInterFace(IID_IDirect3DTexture2, Texture);
    //TRYDD(Texture.GetHandle(FOwner.D3DDevice,FHandle),'テクスチャのハンドルが得られませんでした');
    Texture.Release;
  end;
end;


destructor TDDDDTexture.Destroy;
begin
  //もし、すでにロードされていたら、その内容は解放
  if FInitialized then begin
    FWorkSurf.Free;
    FDevSurf.Free;
    if FSurfaceCreated then begin
      dSurf.Release;
      wSurf.Release;
    end;
  end;

  if Assigned(FDDPalette) then
    FDDPalette.Release;
  FDDPalette:=Nil;

  FHandle:=0;

  FOwner.TextureDestroyed(Self);

  inherited Destroy;
end;

}


(****************************************************************************
  Genサーフェス
  …サーフェスの生成はしない。プライマリサーフェスなどのために
 ****************************************************************************)

constructor TDDDDGenSurface.Create(AOwner:TObject; Surf:IDirectDrawSurface7; x,y:Integer);
begin
  FOwner:=AOwner;

  FWidth:=x;
  FHeight:=y;
  FSurf:=Surf;
  FLocked:=False;

  if surf = Nil then begin
    ZeroMemory(@FDesc,sizeof(FDesc));
    FDesc.dwSize:=sizeof(FDesc);
    FDesc.dwFlags:=DDSD_ALL;
  end else begin
    ZeroMemory(@FDesc,sizeof(FDesc));
    FDesc.dwSize:=sizeof(FDesc);
    surf.GetSurfaceDesc(@FDesc);
  end;


  //色変換ルーチンの初期化
  InitColorConverter(FDesc.ddpfPixelFormat);
end;

destructor TDDDDGenSurface.Destroy;
begin
  inherited Destroy;
end;


procedure TDDDDGenSurface.setColorKey(ck:DWORD);
var
  ddck:DDCOLORKEY;
begin
  FCk:=ck;

	//カラーキーの設定
	ddck.dwColorSpaceLowValue := ck;
	ddck.dwColorSpaceHighValue := ck;
	FSurf.SetColorKey(DDCKEY_SRCBLT, @ddck);
end;

//DirectX SDKのddutilから移植、TColorから物理カラーを導出
function  TDDDDGenSurface.ColorMatch(rgb:TColor):DWORD;
var
  rgbT:TColor;
  hd:HDC;
  dw:DWORD;
  ddsd:DDSURFACEDESC2;
begin
  result:=0;

  //サーフェスがロストしているなら、何もしない
  if IsLost then
    Exit;

  //入力がいいかげんなら、出力もいいかげんにする(^^;)
  {
  if rgb = CLR_INVALID then begin
    exit;
  end;
  }
  
  //  GDIのSetPixelで、TColor->DWORDな物理カラーの変換をしちまいやしょう
  TRYDD(FSurf.GetDC(hd),'ColorMatchに失敗しました、サーフェスのデバイスコンテキストのハンドルが得られません');
  rgbT := Windows.GetPixel(hd, 0, 0);             // サーフェスの左上をちょっと使うので、待避
  Windows.SetPixel(hd, 0, 0, rgb);               // ちょっと使う
  FSurf.ReleaseDC(hd);

  // 一旦ロックする
  ddsd.dwSize := sizeof(ddsd);
  TRYDD(FSurf.Lock(Nil, @ddsd, DDLOCK_WAIT, 0),'ColorMatchに失敗しました、サーフェスがロックできません');

  //左上をDWORD値として読み取る
  dw := PDWORD(ddsd.lpSurface)^;
  //bpp値でAndをとる
  dw := dw And ((1 Shl ddsd.ddpfPixelFormat.dwRGBBitCount)-1);

  //アンロック
  FSurf.Unlock(Nil);

  //サーフェスの左上を元に戻す
  TRYDD(FSurf.GetDC(hd),'ColorMatchに失敗しました、サーフェスのデバイスコンテキストのハンドルが得られません');
  Windows.SetPixel(hd, 0, 0, rgbT);
  FSurf.ReleaseDC(hd);

  result:=dw;
end;


//色変換係数の初期化
procedure TDDDDGenSurface.InitColorConverter(ddpf:DDPIXELFORMAT);
  procedure GetShiftVal(var rr,rl:DWord; bitmask:DWord);
  var
    s,m:DWORD;  //シフトとマスクの計算用
  begin
    s:=0;
    m:=bitmask;
    while ((m And 1) = 0) And (s<32) do begin  //最下位ビットが1になるまで右シフト
      Inc(s);
      m:=m shr 1;
    end;
    rl := s;

    s:=8;
    while ((m And 1) = 1) And (s>0) do begin  //最下位ビットが0になるまで右シフト
      Dec(s);
      m:=m shr 1;
    end;
    rr := s;
  end;
begin
  with Shifter do begin

    GetShiftVal(ar,al, ddpf.dwRGBAlphaBitMask);
    GetShiftVal(rr,rl, ddpf.dwRBitMask);
    GetShiftVal(gr,gl, ddpf.dwGBitMask);
    GetShiftVal(br,bl, ddpf.dwBBitMask);
    am:=ddpf.dwRGBAlphaBitMask;
    rm:=ddpf.dwRBitMask;
    gm:=ddpf.dwGBitMask;
    bm:=ddpf.dwBBitMask;

    PutTestMessage(Format('PixelFormat: AMask=%.8x RMask=%.8x GMask=%.8x BMask=%.8x',[am,rm,gm,bm]));
  end;

end;

//物理カラーをTColorに
function TDDDDGenSurface.PhysicalToTColor(dw: DWord): TColor;
begin
  if (FDesc.ddpfPixelFormat.dwFlags And DDPF_PALETTEINDEXED8 <> 0) then
    result:=(TDDDD(FOwner).Palette[dw].peRed) + (TDDDD(FOwner).Palette[dw].peGreen Shl 8) + (TDDDD(FOwner).Palette[dw].peBlue Shl 16)
  else begin
    with Shifter do
      result:=
        (((dw And rm) shr rl) shl rr) Or
        (((dw And gm) shr gl) shl (gr+8)) Or
        (((dw And bm) shr bl) shl (br+16)) Or
        (((dw And am) shr al) shl (ar+24));
  end;

  //PutTestMessage(Format('conv: %.8x → %.8x', [dw, result]));
end;

//ARGB値を物理カラーに
function TDDDDGenSurface.ARGBToPhysical(a, r, g, b: Byte): DWord;
begin
  with Shifter do
    result:=
      ((a Shr ar) Shl al) Or
      ((r Shr rr) Shl rl) Or
      ((g Shr gr) Shl gl) Or
      ((b Shr br) Shl bl);


//  PutTestMessage(Format('conv: %.2x%.2x%.2x%.2x → %.8x', [a,r,g,b, result]));
end;



//TColorを物理カラーに
function TDDDDGenSurface.TColorToPhysical(col: TColor): DWord;
var
  r,g,b,a:BYTE;
begin
  r:= col And $000000FF;
  g:=(col And $0000FF00) Shr 8;
  b:=(col And $00FF0000) Shr 16;
  a:=(col And $FF000000) Shr 24;

  with Shifter do
    result:=
      ((r Shr rr) Shl rl) Or
      ((g Shr gr) Shl gl) Or
      ((b Shr br) Shl bl) Or
      ((a Shr ar) Shl al) ;
end;




function TDDDDGenSurface.GetDC:HDC;
begin
  FSurf.GetDC(FDC);
  result:=FDC;
end;

procedure TDDDDGenSurface.ReleaseDC;
begin
  FSurf.ReleaseDC(FDC);
end;

procedure TDDDDGenSurface.Lock(var ddsd:DDSURFACEDESC2);
begin
  TRYDD(FSurf.Lock(Nil,@FDesc,DDLOCK_WAIT,0),'サーフェスがロックできません');
  FLocked:=True;
  FLockedDesc:=FDesc;
  ddsd:=FDesc;
end;

procedure TDDDDGenSurface.UnLock;
begin
  TRYDD(FSurf.Unlock(Nil),'サーフェスのアンロックに失敗しました');
  Flocked:=False;
end;

procedure TDDDDGenSurface.Restore;
begin
  if FSurf.IsLost<>DD_OK then
    FSurf.Restore;
end;

//BMPファイルを入れたストリームから画像の読みこみ
procedure TDDDDGenSurface.LoadFromBMPStream(Source:TStream);
var
	bfh:TBITMAPFILEHEADER;
	bih:TBITMAPINFOHEADER;
  ddsd:DDSURFACEDESC2;

  bypp:DWord;    //サーフェスのBytes/Pix
  fbypp:DWord;   //ファイルのBytes/Pix

  i,bpl,fbpl,pitch,height:DWord;
  pix,buf,dest:pByte;
  pal:Array[0..255] of TRGBQUAD;
  tmpBmp:TBitmap;
  hd:HDC;


  //ファイル＝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 ddsd.dwWidth-1 do begin
      idx:=pSrc^;

      phys:=ARGBToPhysical($FF, pal[idx].rgbRed, pal[idx].rgbGreen, pal[idx].rgbBlue);
      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 ddsd.dwWidth-1 do begin
      logi:=pSrc^;

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

      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 ddsd.dwWidth-1 do begin
      Move(pSrc^, logi, 3);

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

      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 ddsd.dwWidth-1 do begin
      logi:=pSrc^;

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

      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
  //Alt+Tab後で制御が無いときなど、サーフェスがロストしている状態なら何もしない
  if IsLost Then
    Exit;

  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
    TRYDD(1, '色数が8ビット〜32ビットの範囲のビットマップを、LoadBMPには指定してください');
    exit;
  end;


  //サーフェスの bypp を得る
  if (FDesc.ddpfPixelFormat.dwFlags And DDPF_PALETTEINDEXED8) <> 0 then
    bypp:=1
  else
    bypp:=FDesc.ddpfPixelFormat.dwRGBBitCount div 8;

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


  if bypp = 1 then begin

    { サーフェスが8ビットパレットつきの場合 }

    if (fbypp>1) then begin
      { ファイルがハイカラー以上なら、BitBlt }

      //TBitmapにファイルを読む
      tmpBmp:=TBitmap.Create;
      try
        Source.Position:=0;
        tmpBmp.LoadFromStream(Source);
      except
        PutDebugMessage('不正なビットマップです');
        exit;
      end;

      //BitBltでサーフェスに
      TRYDD(Surface.GetDC(hd),'サーフェスのデバイスコンテキストの取得に失敗しました');
      //ddc:=TDDDDCanvas.Create(Self);
      //ddc.CopyRect(Rect(0,0,Self.Width,Self.Height),tmpBmp.Canvas,
      //              Rect(0,0,tmpBmp.Width,tmpBmp.Height));
      Windows.BitBlt(hd, 0,0,tmpBmp.Width,tmpBMP.Height,tmpBmp.Canvas.Handle,0,0, SRCCOPY);
      tmpBmp.Free;
      //ddc.Free;
      Surface.ReleaseDC(hd);

    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);

      //サーフェスのロック
      ZeroMemory(@ddsd, sizeof(DDSURFACEDESC2));
      ddsd.dwSize := sizeof(ddsd);
      TRYDD(FSurf.Lock(Nil,@ddsd,DDLOCK_WAIT,0),'LoadBMP中にサーフェスがロックできませんでした');


      //DIBを上下さかさまにコピー
      pitch := ddsd.lPitch;
      dest := ddsd.lpSurface;
      Inc(dest,pitch * (ddsd.dwHeight-1));

      if (pitch > bpl) then
        pitch := bpl;

      height := ddsd.dwHeight;
      if (height > DWord(bih.biHeight)) then
        height := DWord(bih.biHeight);

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

      TRYDD(FSurf.Unlock(Nil),'LoadBMP中にサーフェスがアンロックできませんでした');

      FreeMem(pix);
      FreeMem(buf);


    end;

  end else begin
    {サーフェスがハイカラー以上の場合}

    //パレットの読み込み
    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);

    //サーフェスのロック
    ZeroMemory(@ddsd, sizeof(DDSURFACEDESC2));
    ddsd.dwSize := sizeof(ddsd);
    TRYDD(FSurf.Lock(Nil,@ddsd,DDLOCK_WAIT,0),'LoadBMP中にサーフェスがロックできませんでした');


    //DIBを上下さかさまにコピー
    pitch := ddsd.lPitch;
    dest := ddsd.lpSurface;
    Inc(dest,pitch * (ddsd.dwHeight-1));

    if (pitch > bpl) then
      pitch := bpl;

    height := ddsd.dwHeight;
    if (height > DWord(bih.biHeight)) then
      height := DWord(bih.biHeight);

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

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

    TRYDD(FSurf.Unlock(Nil),'LoadBMP中にサーフェスがアンロックできませんでした');

    FreeMem(pix);
    FreeMem(buf);

  end;


end;


//古いLoadFromBMPStream
{
procedure TDDDDGenSurface.LoadFromBMPStream(Source:TStream);
var
	bfh:TBITMAPFILEHEADER;
	bih:TBITMAPINFOHEADER;
  ddsd:DDSURFACEDESC2;
  i,bpl,fbpl,pitch,height,bpp,fbpp:DWord;
  pix,buf,dest:pByte;
  pal:Array[0..1023] of Byte;
  tmpBmp:TBitmap;
  hd:HDC;
begin
  //Alt+Tab後で制御が無いときなど、サーフェスがロストしている状態なら何もしない
  if IsLost Then
    Exit;

  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;

  bpp:=TDDDD(Owner).BitDepth Shr 3;

  fbpp := bih.biBitCount;
  if  fbpp = 8 then
    fbpp := 1
  else begin
    fbpp := 0;
  end;

  if (fbpp <> bpp) then begin
    fbpp := 0;
  end;

  //もし、画面の色数に合わないBMPなら、BitBltで転送する
  if (fbpp=0) Or (bpp=0) then begin
    //TBitmapにファイルを読む
    tmpBmp:=TBitmap.Create;
    try
      Source.Position:=0;
      tmpBmp.LoadFromStream(Source);
    except
      PutDebugMessage('不正なビットマップです');
      exit;
    end;

    //BitBltでサーフェスに
    TRYDD(Surface.GetDC(hd),'サーフェスのデバイスコンテキストの取得に失敗しました');
    //ddc:=TDDDDCanvas.Create(Self);
    //ddc.CopyRect(Rect(0,0,Self.Width,Self.Height),tmpBmp.Canvas,
    //              Rect(0,0,tmpBmp.Width,tmpBmp.Height));
    Windows.BitBlt(hd, 0,0,tmpBmp.Width,tmpBMP.Height,tmpBmp.Canvas.Handle,0,0, SRCCOPY);
    tmpBmp.Free;
    //ddc.Free;
    Surface.ReleaseDC(hd);
    Exit;
  end;

  if fbpp=1 then begin
    try
      Source.Read(pal,1024);
    except
      PutDebugMessage('LoadBMP中に、読み込みエラーが発生しました');
      Exit;
    end;
  end;

  Source.Position:=bfh.bfOffBits;

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

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

  //サーフェスのロック
  ZeroMemory(@ddsd, sizeof(DDSURFACEDESC2));
  ddsd.dwSize := sizeof(ddsd);
  TRYDD(FSurf.Lock(Nil,@ddsd,DDLOCK_WAIT,0),'LoadBMP中にサーフェスがロックできませんでした');


  //DIBを上下さかさまにコピー
  pitch := ddsd.lPitch;
  dest := ddsd.lpSurface;
  Inc(dest,pitch * (ddsd.dwHeight-1));

  if (pitch > bpl) then
    pitch := bpl;

  height := ddsd.dwHeight;
  if (height > DWord(bih.biHeight)) then
    height := DWord(bih.biHeight);

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

  TRYDD(FSurf.Unlock(Nil),'LoadBMP中にサーフェスがアンロックできませんでした');

  FreeMem(pix);
  FreeMem(buf);
end;
}


procedure TDDDDGenSurface.LoadBMP(fname:String);
var
  fs:TFileStream;
begin

  PutTestMessage(fname+' をサーフェスに読み込みます');

  try
    fs:=TFileStream.Create(fname,fmOpenRead);
  except
    PutDebugMessage(fname + 'が、見つかりません');
    Exit;
  end;
  LoadFromBMPStream(fs);

  fs.Free;
end;


procedure TDDDDGenSurface.LoadFromQDA(FName:String; ID:String);
var
  ms:TMemoryStream;
begin
  PutTestMessage('アーカイブ '+FName+' から、サーフェスに '+ ID +' を読み込みます');

  ms:=Nil;
  try
    ms:=ExtractFromQDAFile(FName,ID);
  except
    PutDebugMessage('アーカイブからのビットマップの読み取りに失敗しました');
    if Assigned(ms) then
      ms.Free;
    exit;
  end;

  LoadFromBMPStream(ms);

  ms.Free;
end;


//クリッピングルーチン(ユニット内部用)
function CalcClippingBF(var dx:Integer; var dy:Integer; var sr:TRect; const cr:TRect):Boolean;
var
  tcr:TRect;
  //入れ替え
  procedure swapInt(var a:Integer; var b:Integer);
  var
    c:Integer;
  begin
    c:=a;
    a:=b;
    b:=c;
  end;
  //一次元でクリッピング
  function Clip1D(var d0:Integer; d1:Integer; var s0:Integer; var s1:Integer; c0,c1:Integer):Boolean;
  var
    ts1:Integer;
  begin
    //範囲外ならそれまで
    if (d0 > c1) Or (d1 < c0) then begin
      result:=False;
      Exit;
    end;
    ts1:=s1;
    if d1 > c1 then
      s1:=s0+c1-d0;
    if d0 < c0 then begin
      s0:=ts1-(d1-c0);
      d0:=c0;
    end;
    result:=True;
  end;
  //Rect構造体の中身を正規化
  procedure RegulateRect(var r:TRect);
  begin
    with r do begin
      if Top > Bottom then
        swapInt(Top,Bottom);
      if Left > Right then
        swapInt(Left,Right);
    end;
  end;
begin

  //PutDebugMessage(Format('before: SRC (%d,%d)-(%d,%d) to (%d,%d)',[sr.left,sr.top,sr.right,sr.bottom,dx,dy]));

  RegulateRect(sr);
  tcr:=cr;
  RegulateRect(tcr);

  if not Clip1D( dx,dx+(sr.Right-sr.Left),  sr.Left,sr.Right, tcr.Left,tcr.Right) then begin
    result:=False;
    Exit;
  end;
  if not Clip1D( dy,dy+(sr.Bottom-sr.Top), sr.Top,sr.Bottom, tcr.Top,tcr.Bottom) then begin
    result:=False;
    Exit;
  end;

  //PutDebugMessage(Format('after: SRC (%d,%d)-(%d,%d) to (%d,%d)',[sr.left,sr.top,sr.right,sr.bottom,dx,dy]));

  result:=True;
end;

//クリッピングルーチン(ユニット内部用)
function CalcClippingB(var dr:TRect; var sr:TRect; const cr:TRect):Boolean;
var
  tcr:TRect;
  //入れ替え
  procedure swapInt(var a:Integer; var b:Integer);
  var
    c:Integer;
  begin
    c:=a;
    a:=b;
    b:=c;
  end;
  //一次元でクリッピング
  function Clip1D(var d0:Integer; var d1:Integer; var s0:Integer; var s1:Integer; c0,c1,dw,sw:Integer):Boolean;
  var
    ts1,td1:Integer;
  begin
    //範囲外ならそれまで
    if (d0 > c1) Or (d1 < c0) then begin
      result:=False;
      Exit;
    end;
    ts1:=s1;
    td1:=d1;
    if d1 > c1 then begin
      s1:=s0+((c1-d0)*sw div dw);
      d1:=c1;
    end;
    if d0 < c0 then begin
      s0:=ts1-((td1-c0)*sw div dw);
      d0:=c0;
    end;

    result:=True;
  end;
  //Rect構造体の中身を正規化
  procedure RegulateRect(var r:TRect);
  begin
    with r do begin
      if Top > Bottom then
        swapInt(Top,Bottom);
      if Left > Right then
        swapInt(Left,Right);
    end;
  end;
begin

  //PutDebugMessage(Format('before: SRC (%d,%d)-(%d,%d) to (%d,%d)-(%d,%d)',[sr.left,sr.top,sr.right,sr.bottom, dr.left,dr.top,dr.right,dr.bottom]));

  RegulateRect(sr);
  RegulateRect(dr);
  tcr:=cr;
  RegulateRect(tcr);

  if not Clip1D( dr.Left,dr.Right, sr.Left, sr.Right, tcr.Left,tcr.Right, (dr.Right-dr.Left), (sr.Right-sr.Left) ) then begin
    result:=False;
    Exit;
  end;
  if not Clip1D( dr.Top,dr.Bottom, sr.Top, sr.Bottom, tcr.Top,tcr.Bottom, (dr.Bottom-dr.Top), (sr.Bottom-sr.Top) ) then begin
    result:=False;
    Exit;
  end;

  //PutDebugMessage(Format(' after: SRC (%d,%d)-(%d,%d) to (%d,%d)-(%d,%d)',[sr.left,sr.top,sr.right,sr.bottom, dr.left,dr.top,dr.right,dr.bottom]));

  result:=True;
end;



function TDDDDGenSurface.Blt(SrcSurf:TDDDDGenSurface; const destRect,srcRect:TRect; dwFlags:DWORD; const fx:DDBLTFX):HRESULT;
var
  sr,dr:TRect;
  cr:TRect;
  ssurf:IDirectDrawSurface7;
begin
  sr:=srcRect;
  dr:=destRect;
  if FClipping then
    cr:=FClipRect
  else
    cr:=Classes.Rect(0,0,FWidth,FHeight);

  //SrcSrufにNilを指定された場合の処置
  if SrcSurf = Nil then
    ssurf:=Nil
  else
    ssurf:=SrcSurf.FSurf;


  if Self = TDDDD(FOwner).FrontBuffer then
    result:=FSurf.Blt(@dr, ssurf, @sr, dwFlags, @fx)
  else if CalcClippingB(dr,sr,cr) then begin
    if Self = TDDDD(Fowner).FrontBuffer then
      dr:=destRect;

    Case fx.dwDDFX of
      DDBLTFX_MIRRORLEFTRIGHT: begin
        sr:=Classes.Rect(SrcSurf.FWidth -sr.Right,sr.Top,SrcSurf.FWidth - sr.Left,sr.Bottom);
        result:=FSurf.Blt(@dr, ssurf, @sr, dwFlags, @fx);
      end;
      DDBLTFX_MIRRORUPDOWN: begin
        sr:=Classes.Rect(sr.Left,SrcSurf.FHeight - sr.Bottom,sr.Right,SrcSurf.FHeight - sr.Top);
        result:=FSurf.Blt(@dr, ssurf, @sr, dwFlags, @fx);
      end;
      else begin
        sr:=Classes.Rect(sr.Left,sr.Top,sr.Right,sr.Bottom);
        result:=FSurf.Blt(@dr, ssurf, @sr, dwFlags, @fx);
      end;
    end;
  end else
    result:=DD_OK;
end;

function TDDDDGenSurface.BltFast(SrcSurf:TDDDDGenSurface; dx,dy:Integer; const srcRect:TRect; dwFlags:DWORD):HRESULT;
var
  r:TRect;
  cr:TRect;
begin
  r:=srcRect;
  if FClipping then
    cr:=FClipRect
  else
    cr:=Classes.Rect(0,0,FWidth,FHeight);

  if CalcClippingBF(dx,dy,r,cr) then
    result:=FSurf.BltFast(dx,dy, SrcSurf.FSurf, @r, dwFlags)
  else
    result:=DD_OK;
end;


type HiLoDWord = record
  Lo,Hi:DWord;
end;


//加色合成・実行関数
procedure _BltFastAdd(srcSD,destSD:DDSURFACEDESC2; bx,by:Integer; r:TRect);
var
  mask1,mask2:DWord;      //加色合成に使うマスク
  srcLine,DestLine:PByte;
  width,height:Integer;    //転送する幅,高さ
  maskA,maskB:HiLoDWord;       //加色合成に使うマスク(64ビット)
  //pMaskA,pMaskB:Pointer;
  y:Integer;
  function BM2AM(x:DWord):DWord;
  begin
    result:= not(x Xor (X-1)) And x;
  end;
begin

  {$IFDEF USE_3DNOW}
    r.Left:=(r.Left+3) And $FFFFFFFC; //8バイト整合
    bx:=bx And $FFFFFFFC;
    width:=(r.right-r.left) Shr 2;
  {$ELSE}
    r.Left:=(r.Left+1) And $FFFFFFFE; //4バイト整合
    bx:=bx And $FFFFFFFE;
    width:=(r.right-r.left) Shr 1;
  {$ENDIF}

  srcLine:=srcSD.lpSurface;
  Inc(srcLine,r.Top * srcSD.lPitch + r.Left*2);
  destLine:=destSD.lpSurface;
  Inc(destLine,by * destSD.lPitch + bx*2);
  height:=r.Bottom-r.Top;

  if (width <= 0) Or (height <=0) then begin
    exit;
  end;


  //PixelFormatからマスクの作成
  with destSD.ddpfPixelFormat do begin
    mask1:=BM2AM(dwRBitMask) Or BM2AM(dwGBitMask) Or BM2AM(dwBBitMask);
  end;
  mask1:=mask1 Or (mask1 Shl 16); //正規化マスク
  mask2:=not mask1 Or $80008000; //桁上がり検出マスク

  maskA.Hi:=mask1;
  maskA.Lo:=mask1;
  maskB.Hi:=mask2;
  maskB.Lo:=mask2;



  {$IFDEF USE_3DNOW}
  pMaskA:=@maskA;
  pMaskB:=@maskB;
  asm
    push  ebx
    push  edi
    DW    FEMMS

    //定数の読みこみ
    mov   eax,pMaskB;
    DW    MOVQ_ld;  DB MM7_mEAX;
    mov   eax,pMaskA;
    DW    MOVQ_ld;  DB MM6_mEAX;

    DW    PXOR;     DB MM5_MM5;
    mov   eax,5
    DW    MOVD_ld;  DB MM5_EAX;

    mov   edi,height
    {Yループ}
    @LOOP_Y:

    mov   eax,srcLine   //EAXに原画へのポインタ
    mov   ebx,destLine  //EBXに書きこみ先へのポインタ

    mov   ecx,width
    {Xループ}
    @LOOP_X:

    //加色合成
    DW    MOVQ_ld;  DB MM0_mEAX;
    DW    MOVQ_ld;  DB MM1_mEBX;
    DW    PAND;     DB MM0_MM6;
    DW    PAND;     DB MM1_MM6;
    DW    PADDD;    DB MM0_MM1;
    DW    MOVQ_ld;  DB MM1_MM0;
    DW    PAND;     DB MM0_MM7;
    DW    MOVQ_ld;  DB MM2_MM0;
    DW    PSRLQ;    DB MM2_MM5;
    DW    PSUBD;    DB MM0_MM2;
    DW    POR;      DB MM0_MM1;

    DW    MOVQ_st;  DB MM0_mEBX;  //DEBUG


    //次のピクセルへ
    add   eax,8
    add   ebx,8

    dec   ecx
    jnz   @LOOP_X


    //1ライン降りる
    mov   edx,srcSD.lPitch
    add   srcLine,edx
    mov   edx,destSD.lPitch
    add   destLine,edx

    dec   edi
    jnz   @LOOP_Y

    DW    FEMMS
    pop   edi
    pop   ebx
  end;

  {$ELSE}
  For y:=1 to height do begin
    asm
      push  ebx
      push  edi
      push  esi

      //レジスタの初期化
      mov   esi,srcLine
      mov   edi,destLine
      xor   edx,edx

      @LOOP:
      cmp   edx,width
      jz    @LOOPEND

      //eax←src ebx←dest
      mov   eax,[esi+edx*4]
      mov   ebx,[edi+edx*4]


      //加色合成
      and   eax,mask1
      and   ebx,mask1
      add   eax,ebx
      //rcr   eax,1
      mov   ebx,eax
      and   eax,mask2
      mov   ecx,eax
      shr   ecx,5
      sub   eax,ecx
      or    eax,ebx
      //shl   eax,1


      //結果を格納
      //or    eax,ebx
      mov   [edi+edx*4],eax

      inc   edx
      jmp   @LOOP

      @LOOPEND:

      pop   esi
      pop   edi
      pop   ebx
    end;
    Inc(srcLine,srcSD.lPitch);
    Inc(destLine,destSD.lPitch);
  end;
  {$ENDIF}

end;


//加色合成
function TDDDDGenSurface.BltFastAdd(srcSurf:TDDDDGenSurface; bx,by:Integer; const rect:TRect; dwFlags:DWORD):HRESULT;
var
  r:TRect;
  cr:TRect;
  destSD,srcSD:DDSURFACEDESC2;
begin
  //Bltすべき範囲の計算
  r:=rect;
  if FClipping then
    cr:=FClipRect
  else
    cr:=Classes.Rect(0,0,FWidth,FHeight);


  //Bltしなくてもいいなら帰る
  if not CalcClippingBF(bx,by,r,cr) then begin
    result:=DD_OK;
    Exit;
  end;

  Lock(destSD);
  srcSurf.Lock(srcSD);

  _BltFastAdd(srcSD,destSD,bx,by, r);

  Unlock;
  srcSurf.Unlock;

  result:=DD_OK
end;


//バッチ処理でPutFastAddする
procedure TDDDDGenSurface.PutFastAddBatch(count:Integer; batch:PDDDDBltBatch);
var
  i:Integer;
  sw,sh,dw,dh:Integer;  //転送元と転送先のサイズ
  fx:DDBltFx;
  r:TRect;
  cr:TRect;
  bx,by:Integer;
  destSD,srcSD:DDSURFACEDESC2;
  prevSurface:TDDDDGenSurface;
  function ABS(x:Integer):Integer;
  begin
    if x<0 then
      result:=-x
    else
      result:=x;
  end;
begin

  ZeroMemory(@fx,sizeof(fx));
  fx.dwSize:=sizeof(fx);
  prevSurface:=Nil;

  if TDDDD(FOwner).BackBuffer.IsLost then
    Exit;
  
  TDDDD(FOwner).BackBuffer.Lock(destSD);

  for i:=1 to count do begin
    with batch^ do begin
      //まず、サイズをチェック
      dw:=ABS(destR.Right - destR.Left);
      dh:=ABS(destR.Bottom - destR.Top);
      sw:=ABS(srcR.Right - srcR.Left);
      sh:=ABS(srcR.Bottom - srcR.Top);

      //サイズが違うなら、Blt
      if (dw <> sw) Or (sh<>dh) then begin
        TDDDD(FOwner).BackBuffer.Blt(srcSurface, destR,srcR, DDBLT_KEYSRC+DDBLT_WAIT,fx);
        Continue;
      end;

      //Bltすべき範囲の計算
      bx:=destR.Left;
      by:=destR.Top;
      r:=srcR;
      if TDDDD(FOwner).BackBuffer.FClipping then
        cr:=TDDDD(FOwner).BackBuffer.FClipRect
      else
        cr:=Classes.Rect(0,0,TDDDD(FOwner).BackBuffer.FWidth,TDDDD(FOwner).BackBuffer.FHeight);


      //Bltしなくてもいいなら何もしない
      if not CalcClippingBF(bx,by,r,cr) then begin
        Inc(batch);
        Continue;
      end;

      if not (srcSurface = prevSurface) then begin
        if not (prevSurface = Nil) then
          prevSurface.Unlock;
        srcSurface.Lock(srcSD);
      end;

      _BltFastAdd(srcSD,destSD,bx,by, r);

      prevSurface:=srcSurface;
    end;
    Inc(batch);
  end;

  if not (prevSurface = Nil) then
    prevSurface.UnLock;

  TDDDD(Fowner).BackBuffer.Unlock;
end;

//塗りつぶし
procedure TDDDDGenSurface.FillRect(r:TRect; col:DWord);
var
  fx:DDBLTFX;
begin
  ZeroMemory(@fx,sizeof(fx));
  fx.dwSize:=sizeof(fx);
  fx.dwFillColor:=col;

  Blt(Nil,r,r,DDBLT_COLORFILL Or DDBLT_WAIT,fx);
end;


function TDDDDGenSurface.Put(const destRect,srcRect:TRect; dwFlags:DWORD; const fx:DDBLTFX):HRESULT;
begin
  result:=TDDDD(Owner).BackBuffer.Blt(Self,destRect,srcRect, dwFlags, fx);
end;

function TDDDDGenSurface.PutFast(dx,dy:Integer; const srcRect:TRect; dwFlags:DWORD):HRESULT;
begin
  result:=TDDDD(Owner).BackBuffer.BltFast(Self, dx,dy, srcRect, dwFlags);
end;

function TDDDDGenSurface.PutFastAdd(bx,by:Integer; const rect:TRect; dwFlags:DWORD):HRESULT;
begin
  result:=TDDDD(Owner).BackBuffer.BltFastAdd(Self, bx,by, rect, dwFlags);
end;

function TDDDDGenSurface.getDesc:DDSURFACEDESC2;
begin
  ZeroMemory(@FDesc,sizeof(FDesc));
  FDesc.dwSize:=sizeOf(FDesc);
  TRYDD(FSurf.GetSurfaceDesc(@FDesc),'サーフェス情報の取得に失敗しました');
  result:=FDesc;
end;

procedure TDDDDGenSurface.BitBlt(dx,dy,width,height:Integer; hd:HDC; sx,sy:Integer);
var
  hdcd:HDC;
begin
	FSurf.GetDC(hdcd);
	Windows.BitBlt(hdcd, dx, dy, width, height, hd, sx, sy, SRCCOPY);
	FSurf.ReleaseDC(hdcd);
end;

function TDDDDGenSurface.getIsLost:BOOL;
begin
  result:=(FSurf.IsLost <> DD_OK);
end;

//サーフェス内容のスナップショットをファイルに保存
procedure TDDDDGenSurface.SaveBMP(fname:String);
var
  ddsd:DDSURFACEDESC2;
  bfh:TBitmapFileHeader;
  bih:TBitmapInfoHeader;
  pix:pBYTE;
  bpl:integer;  //一ラインあたりのバイト数
  bpp:Integer;  //一ピクセル当たりのバイト数(ここではビット数ではない)
  pal:array[0..255] of TRGBQUAD;
  col:TColor;
  destline:pBYTE; //ビットマップの一ライン
  f:FILE;
  i,x,y:Integer;
  logPal:TLOGPAL; //システムパレット
  hd:HDC;
begin

  //サーフェスがロストしているなら、何もしない
  if IsLost then
    Exit;

  try
    AssignFile(f,fname);
    Rewrite(f,1);
  except
    PutDebugMessage('ファイル'+fname+'を作れません');
    exit;
  end;

  try
    bpp:=TDDDD(Owner).BitDepth div 8;
    if (bpp<=0) then begin
      PutDebugMessage('TDDDDGenSurface.SaveBMPの実行に失敗しました、サポートしていない色モードです。');
      exit;
    end;

    if bpp>1 then
      bpp:=3;

    bpl:=(FWidth*bpp+3) And $FFFFFFFC;

    //ヘッダの書き込み
    with bfh do begin
      bfh.bfType:=(Ord('M') shl 8 ) + Ord('B');
      bfh.bfSize:=bpl*FHeight + sizeof(bfh) + sizeof(bih);
      bfh.bfReserved1:=0;
      bfh.bfReserved2:=0;
      if bpp = 1 then
        bfh.bfOffbits:=sizeof(TBitmapInfoHeader)+sizeof(TBitmapFileHeader)+1024
      else
        bfh.bfOffbits:=sizeof(TBitmapInfoHeader)+sizeof(TBitmapFileHeader);
    end;
    with bih do begin
      biSize:=sizeof(TBitmapInfoHeader);
      biWidth:=FWidth;
      biHeight:=FHeight;
      biPlanes:=1;
      biBitCount:=bpp*8;
      biCompression:=BI_RGB;
      biSizeImage:=bpl*FHeight;
      biXPelsPerMeter:=0;
      biYPelsPerMeter:=0;
      if bpp=1 then
        biClrUsed:=256
      else
        biClrUsed:=0;
      biClrImportant:=0;
    end;

    //ヘッダの書き込み
    BlockWrite(f,bfh,sizeof(TBitmapFileHeader));
    BlockWrite(f,bih,sizeof(TBitmapInfoHeader));

    //パレットの書き込み
    if (bpp=1) then begin
      hd := Windows.GetDC(0);
      if TDDDD(Owner).FFullScreen then begin
        for i:=0 to 255 do begin
          with pal[i],TDDDD(Owner).Palette[i] do begin
            rgbBlue:=peBlue;
            rgbRed:=peRed;
            rgbgreen:=peGreen;
            rgbReserved:=0;
          end;
        end;
      end else begin
        //パレットの設定
        GetSystemPaletteEntries(hd,0,256,logpal.aEntries);
        Windows.ReleaseDC(0,hd);
        for i:=0 to 255 do begin
          with pal[i],logpal.aEntries[i] do begin
            rgbBlue:=peBlue;
            rgbRed:=peRed;
            rgbgreen:=peGreen;
            rgbReserved:=0;
          end;
        end;
      end;
      BlockWrite(f,pal,1024);
    end;

    Seek(f,bfh.bfOffbits);

    //8BPPなら、パレット付きでVRAMから直転送、そうでないなら変換しながら転送
    if bpp=3 then begin
      Lock(ddsd);
      GetMem(destLine,bpl);

      For y:=FHeight-1 downto 0 do begin
        pix:=destLine;
        For x:=0 to FWidth-1 do begin
          col:=TDDDD(FOwner).PhysicalToTColor(Pixels[x,y]);
          pix^:=col And $00FF0000 Shr 16;
          Inc(pix);
          pix^:=col And $0000FF00 Shr 8;
          Inc(pix);
          pix^:=col  And $0000000FF;
          Inc(pix);
        end;
        BlockWrite(f,destLine^,bpl);
        Seek(f,bpl - FWidth * 3 + FilePos(f));
      end;
      FreeMem(destLine);
      Unlock;
    end else begin
      Lock(ddsd);
      pix:=ddsd.lpSurface;
      Inc(pix, ddsd.lPitch * (FHeight - 1));
      for i:=1 to FHeight do begin
        BlockWrite(f,pix^,FWidth);
        Seek(f,bpl - FWidth + FilePos(f));
        dec(pix,ddsd.lPitch);
      end;
      Unlock;
    end;
  finally
    CloseFile(f);
  end;
end;


//VRAM直叩きによるピクセル情報セット/ゲットだぜ関数
function TDDDDGenSurface.getPixel(x,y:Integer):DWORD;
var
  ddsd:DDSURFACEDESC2;
  pPix:PByte; //ピクセルへのポインタ
  curDepth:DWORD; //このサーフェスのビットデプス
  curByteDepth:DWORD;
  alreadyLocked:Boolean;  //既にサーフェスはロックされている
begin
  if (x<0) Or (x>FWidth-1) Or (y<0) Or (y>FHeight-1) then begin
    PutDebugMessage('サーフェス外のピクセルを参照しようとしました');
    Exit;
  end;

  //まずロック
  if not FLocked then begin
    alreadyLocked:=False;
    ZeroMemory(@ddsd,sizeof(ddsd));
    ddsd.dwSize:=sizeof(ddsd);
    //TRYDD(FSurf.Lock(Nil,ddsd,DDLOCK_READONLY + DDLOCK_WAIT,0),'サーフェスのロックに失敗しました');
    if FSurf.Lock(Nil,@ddsd,DDLOCK_READONLY + DDLOCK_WAIT,0) <> DD_OK then
      Exit;
  end else begin
    ddsd:=FLockedDesc;
    alreadyLocked:=True;
  end;


  //所望のピクセルの、アドレスを算出
  curDepth:=ddsd.ddpfPixelFormat.dwRGBBitCount;
  curByteDepth:=curDepth Shr 3;
  pPix:=ddsd.lpSurface;
  Inc(pPix,ddsd.lPitch * y);
  Inc(pPix,DWord(x) * curByteDepth);


  //DWORD値として読み取る
  case curByteDepth of
    1: result := PBYTE(pPix)^;
    2: result := PWORD(pPix)^;
    3: begin
      result:=0;
      Move(pPix^,result,3);
    end;
    4: result := PDWORD(pPix)^;
  end;
  //bpp値でAndをとる
  //result := dw And ((1 Shl curDepth)-1);

  //忘れずアンロック
  if not alreadyLocked then
    FSurf.UnLock(Nil);
end;

procedure TDDDDGenSurface.setPixel(x,y:Integer; p:DWORD);
var
  ddsd:DDSURFACEDESC2;
  pPix:PByte; //ピクセルへのポインタ
  curDepth:DWORD; //このサーフェスのビットデプス
  curByteDepth:DWORD;
  alreadyLocked:Boolean;  //すでにロックされている
begin

  //範囲チェック
  if (x<0) Or (x>FWidth-1) Or (y<0) Or (y>FHeight-1) then begin
    PutDebugMessage('サーフェス外のピクセルを変更しようとしました');
    Exit;
  end;

  //まずロック(既にロック済みなら、なにもしない)
  alreadyLocked:=FLocked;

  if not alreadyLocked then begin
    ZeroMemory(@ddsd,sizeof(ddsd));
    ddsd.dwSize:=sizeof(ddsd);
    //TRYDD(FSurf.Lock(Nil,ddsd,DDLOCK_WAIT,0),'サーフェスのロックに失敗しました');
    if (FSurf.Lock(Nil,@ddsd,DDLOCK_WAIT,0) <> DD_OK) then
      Exit;
  end else
    ddsd:=FLockedDesc;

  //所望のピクセルの、アドレスを算出
  curDepth:=ddsd.ddpfPixelFormat.dwRGBBitCount;
  curByteDepth:=curDepth Shr 3;
  pPix:=ddsd.lpSurface;
  Inc(pPix,ddsd.lPitch * y);
  Inc(pPix,DWord(x) * curByteDepth);

  //DWORD値として書き込む
  case curByteDepth of
    1: PBYTE(pPix)^ := BYTE(p And $FF);
    2: PWORD(pPix)^ := Word(p And $FFFF);
    3: begin
      p:=p And $FFFFFF;
      Move(p,pPix^,3);
    end;
    4: PDWORD(pPix)^:=p;
  end;
  //bpp値でAndをとる
  //result := dw And ((1 Shl curDepth)-1);

  //忘れずアンロック
  if not alreadyLocked then
    FSurf.UnLock(Nil);
end;







(****************************************************************************
  サーフェスの生成、自動復元
 ****************************************************************************)

//privateで宣言されている、実働手続き
procedure TDDDDSurface.CreateSurface(AOwner:TObject; width,height:Integer; colorKey:DWORD; where:TDDDDSurfaceMemoryType);
var
  ddck:DDCOLORKEY;
  backSCaps:DDSCAPS2;
begin
  FSurf := Nil;
  FBMPName:='';

  //DDSURFACEDESC2の作成
  ZeroMemory(@FDesc,Sizeof(FDesc));
  with FDesc do begin
    dwSize:=Sizeof(FDesc);
  	dwFlags := DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT;
	  dwWidth := width;
	  dwHeight := height;

    case where of
      smtDefault: begin //バックバッファと同じ位置
        TDDDD(FOwner).BackBuffer.Surface.GetCaps(@backSCaps);

        if backSCaps.dwCaps And DDSCAPS_VIDEOMEMORY <> 0 then
          ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
        else
          ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY;
      end;

      smtCompatible: begin  //以前のバージョンのQuadruple Dでのデフォルト
        if TDDDD(AOwner).FullScreen then
          ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN
        else
          ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY;
      end;

      smtSystemMemory: begin  //システムメモリ優先
        ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY;
      end;

      smtVideoMemory: begin   //ビデオメモリ優先
        ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY;
      end;

      smtNonLocalVideoMemory: begin //AGPメモリ優先
        ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY Or DDSCAPS_NONLOCALVIDMEM;
      end;
    end;

  end;

  if FDesc.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY <> 0 then
    if FDesc.ddsCaps.dwCaps And DDSCAPS_NONLOCALVIDMEM <> 0 then
      PutTestMessage('サーフェスをノンローカルビデオメモリに配置します')
    else
      PutTestMessage('サーフェスをビデオメモリに配置します')
  else if FDesc.ddsCaps.dwCaps And DDSCAPS_SYSTEMMEMORY  <> 0 then
    PutTestMessage('サーフェスをシステムメモリに配置します')
  else
    PutTestMessage('サーフェスをドライバのデフォルトの位置(おそらくビデオメモリ)に配置します');


  //実際にSurfaceを作る…指定通りに作ってダメならシステムメモリを強制使用
  if TDDDD(AOwner).DDraw.CreateSurface(@FDesc, FSurf, Nil) <> DD_OK then begin
    FDesc.ddsCaps.dwCaps:=DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY;
    TRYDD(TDDDD(AOwner).DDraw.CreateSurface(@FDesc, FSurf, Nil),'サーフェスを作れませんでした');
  end;


	//カラーキーの設定
	ddck.dwColorSpaceLowValue := colorKey;
	ddck.dwColorSpaceHighValue := colorKey;
	FSurf.SetColorKey(DDCKEY_SRCBLT, @ddck);

  //FDescを更新
  getDesc;

  //メンバの設定
  FWidth:=width;
  FHeight:=height;
  FCk:=colorKey;
  FClipping:=False;
  ClipRect:=Rect(0,0,FWidth,FHeight);


  TDDDD(FOwner).KeepSurface(Self);  //自分が作られたことを、DDDDに知らせる

  //色変換ルーチンの初期化
  InitColorConverter(FDesc.ddpfPixelFormat);

end;





{$IFNDEF FOR_CPPBUILDER}

//Delphi用コンストラクタ郡

//普通にサーフェス作成
constructor TDDDDSurface.Create(AOwner:TObject; width,height:Integer; colorKey:DWORD);
begin
  //オーナーの設定
  FOwner:=AOwner;

  CreateSurface(AOwner, width,height,colorKey, TDDDD(FOwner).SurfaceLocation);
end;

//システムメモリに作る
constructor TDDDDSurface.CreateOnSystemMemory(AOwner:TObject; width,height:Integer; colorKey:DWORD);
begin
  //オーナーの設定
  FOwner:=AOwner;

  CreateSurface(AOwner, width,height,colorKey, smtSystemMemory);
end;

//ビデオメモリに作る
constructor TDDDDSurface.CreateOnVideoMemory(AOwner:TObject; width,height:Integer; colorKey:DWORD);
begin
  //オーナーの設定
  FOwner:=AOwner;

  CreateSurface(AOwner, width,height,colorKey, smtVideoMemory);
end;


//AGP用のノンローカルビデオメモリに作る
constructor TDDDDSurface.CreateOnNonLocalVideoMemory(AOwner:TObject; width,height:Integer; colorKey:DWORD);
begin
  //オーナーの設定
  FOwner:=AOwner;

  CreateSurface(AOwner, width,height,colorKey, smtNonLocalVideoMemory);
end;



{$ELSE}

//C++ Builder用コンストラクタ

constructor TDDDDSurface.Create(AOwner:TObject; width,height:Integer; colorKey:DWORD; where:TDDDDSurfaceMemoryType);
begin
  //オーナーの設定
  FOwner:=AOwner;

  CreateSurface(AOwner, width,height,colorKey, where);
end;



{$ENDIF}  //FOR_CPPBUILDER



destructor TDDDDSurface.Destroy;
begin
  Clipping:=False;

  if FSurf <> Nil then begin
    TRYDD(FSurf.Release,'サーフェスの解放に失敗しました');
  end;

  TDDDD(FOwner).SurfaceDestroyed(Self); //自分が破棄されたことを、DDDDに知らせる


  inherited Destroy;
end;


procedure TDDDDSurface.LoadBMP(fname:String);
begin
  FBMPname:=fname;
  FSourceType:=ddsBMP;

  inherited;
end;

procedure TDDDDSurface.LoadFromQDA(FName:String; ID:String);
begin
  FQDAName:=FName;
  FQDAID:=ID;
  FSourceType:=ddsQDA;

  inherited;
end;







(****************************************************************************
  SurfaceKeeper
****************************************************************************)

//保存
constructor TDDDDSurfaceKeeper.Create(owner:TObject; surf:TDDDDSurface);
begin
  inherited Create;

  FOwner:=owner;
  FTarget:=surf;

  FWidth:=surf.Width;
  FHeight:=surf.Height;
  FDepth:=TDDDD(Owner).BitDepth;
end;

//OnRestore用の復元
procedure  TDDDDSurfaceKeeper.Restore;
begin
  if FTarget.IsLost then
    FTarget.Restore
  else
    Exit;

  PutTestMessage('サーフェスを復元します');

  //ファイルから読みなおす
  if FTarget.FSourceType = ddsBMP then begin
    if FTarget.FBMPName <> '' then
      FTarget.LoadBMP(FTarget.FBMPName);
  end else begin
    if FTarget.FQDAName <> '' then
      FTarget.LoadFromQDA(FTarget.FQDAName,FTarget.FQDAID);
  end;

end;

//OnChangeDisplayMode用の再生成
procedure  TDDDDSurfaceKeeper.Recover;
var
  ddck:DDCOLORKEY;
begin
  //DDSURFACEDESC2の作成
  with FTarget.FDesc do begin
  	dwFlags := DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT;
  end;

  PutTestMessage(Format('ID:%dのサーフェスを再構築します',[FID]));

  //実際にSurfaceを作る
  //まず元のサーフェスの位置で作り、失敗したらシステムメモリに
  with FTarget do begin
    if TDDDD(FOwner).DDraw.CreateSurface(@FDesc, FSurf, Nil) <> DD_OK then begin
      PutTestMessage('システムメモリにサーフェスを再構築します');
      FDesc.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY;
      TRYDD(TDDDD(FOwner).DDraw.CreateSurface(@FDesc, FSurf, Nil),'サーフェスを作れませんでした');
    end;

  	//カラーキーの設定
    ddck.dwColorSpaceLowValue := FCk;
 	  ddck.dwColorSpaceHighValue := FCk;
	  FSurf.SetColorKey(DDCKEY_SRCBLT, @ddck);
  end;

  //SurfaceDescの再構築
  FTarget.GetDesc;

  //ファイルから読みなおす
  if FTarget.FSourceType = ddsBMP then begin
    if FTarget.FBMPName <> '' then
      FTarget.LoadBMP(FTarget.FBMPName);
  end else begin
    if FTarget.FQDAName <> '' then
      FTarget.LoadFromQDA(FTarget.FQDAName,FTarget.FQDAID);
  end;

end;


procedure TDDDDSurfaceKeeper.Release;
begin
  PutTestMessage(Format('DirectDrawオブジェクトの解放に伴い、ID:%dのサーフェスを解放します',[FID]));

  FTarget.Surface.Release;
end;



destructor TDDDDSurfaceKeeper.Destroy;
begin
  inherited;
end;




(****************************************************************************
  TextureKeeper
****************************************************************************)
//保存
constructor TDDDDTextureKeeper.Create(owner:TObject; tex:TDDDDTexture);
begin
  inherited Create;

  FOwner:=owner;
  FTarget:=tex;

end;

//OnRestore用の復元
procedure  TDDDDTextureKeeper.Restore;
begin
  FTarget.Restore;

  //ファイルから読みなおす
  if FTarget.FSourceType = ddsBMP then begin
    if FTarget.FBMPName <> '' then
      FTarget.LoadBMP(FTarget.FBMPName);
  end else begin
    if FTarget.FQDAName <> '' then
      FTarget.LoadFromQDA(FTarget.FQDAName,FTarget.FQDAID);
  end;

end;

//OnChangeDisplayMode用の再生成
procedure  TDDDDTextureKeeper.Recover;
begin

  PutTestMessage(Format('ID:%dのテクスチャを再構築します',[FID]));

  //実際にSurfaceを作る
  with FTarget do begin
    CreateSurface(FWidth, FHeight, FCk, FPixelFormatStr);
  end;

  //ファイルから読みなおす
  if FTarget.FSourceType = ddsBMP then begin
    if FTarget.FBMPName <> '' then
      FTarget.LoadBMP(FTarget.FBMPName);
  end else begin
    if FTarget.FQDAName <> '' then
      FTarget.LoadFromQDA(FTarget.FQDAName,FTarget.FQDAID);
  end;

  //FTarget.ForceRestore;
end;


//画面の切り替わり等で、クリーンナップされた事を知らせる
procedure  TDDDDTextureKeeper.Release;
begin
  PutTestMessage(Format('DirectDrawオブジェクトの解放に伴い、ID:%dのテクスチャを解放します',[FID]));

  FTarget.Surface.Release;
  //FTarget.FSurfaceCreated:=False;
end;

destructor TDDDDTextureKeeper.Destroy;
begin
  inherited;
end;








(****************************************************************************
  DDDD本体
****************************************************************************)
constructor TDDDD.Create(AOwner:TComponent);
var
  i,count:Integer;
begin
  inherited Create(AOwner);

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

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

  //プロパティのデフォルト値
  FAutoDisplayModeInitialize:=True;
  FSuppressRestore:=False;
  FDisableScreenSaver:=True;
  FVsyncAtWindowed:=True;
  //FAllowRakugaki:=False;
  FSurfaceLocation:=smtDefault;
  FBackBufferLocationAtWindowed:=bmtDefault;

  FD3DOptions:=[MakeZBuffer];

  FInitialBitDepth:=0;
  FInitializeFullScreen:=False;
  FInitialScreenWidth:=640;
  FInitialScreenHeight:=480;

  FDebugOption := [ddoHaltOnError];

  if not (csDesigning in ComponentState) then begin
    FAtLast:=False;
    FAtFirst:=True;
    FAfterInit:=False;

    FOwnerOnPaint:=TForm(Owner).OnPaint;
    TForm(Owner).OnPaint:=DoRestore;
    FOwnerOnCreate:=TForm(Owner).OnCreate;
    TForm(Owner).OnCreate:=DoInit;

    //アプリ起動時のスクリーンセーバーの状態を取得
    SystemParametersInfo(SPI_GETSCREENSAVEACTIVE,0,@FScreenSaverWasActive,SPIF_UPDATEINIFILE);

    //各変数の初期化
    FDDraw:=Nil;
    DDPalette:=Nil;
    FBackBuffer:=Nil;
    FFrontBuffer:=Nil;
    FBackBuffer:=Nil;
    FClipper:=Nil;
    FFreq:=0;

    FD3D:=Nil;
    FD3DDevice:=Nil;
    //FD3DRM1:=Nil;
    FD3DRM:=Nil;
    FD3DRMDevice:=Nil;
    FZBuffer:=Nil;
    FEye:=Nil;
    FViewport:=Nil;
    //FD3DDeviceList:=Nil;

    NSurfaceCreated:=0;
    NTextureCreated:=0;

    //DirectDrawDriverリストの作成
    FDDDriverList:=TStringList.Create;
    DirectDrawEnumerate(Pointer(@EnumDirectDrawDriver),FDDDriverList);

    //SurfaceKeeper用
    SurfaceKeepList:=TList.Create;
    TextureKeepList:=TList.Create;
  end;
end;

destructor TDDDD.Destroy;
begin
  //NPF('Destroy');

  FAtLast:=True;
  if  not (csDesigning in ComponentState) then begin

    //DirectDrawDriverリストのクリア
    FDDDriverList.Free;

    //スクリーンセーバーの状態を戻す
    DisableScreenSaver:=not FScreenSaverWasActive;

    //イベントハンドラを呼ぶ
    if Assigned(FOnDestroy) then
      FOnDestroy(Self);

    //全解放
    ReleaseAll;

    //ウィンドウプロシジャを戻す
  	SetWindowLong(FOwnerHWnd, GWL_WNDPROC, Longint(FOwnerWndProc));
	  FreeObjectInstance(FNewProc);

    //キーパーリストの解放
    TextureKeepList.Free;
    SurfaceKeepList.Free;
  end;

  inherited Destroy;
end;

procedure TDDDD.ReleaseAll; //DirectDraw関連オブジェクトを全解放
begin

  FSuppressRestore:=True;   //解像度の変更が終わるまではOnRestoreイベントハンドラを呼ばないようにする

  if FAtFirst then
    Exit;

  PutTestMessage('…DirectDraw/3D関連オブジェクトを全て解放します…');


  //クリーンナップイベントを呼ぶ ＆ オフスクリーンサーフェス全解放
  if FAfterInit then begin
    CleanUpSurfaces;
    PutTestMessage('オフスクリーンサーフェスを全て解放しました');

    if Assigned(FOnCleanUp) then
      FOnCleanUp(Self);
  end;


  //Direct3Dデバイスを解放
  if FUse3D then begin

    if FViewport<>Nil then begin
      TRYDD(FViewport.Release, 'RM用ビューポートの解放に失敗しました');
      PutTestMessage('RM用ViewPortを解放しました');
      FViewport:=Nil;
    end;

    if FD3DRMDevice<>nil then begin
      TRYDD(FD3DRMDevice.Release,'Direct3DRMDeviceの解放に失敗しました');
      PutTestMessage('Direct3DRMDeviceを解放しました');
      FD3DRMDevice:=nil;
    end;

  end;


  if (DDPalette<>Nil) then begin
    TRYDD(DDPalette.Release, 'パレットの解放に失敗しました');
    PutTestMessage('パレットを解放しました');
    DDPalette:=Nil;
  end;

  if Use3D then begin
    //コンポーネントが破棄されない限り、Direct3DRMオブジェクトは解放しない
    if FAtLast then begin

      if FD3DRM<>Nil then begin
        TRYDD(FD3DRM.Release,'Direct3DRM3の解放に失敗しました');
        PutTestMessage('Direct3DRM3を解放しました');
        FD3DRM:=Nil;
      end;
      {
      if FD3DRM1<>Nil then begin
        TRYDD(FD3DRM1.Release,'Direct3DRM1オブジェクトの解放に失敗しました');
        FD3DRM1:=Nil;
      end;
      }
    end;
    if Assigned(FZBuffer) then begin
      TRYDD(FBackBuffer.Surface.DeleteAttachedSurface(0, FZBuffer.Surface), 'Zバッファのバックバッファからの切断に失敗しました');
      TRYDD(FZBuffer.Surface.Release,'Zバッファの解放に失敗しました');
      PutTestMessage('Zバッファを解放しました');
      FZBuffer.Free;
      FZBuffer:=Nil;
    end;

    if FD3D<>Nil then begin
      //TRYDD(FD3D.Release,'Direct3Dの解放に失敗しました');
      FD3D.Release;
      PutTestMessage('Direct3Dを解放しました');
      FD3D:=Nil;
    end;

  end;


  if Assigned(FBackBuffer) then begin
    //TRYDD(FBackBuffer.Surface.Release, 'バックバッファの解放に失敗しました');
    FBackBuffer.Surface.Release;
    FBackBuffer.Free;
    PutTestMessage('バックバッファを解放しました');
    FBackBuffer:=Nil;
  end;

  if Assigned(FFrontBuffer) then begin
    TRYDD(FFrontBuffer.Surface.Release, 'プライマリサーフェスの解放に失敗しました');
    FFrontBuffer.Free;
    PutTestMessage('プライマリサーフェスを解放しました');
    FFrontBuffer:=Nil;
  end;

  if Assigned(FClipper) then begin
    TRYDD(FClipper.Release, 'Clipperの解放に失敗しました');
    PutTestMessage('クリッパーを解放しました');
    FClipper:=Nil;
  end;


  if (FUse3D) And (FD3DDevice<>Nil) then begin
    TRYDD(FD3DDevice.Release,'Direct3DDeviceの解放に失敗しました');
    PutTestMessage('Direct3DDeviceを解放しました');
    FD3DDevice:=nil;
  end;

  if Assigned(FDDraw) And FFullScreen  then
    FDDraw.RestoreDisplayMode;

  if Assigned(FDDraw) then begin
    TRYDD(FDDraw.Release,'DirectDrawの解放に失敗しました');
    PutTestMessage('DirectDrawを解放しました');
    FDDRaw:=Nil;
  end;

  PutTestMessage('…DirectDraw/3D関連オブジェクト、解放終了しました…');

end;


function TDDDD.getFreq:Integer;
var
  f:WORD;
begin
  DDraw.GetMonitorFrequency(@f);
  result:=f;
end;

function TDDDD.getBitDepth:Integer;
var
  tmpDC:HDC;
begin
  tmpDC := CreateIC('Display',Nil,Nil,Nil);
	result := GetDeviceCaps(tmpDC,BITSPIXEL);
	DeleteDC(tmpDC);
end;

procedure TDDDD.Loaded;
begin
  inherited Loaded;

  //プロパティハンドラ(?)を実行
  if (not (csDesigning in ComponentState)) then
    setDisableScreenSaver(DisableScreenSaver);

  //デバッグ用変数をリフレッシュ
  DebugOption:=DebugOption;
end;

procedure TDDDD.Flip;
var
  ddsd:DDSURFACEDESC2;
  sr:TRect;       //転送元矩形
  dr:TRect;       //転送先矩形
{
  sw, sh:Integer; //転送元矩形のサイズ
  dw, dh:Integer; //転送先矩形のサイズ
}
  cr:TRect;
  p:TPoint;
  fx:DDBltFx;
begin

	if (FFullScreen) then begin
		if FFrontBuffer.Surface.Flip(Nil, DDFLIP_WAIT) = DD_OK then
      Exit;
  end;


  ZeroMemory(@ddsd,sizeof(ddsd));
  ddsd.dwSize := sizeof(ddsd);
  FBackBuffer.Surface.GetSurfaceDesc(@ddsd);

  //転送元(バックバッファ全体)・転送先(クライアントエリア)・クリップ枠(画面全体)の計算
  with sr do begin
    Top := 0;
    Left := 0;
    Bottom := ddsd.dwHeight;
    Right := ddsd.dwWidth;
//    sw:=abs(Right-Left);
//    sh:=abs(Bottom-Top);
  end;

  //クライアント領域全体が、転送先
  dr:=TForm(Owner).ClientRect;
  p:=TForm(Owner).ClientToScreen(Point(0,0));
  with dr,p do begin
    Inc(Left,X);
    Inc(Right,X);
    Inc(Top,Y);
    Inc(Bottom,Y);
    //dw:=abs(Right-Left);
    //dh:=abs(Bottom-Top);
  end;
  //dr:=FScreenRect;

  with cr do begin
    Top:=0;
    Left:=0;
    Right:=Screen.Width;
    Bottom:=Screen.Height;
  end;

  if FVsyncAtWindowed then
    DDraw.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN,0);

  ZeroMemory(@fx,sizeof(fx));
  fx.dwSize:=Sizeof(DDBltFx);

  //クリッパにクリッピングを任せる
{
  if not FAllowRakugaki then begin
    if CalcClippingB(dr,sr,cr) then begin
      FFrontBuffer.Surface.Blt(@dr,FBackBuffer.Surface,@sr,DDBLT_WAIT,@fx);
    end;
  end else
}
    FFrontBuffer.Surface.Blt(@dr,FBackBuffer.Surface,@sr,DDBLT_WAIT,@fx);
//  end;

end;

procedure TDDDD.Clear;
var
  fx:DDBltFx;
  r:TRect;
begin
	ZeroMemory(@fx, sizeof(DDBLTFX));
	fx.dwSize := sizeof(DDBLTFX);
	fx.dwFillColor := FBackColor;

  with r do begin
    top:=0;
    left:=0;
    right:=FScrWidth;
    bottom:=FScrHeight;
  end;

  //TRYDDで囲った方が良いけど、Atl+Tabの時に引っかかるので
	FBackBuffer.Surface.Blt(@r,Nil,@r,
						DDBLT_COLORFILL Or DDBLT_WAIT,@fx);
end;

procedure TDDDD.Restore;
begin
  FFrontBuffer.Restore;
	if (not FFullScreen) then
    FBackBuffer.Restore;
  if Use3D And (Assigned(FZBuffer)) then
    FZBuffer.Restore;

  RestoreSurfaces;
end;




//あるDirectDrawドライバが、3Dをサポートしているか調べる
function isSuport3D(const dd:IDirectDraw7):Boolean;
var
  DriverCaps,HELCaps:DDCAPS;
begin
  result:=False;

  ZeroMemory(@DriverCaps,sizeof(DDCAPS));
  DriverCaps.dwSize := sizeof(DDCAPS);
  ZeroMemory(@HELCaps,sizeof(DDCAPS));
  HELCaps.dwSize := sizeof(DDCAPS);

  if (dd.GetCaps(@DriverCaps,@HELCaps)<>DD_OK) then
    Exit;

  if ((DriverCaps.dwCaps and DDCAPS_3D)<>0) And
     ((DriverCaps.ddsCaps.dwCaps and DDSCAPS_TEXTURE)<>0) then begin
    result:=True;
  end;
end;

//DirectDrawDriverのうち、3D HALを持っているものを探す。
//見たかったならTrueを返す
function FindDirectDrawDriver( lpGUID: PGUID ; lpDriverDescription: LPSTR ;
      lpDriverName: LPSTR ; lpContext: Pointer ): BOOL ;stdcall;
var
  lpTempDD:IDirectDraw7;
begin
  PutTestMessage(Format('Enumerated DDraw Driver ... %s',[StrPas(lpDriverDescription)]));

  if(lpGUID <> nil)then begin
		TRYDD(DirectDrawCreateEx(lpGUID,Pointer(lpTempDD),IID_IDirectDraw7, Nil),'DirectDrawオブジェクトの作成に失敗しました');
    PutTestMessage('DirectDrawオブジェクトをテスト作成しました');

    if isSuport3D(lpTempDD) then begin
			IDIRECTDRAW7(lpContext) := lpTempDD;
			Result:= BOOL(DDENUMRET_CANCEL);
      PutTestMessage('テスト作成されたDirectDrawオブジェクトを採用します');
      exit;
    end;

    if (lpTempDD<> nil) then begin
			IDIRECTDRAW(lpContext) := Nil;
      lpTempDD.Release;
      PutTestMessage('テスト用DirectDrawオブジェクトを解放しました');
      lpTempDD:= nil;
    end;

	end;
	Result:= BOOL(DDENUMRET_OK);
end;


//D3Dデバイスの列挙
function EnumD3DDeviceCallBack(lpDeviceDescription: LPSTR;
	 lpDeviceName: LPSTR; Para0: LPD3DDEVICEDESC7; Para1: Pointer): HRESULT; stdcall;
var
  QD:TDDDD;
  devGuid:TGUID;
begin

  QD:=Para1;

  Move(Para0^.DeviceGUID,devGUID,Sizeof(TGUID));
  
  if CompareMem(@devGUID, @IID_IDirect3DTnLHalDevice, Sizeof(TGUID)) then
    QD.FValidD3DDeviceType:=QD.FValidD3DDeviceType + [dtTnLHAL];

  if CompareMem(@devGUID, @IID_IDirect3DHALDEVICE, Sizeof(TGUID)) then
    QD.FValidD3DDeviceType:=QD.FValidD3DDeviceType + [dtHAL];

  if CompareMem(@devGUID, @IID_IDirect3DMMXDevice, Sizeof(TGUID)) then
    QD.FValidD3DDeviceType:=QD.FValidD3DDeviceType + [dtMMX];

  if CompareMem(@devGUID, @IID_IDirect3DRGBDevice, Sizeof(TGUID)) then
    QD.FValidD3DDeviceType:=QD.FValidD3DDeviceType + [dtRGB];

  if CompareMem(@devGUID, @IID_IDirect3DRampDevice, Sizeof(TGUID)) then
    QD.FValidD3DDeviceType:=QD.FValidD3DDeviceType + [dtRamp];

  if CompareMem(@devGUID, @IID_IDirect3DRefDevice, Sizeof(TGUID)) then
    QD.FValidD3DDeviceType:=QD.FValidD3DDeviceType + [dtRef];


  result:=DDENUMRET_OK;
end;



type TEnumDDDInfo = record
  name:String[255];
  ddraw:IDirectDraw7;
end;

type PEnumDDDInfo = ^TEnumDDDInfo;

//DirectDrawドライバを列挙して、名前が一致したら生成
function EnumDDDAndCreate( lpGUID: PGUID ; lpDriverDescription: LPSTR ;
      lpDriverName: LPSTR ; lpContext: Pointer ): BOOL ;stdcall;
var
  pInfo:PEnumDDDInfo;
  drvSym:String;    //DirectX SDKにならって、ドライバ名でマッチング
  tmpDD:IDirectDraw7;
begin
  pInfo:=lpContext;

  drvSym:=Format('%s (%s)',[StrPas(lpDriverDescription),StrPas(lpDriverName)]);

  if drvSym = pInfo^.name then begin
    if DirectDrawCreateEx(lpGUID,Pointer(tmpDD),IID_IDirectDraw7, Nil) = DD_OK then begin
      PutTestMessage('DirectDrawオブジェクトを作成しました');
      pInfo^.ddraw:=tmpDD;
      PutTestMessage(Format('Created DDraw Driver ... %s %p',[drvSym,Pointer(pInfo^.ddraw)]));
    	Result:= BOOL(DDENUMRET_CANCEL);
      Exit;
    end;
  end;

	Result:= BOOL(DDENUMRET_OK);
end;


//同じ名前を持つDirectDrawオブジェクトを生成
function CreateDirectDrawByName(name:String):IDirectDraw7;
var
  info:TEnumDDDInfo;
begin
  info.name:=name;
  info.ddraw:=Nil;

  DirectDrawEnumerate(Pointer(@EnumDDDAndCreate),@info);
  result:=info.ddraw;
end;


//同じ名前を持つDirect3Dデバイスを作成
{
function CreateDirect3DDeviceByName(name:String):IDirect3DDevice;
begin

end;
}

//Zバッファの列挙コールバック
function EnumZBufFormatCallBack(lpDDPixFmt: LPDDPIXELFORMAT; lpContext: Pointer): HRESULT; stdcall;
begin

  if  lpDDPixFmt^.dwFlags = DDPF_ZBUFFER then begin
    with lpDDPixFmt^ do
      PutTestMessage(Format('列挙されたZバッファのフォーマット...ZDepth=%d SDepth=%d Mask=(Z:%.8x S:%.8x L:%.8x)',
        [dwZBufferBitDepth,dwStencilBitDepth,dwZBitMask,dwStencilBitMask,dwLuminanceAlphaBitMask]));

    Move(lpDDPixFmt^, lpContext^, sizeof(DDPIXELFORMAT) );
    result:=D3DENUMRET_CANCEL;
    exit;
  end;

  result:=D3DENUMRET_OK;
end;

//ステンシルバッファの列挙コールバック
function EnumStencilBufFormatCallBack(lpDDPixFmt: LPDDPIXELFORMAT; lpContext: Pointer): HRESULT; stdcall;
begin

  if  lpDDPixFmt^.dwFlags = DDPF_ZBUFFER Or DDPF_STENCILBUFFER then begin
    with lpDDPixFmt^ do
      PutTestMessage(Format('列挙されたステンシルバッファのフォーマット...ZDepth=%d SDepth=%d Mask=(Z:%.8x S:%.8x L:%.8x)',
        [dwZBufferBitDepth,dwStencilBitDepth,dwZBitMask,dwStencilBitMask,dwLuminanceAlphaBitMask]));

    Move(lpDDPixFmt^, lpContext^, sizeof(DDPIXELFORMAT) );
    result:=D3DENUMRET_CANCEL;
    exit;
  end;

  result:=D3DENUMRET_OK;
end;


//フルスクリーンで初期化
procedure TDDDD.FullScreenMode(width,height,depth,freq:DWord; DDDriverName:String);
begin
  SetDisplayMode(True, width,height,depth, freq, DDDriverName);
end;

//ウィンドウモードで初期化
procedure TDDDD.WindowMode(width,height:DWord);
begin
  SetDisplayMode(False, width,height,FBitDepth, 0, '');
end;

procedure TDDDD.SetDisplayMode(fFull:Boolean; width,height,depth,freq:Integer;DDDriverName:String);
var
  ddsd:DDSURFACEDESC2;
  caps:DDSCAPS2;
  front,back:IDirectDrawSurface7;
  i,ret:Integer;
  fDeviceOK:Boolean;  //Direct3DDeviceが作れたか？
  tmpDC:HDC;
  drvCaps:DDCAPS;     //今使っているDirectDrawドライバの能力(HALについて)
  dmyCaps:DDCAPS;     //今使っているDirectDrawドライバの能力(HELについて)
  d3drm1:IDirect3DRM;
  ZBuf:IDirectDrawSurface7;

  pDeviceGUID:PGUID;

  //Zバッファとステンシルバッファの作成
  function CreateZBuffer(pDevGuid:PGUID; fVideo:Boolean):Boolean;
  var
    dwZCaps:DWORD;      //ZBuffer作成時のCaps
  begin

    result:=False;

    //もし、既にZバッファが作ってあるなら、それを解放
    if FZBuffer <> Nil then
      FZBuffer.Free;
    if ZBuf <> Nil then begin
      back.DeleteAttachedSurface(0, ZBuf);
      ZBuf.Release;
    end;

    ZBuf:=Nil;
    FZBuffer:=Nil;

    // なるべくBackBufferと同じ場所に置こうとする。
    // ただし、HALを使いたくない場合は、システムメモリに置く
    ZeroMemory(@caps,sizeof(caps));
    back.GetCaps(@caps);

    if fVideo then
      dwZCaps := DDSCAPS_ZBUFFER
    else
      dwZCaps := DDSCAPS_ZBUFFER + DDSCAPS_SYSTEMMEMORY;

    with ddsd do begin
      ZeroMemory(@ddsd, SizeOf(ddsd));
      dwSize := SizeOf(ddsd);
      dwFlags:= DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT Or DDSD_PIXELFORMAT;
      dwWidth:=width;
      dwHeight:=height;
      //dwZBufferBitDepth:=16;
      ddsCaps.dwCaps:=dwZCaps;
    end;

    //Zバッファの列挙、使用中のD3DDeviceで ＆ アタッチ
    if MakeStencilBuffer in D3DOptions then begin
      FD3D.EnumZBufferFormats(pDevGUID, Pointer(@EnumStencilBufFormatCallBack), @(ddsd.ddpfPixelFormat));

      if FDDraw.CreateSurface(@ddsd, ZBuf, nil) <> DD_OK then begin
        PutTestMessage('ステンシルバッファの作成に失敗しました');
        Exit;
      end;

      //バックバッファにアタッチしてZバッファの作成完了!
      if back.AddAttachedSurface(ZBuf) <> DD_OK then begin
        PutTestMessage('ステンシルバッファのアタッチに失敗しました');
        Exit;
      end;
      FZBuffer:=TDDDDGenSurface.Create(Self,ZBuf,width,height);

      PutTestMessage('ステンシルバッファを作成しました');
    end else if MakeZBuffer in D3DOptions then begin

      FD3D.EnumZBufferFormats(pDevGUID, Pointer(@EnumZBufFormatCallBack), @(ddsd.ddpfPixelFormat));
      if FDDraw.CreateSurface(@ddsd, ZBuf, nil) <> DD_OK then begin
        PutTestMessage('Zバッファの作成に失敗しました');
        Exit;
      end;

      //バックバッファにアタッチしてZバッファの作成完了!
      if back.AddAttachedSurface(ZBuf) <> DD_OK then begin
        PutTestMessage('Zバッファのアタッチに失敗しました');
        Exit;
      end;
      FZBuffer:=TDDDDGenSurface.Create(Self,ZBuf,width,height);

      PutTestMessage('Zバッファを作成しました');
    end;

    result:=True;
  end;

begin

  PutTestMessage(Format('スクリーンモード%d x %d x %d として初期化を開始します',[width,height,depth]));

  //全画面モードの場合、フォームを表示していないと、DisplayModeを切り替えられない
  if (fFull) then
    TForm(Owner).Show;

  FSuppressRestore:=True;   //解像度の変更が終わるまではOnRestoreイベントハンドラを呼ばないようにする

  //クリーンナップイベントを呼ぶ→各DirectDraw関連オブジェクトを解放
  ReleaseAll;

  //ここでなら、Form.BorderStyleの変更が可能なの
  // …でもDirectInputとかの事も考えるとやっぱりダメなの
  //if Assigned(FOnBorderStyleCanChange) then
  //  FOnBorderStyleCanChange(Self, ffull,width,height,depth,freq,DDDriverName);

  //もし、Formが作り直されているようなら、再度WindowProcedureをフック
  if FOwnerHWnd <> TForm(Owner).Handle then begin
    FOwnerHWnd:=TForm(Owner).Handle;
    FOwnerWndProc:=Pointer(SetWindowLong(FOwnerHWnd, GWL_WNDPROC, Longint(FNewProc)));
  end;

  //フックしたウィンドウプロシジャの復元
  {
  if not FAtFirst then begin
    SetWindowLong(FOwnerHWnd, GWL_WNDPROC, Longint(FOwnerWndProc));
    FreeObjectInstance(FNewProc);

    //ここでなら、Form.BorderStyleの変更が可能なの
    if Assigned(FOnBorderStyleCanChange) then
      FOnBorderStyleCanChange(Self);

    //ウィンドウプロシジャをもう一回フック
    FOwnerHWnd:=TForm(Owner).Handle;
    FNewProc:=MakeObjectInstance(WndProc);
    FOwnerWndProc:=Pointer(SetWindowLong(FOwnerHWnd, GWL_WNDPROC, Longint(FNewProc)));
  end;
  }

  //DirectDrawオブジェクトの生成


  if fFull then begin
    PutTestMessage('フルスクリーンで初期化を開始します');

    //フルスクリーンなら、ドライバを変更できる
    if DDDriverName <> '' then begin
      //指定があるなら、そのドライバを使う。
      PutTestMessage('指定されたドライバ ' + DDDriverName + ' を使用します');
      FDDraw:=CreateDirectDrawByName(DDDriverName);
      if FDDraw = Nil then begin
        PutTestMessage('指定されたドライバが見つからなかったので、デフォルトのドライバを使用します');
        TRYDD(DirectDrawCreateEx(Nil, Pointer(FDDraw), IID_IDirectDraw7, Nil),'DirectDrawオブジェクトが作成できません');
        PutTestMessage('DirectDrawオブジェクトを作成しました');
      end;
    end else begin
      //指定が無い場合…
      PutTestMessage('デフォルトのドライバを使用します');

      if Use3D then begin
        //指定が無いなら、Direct3D HALがOKなドライバを探す
        DirectDrawEnumerate(Pointer(@FindDirectDrawDriver),FDDraw);
        if FDDraw = Nil then begin
          TRYDD(DirectDrawCreateEx(Nil, Pointer(FDDraw), IID_IDirectDraw7, Nil),'DirectDrawオブジェクトが作成できません');
          PutTestMessage('DirectDrawオブジェクトを作成しました');
        end;
      end else begin
        //とりあえずデフォルトって事で
        TRYDD(DirectDrawCreateEx(Nil, Pointer(FDDraw), IID_IDirectDraw7, Nil),'DirectDrawオブジェクトが作成できません');
        PutTestMessage('DirectDrawオブジェクトを作成しました');
      end;
    end;
  end else begin
    PutTestMessage('ウィンドウモードで初期化を開始します');

    //フルスクリーンじゃないなら、おとなしくデフォルトのドライバ
    TRYDD(DirectDrawCreateEx(Nil, Pointer(FDDraw), IID_IDirectDraw7, Nil),'DirectDrawオブジェクトが作成できません');
    PutTestMessage('DirectDrawオブジェクトを作成しました');
  end;


  {
  //DirectDrawドライバはデフォルトドライバを使用
  //必要なら、なるべくDirect3D HALがOKなDirectドライバを探す
  if (Use3D) then begin
    if not FindDirectDrawDriver(FDDDriverList) then
      TRYDD(DirectDrawCreate(Nil, FDDraw1,Nil),'DirectDrawオブジェクトが作成できません');
  end else begin
    TRYDD(DirectDrawCreate(Nil, FDDraw1,Nil),'DirectDrawオブジェクトが作成できません');
  end;
  }

  //TRYDD(FDDraw1.SetCooperativeLevel(FOwnerHWnd,DDSCL_NORMAL),'DirectDraw1オブジェクトの協調レベルの設定に失敗しました');
  //TRYDD(FDDraw.QueryInterface(IID_IDirectDraw2, FDDraw),'DirectDrawオブジェクトとDirectDraw2オブジェクトの連結に失敗しました');
  //FDDraw1.Release;
  //FDDraw1:=Nil;

  //能力の診断…果たしてDirect3DHALは使えるの？
  ZeroMemory(@drvCaps,sizeof(DDCAPS));
  ZeroMemory(@dmyCaps,sizeof(DDCAPS));
  drvCaps.dwSize:=sizeof(DDCAPS);
  dmyCaps.dwSize:=sizeof(DDCAPS);
  FDDraw.GetCaps(@drvCaps,@dmyCaps);

  PutTestMessage('Caps:' + IntToHex(drvCaps.dwCaps,16));

  //画面モードの変更処理
	if (fFull) then begin

    //フォームを画面左上に持って行く
    TForm(Owner).BoundsRect:=Rect(0,0,width,height);

    //DirectDrawの初期化
		TRYDD(DDraw.SetCooperativeLevel(
        FOwnerHWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT Or DDSCL_ALLOWMODEX{ Or DDSCL_FPUPRESERVE})
        ,'協調レベルの設定に失敗しました');

		TRYDD(DDraw.SetDisplayMode(width,height,depth,freq,0),Format('画面モード%dx%dx%dの初期化に失敗しました',[width,height,depth]));

    FCanUseHAL := ((drvCaps.dwCaps And DDCAPS_3D) <> 0) And (BitDepth > 8);

		//表バッファの初期化
		ZeroMemory(@ddsd, sizeof(ddsd));
		ddsd.dwSize := sizeof(ddsd);
		ddsd.dwFlags := DDSD_CAPS Or DDSD_BACKBUFFERCOUNT;
		ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX;
    if FUse3D then
  		ddsd.ddsCaps.dwCaps := ddsd.ddsCaps.dwCaps Or DDSCAPS_3DDEVICE;

		ddsd.dwBackBufferCount := 1;
		TRYDD(DDraw.CreateSurface(@ddsd, front, Nil),'プライマリ・サーフェスの作成に失敗しました');

		//裏バッファの初期化
    ZeroMemory(@caps,sizeof(caps));
		caps.dwCaps := DDSCAPS_BACKBUFFER;
		TRYDD(front.GetAttachedSurface(@caps, back),'バックバッファの作成に失敗しました');

    //サイズを変更し・全面に持ってくる
    TForm(Owner).Width:=Screen.Width;
    TForm(Owner).Height:=Screen.Height;
    //SetForeGroundWindow(FOwnerHWnd);
    BringWindowToTop(FOwnerHWnd);

    TRYDD(FDDraw.CreateClipper(0, FClipper,Nil),'Clipperオブジェクトの作成に失敗しました');
    TRYDD(FClipper.SetHWnd(0,FOwnerHWnd),'Clipperのフォームへの割り当てに失敗しました');
    TRYDD(front.SetClipper(FClipper),'Clipperのプライマリサーフェスへの割り当てに失敗しました');

	end else begin
		TRYDD(DDraw.SetCooperativeLevel(FOwnerHWnd, DDSCL_NORMAL{ Or DDSCL_FPUPRESERVE}),'協調レベルの設定に失敗しました');
    FCanUseHAL := ((drvCaps.dwCaps And DDCAPS_3D) <> 0) And (BitDepth > 8);

		//表バッファの初期化
		ZeroMemory(@ddsd, sizeof(ddsd));
		ddsd.dwSize := sizeof(ddsd);
		ddsd.dwFlags := DDSD_CAPS;
		ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
  	TRYDD(DDraw.CreateSurface(@ddsd, front, Nil),'プライマリ・サーフェスの作成に失敗しました');

		//裏バッファの作成
		ZeroMemory(@ddsd, sizeof(ddsd));
		ddsd.dwSize := sizeof(ddsd);
		ddsd.dwFlags := DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT;

    if FUse3D then begin
      Case FBackBufferLocationAtWindowed of
        bmtDefault, bmtCompatible: begin
          if ((DontUseHAL in FD3DOptions) And (DontUseTnLHAL in FD3DOptions)) Or (not FCanUseHAL) then
            ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_3DDEVICE Or DDSCAPS_SYSTEMMEMORY //HAL使わない
          else
            ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_3DDEVICE Or DDSCAPS_VIDEOMEMORY; //HAL使いたい
        end;
        bmtSystemMemory:       ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_3DDEVICE Or DDSCAPS_SYSTEMMEMORY;
        bmtVideoMemory:        ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_3DDEVICE Or DDSCAPS_VIDEOMEMORY;
      end;
    end else begin
      //Direct3Dを使わないとき
      Case FBackBufferLocationAtWindowed of
        bmtDefault,bmtVideoMemory:      ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY;
        bmtSystemMemory,bmtCompatible:  ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY;
      end;
    end;

		ddsd.dwWidth := width;
		ddsd.dwHeight := height;

    //一応、ddsdに沿って作ってみて、ダメならVIDEOMEMORYフラグを取り除いてもう一度
    if DDraw.CreateSurface(@ddsd, back, Nil) <> DD_OK then begin
      ddsd.ddsCaps.dwCaps := ddsd.ddsCaps.dwCaps And (not DDSCAPS_VIDEOMEMORY);
      TRYDD(DDraw.CreateSurface(@ddsd, back, Nil),'バックバッファの作成に失敗しました');
    end;

    //報告〜
    if ddsd.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY <> 0 then
      if ddsd.ddsCaps.dwCaps And DDSCAPS_NONLOCALVIDMEM <> 0 then
        PutTestMessage('バックバッファをノンローカルビデオメモリに配置します')
      else
        PutTestMessage('バックバッファをビデオメモリに配置します')
    else if ddsd.ddsCaps.dwCaps And DDSCAPS_SYSTEMMEMORY  <> 0 then
      PutTestMessage('バックバッファをシステムメモリに配置します')
    else
      PutTestMessage('バックバッファをドライバのデフォルトの位置(おそらくビデオメモリ)に配置します');

		//色数を現在の画面の色数に合わせる
		//tmp = CreateIC("Display",NULL,NULL,NULL);
		//depth = GetDeviceCaps(tmp,BITSPIXEL);
		//DeleteDC(tmp);

    //クライアント領域のサイズを変更
    {
    TForm(Owner).ClientHeight:=height;
    TForm(Owner).ClientWidth:=width;
    }

    //クリッパーの生成とウィンドウへの割付
    //if not AllowRakugaki then begin
    TRYDD(FDDraw.CreateClipper(0, FClipper,Nil),'Clipperオブジェクトの作成に失敗しました');
    TRYDD(FClipper.SetHWnd(0,FOwnerHWnd),'Clipperのフォームへの割り当てに失敗しました');
    TRYDD(front.SetClipper(FClipper),'Clipperのプライマリサーフェスへの割り当てに失敗しました');
    //end;
  end;



  (*** 各プロパティの変更 ***)
 	FBitDepth := BitDepth;
  FFullScreen := fFull;
  FFreq := freq;
  FScrWidth:=width;
  FScrHeight:=height;

  if Assigned(FFrontBuffer) then
    FFrontBuffer.Free;
  if Assigned(FBackBuffer) then
    FBackBuffer.Free;

  FFrontBuffer:=TDDDDGenSurface.Create(Self, front, width, height);
  FBackBuffer :=TDDDDGenSurface.Create(Self, back, width, height);




	(*** パレットの生成 ***)
	if (DDPalette<>Nil) then begin
		DDPalette.Release;
		DDPalette:=Nil;
  end;

  //パレットエントリ初期化
  // Direct3Dを使う場合、パレットエントリを勝手に書き換えちゃダメ
  if FUse3D then begin
    if fFull then begin
      //全画面モードでは、パレットエントリを適当に設定
      for i:=0 to 255 do begin
        Palette[i].peRed   := i Shr 5 And 7 * 255 div 7;
        Palette[i].peGreen := i Shr 2 And 7 * 255 div 7;
        Palette[i].peBlue  := i       And 3 * 255 div 3;
        Palette[i].peFlags := D3DPAL_READONLY;
      end;
    end else begin
      //ウィンドウモードでは、現在のパレットを使う
      tmpDC:=GetDC(0);
      GetSystemPaletteEntries(tmpDC,0,256,Palette);
      ReleaseDC(0,tmpDC);
      for i:=0 to 9 do
        Palette[i].peFlags:=D3DPAL_READONLY;
      for i:=10 to 245 do
        Palette[i].peFlags:=D3DPAL_FREE Or PC_RESERVED;
      for i:=246 to 255 do
        Palette[i].peFlags:=D3DPAL_READONLY;
    end;
  end else begin
    //フラグ以外は書き換えない
    for i:=0 to 255 do begin
      //Palette[i].peBlue  := 0;
      //Palette[i].peGreen := 0;
      //Palette[i].peRed   := 0;
      Palette[i].peFlags := PC_NOCOLLAPSE;
    end;
  end;

	if (BitDepth=8) then begin
  	TRYDD(DDraw.CreatePalette(DDPCAPS_8BIT, Pointer(@Palette), DDPalette, Nil),'DirectDrawPaletteの作成に失敗しました');
    TRYDD(front.SetPalette(DDPalette),'DirectDrawPaletteのFrontBufferへの割り当てに失敗しました');
    //if not FFullScreen then
    TRYDD(back.SetPalette(DDPalette),'DirectDrawPaletteのBackBufferへの割り当てに失敗しました');
  end;



  (*** Direct3Dの初期化 ***)

  //Direct3Dの初期化開始
  if FUse3D then begin
    fDeviceOK:=False;

    //Direct3Dオブジェクトの作成
    if Use3D then
      TRYDD(FDDraw.QueryInterface(IID_IDirect3D7,FD3D),'Direct3Dオブジェクトの作成に失敗しました');

    //Direct3DRMの作成(アプリ終了までD3DRMオブジェクトは存在しつづける)
    if FD3DRM = Nil then begin
      TRYDD(Direct3DRMCreate(d3drm1),'Direct3DRMオブジェクトの作成に失敗しました');
      TRYDD(d3drm1.QueryInterface(IID_IDirect3DRM3,FD3DRM),'Direct3DRM3オブジェクトの作成に失敗しました');
      d3drm1.Release;
    end;


    //Direct3Dデバイスを列挙して、TnLHAL, MMX, RGB, RAMPのうちどれが使用可能かをチェック
    FValidD3DDeviceType:=[];
    FD3D.EnumDevices(Pointer(@EnumD3DDeviceCallBack),Self);


    //TnLHAL->HAL->MMX->RGB->Rampの順に作ってみるテスト
    pDeviceGUID:=Nil;
    FHALEnabled:=False;
    ZBuf:=Nil;

    if (not (DontUseTnLHAL in FD3DOptions)) And (not fDeviceOK) And (FCanUseHAL) then begin
      //if (FD3D.CreateDevice(IID_IDirect3DHALDevice, back, FD3DDevice)=DD_OK) then begin

      if CreateZBuffer(@IID_IDirect3DTnLHALDevice, True) then begin
        ret:=FD3D.CreateDevice(@IID_IDirect3DTnLHALDevice, back, FD3DDevice);
        if ret = DD_OK then begin
            FD3DDeviceType:=dtTnLHAL;
            fDeviceOK:=True;
            PutTestMessage('T&L HALデバイスを使用します');
            pDeviceGUID:=@IID_IDirect3DTnLHALDevice;
            FHALEnabled:=True;
        end else begin
          PutTestMessage('T&L HALデバイスが作れません' + IntToHex(ret,16))
        end;
      end else begin
        PutTestMessage('T&L HALデバイス用Zバッファが作れません')
      end;
    end;

    if (not (DontUseHAL in FD3DOptions)) And (not fDeviceOK) And (FCanUseHAL) then begin
      //if (FD3D.CreateDevice(IID_IDirect3DHALDevice, back, FD3DDevice)=DD_OK) then begin

      if CreateZBuffer(@IID_IDirect3DHALDevice, True) then begin
        ret:=FD3D.CreateDevice(@IID_IDirect3DHALDevice, back, FD3DDevice);
        if ret = DD_OK then begin
            FD3DDeviceType:=dtHAL;
            fDeviceOK:=True;
            PutTestMessage('HALデバイスを使用します');
            pDeviceGUID:=@IID_IDirect3DHALDevice;
            FHALEnabled:=True;
        end else begin
          PutTestMessage('HALデバイスが作れません' + IntToHex(ret,16))
        end;
      end else begin
        PutTestMessage('HALデバイス用Zバッファが作れません')
      end;
    end;


    if (not (DontUseMMX in FD3DOptions)) And (not fDeviceOK) then begin
      if CreateZBuffer(@IID_IDirect3DMMXDevice, False) then begin
        if (FD3D.CreateDevice(@IID_IDirect3DMMXDevice, back, FD3DDevice)=DD_OK) then begin
          FD3DDeviceType:=dtMMX;
          fDeviceOK:=True;
          PutTestMessage('MMXエミュレーションデバイスを使用します');
          pDeviceGUID:=@IID_IDirect3DMMXDevice;
        end;
      end;
    end;

    if (not (DontUseRGBEmulation in FD3DOptions)) And (not fDeviceOK) then begin
      if CreateZBuffer(@IID_IDirect3DRGBDevice, False) then begin
        if (FD3D.CreateDevice(@IID_IDirect3DRGBDevice, back, FD3DDevice)=DD_OK) then begin
          FD3DDeviceType:=dtRGB;
          fDeviceOK:=True;
          PutTestMessage('RGBエミュレーションデバイスを使用します');
          pDeviceGUID:=@IID_IDirect3DRGBDevice;
        end;
      end;
    end;

    if (not fDeviceOK) then begin
      if CreateZBuffer(@IID_IDirect3DRampDevice, False) then begin
        if (FD3D.CreateDevice(@IID_IDirect3DRampDevice, back, FD3DDevice)=DD_OK) then begin
          FD3DDeviceType:=dtRamp;
          fDeviceOK:=True;
          PutTestMessage('Rampエミュレーションデバイスを使用します');
          pDeviceGUID:=@IID_IDirect3DRampDevice;
        end;
      end;
    end;

    if (not fDeviceOK) then begin
      if CreateZBuffer(@IID_IDirect3DRefDevice, False) then begin
        if (FD3D.CreateDevice(@IID_IDirect3DRefDevice, back, FD3DDevice)=DD_OK) then begin
          FD3DDeviceType:=dtRef;
          //fDeviceOK:=True;
          PutTestMessage('リファレンスラスタライザを使用します');
          pDeviceGUID:=@IID_IDirect3DRefDevice;
        end;
      end;
    end;






    (* Direct3DRMDeviceの作成 *)

    if (fFull = False) And (FD3DDeviceType <> dtTnLHAL) then begin
      TRYDD(FD3DRM.CreateDeviceFromClipper(FClipper,pDeviceGUID,width,height, FD3DRMDevice),'Diret3DRMデバイスの作成に失敗しました');

      //FD3DRMDevice.SetBufferCount(2);
      if FEye<>Nil then begin
        TRYDD(FD3DRM.CreateViewport(FD3DRMDevice,FEye,0,0,FD3DRMDevice.GetWidth,FD3DRMDevice.GetHeight,FViewport),'Viewportの作成に失敗しました');
        ViewPort.SetBack(5000);
      end;
    end;

    //HALが使えたかチェック
    {
    ZeroMemory(@ddsd,sizeof(ddsd));
    ddsd.dwSize:=sizeof(ddsd);
    ZBuf.GetSurfaceDesc(@ddsd);
    FHALEnabled:= (ddsd.ddsCaps.dwCaps And DDSCAPS_VIDEOMEMORY) <> 0;
    }

    if HALEnabled then
      PutTestMessage('ハードウェアアクセラレーション可')
    else
      PutTestMessage('ハードウェアアクセラレーション不可');

  end;

  //ClipRect:=Rect(0,0,width, height);

  FSuppressRestore:=False;

  if (not FAtFirst) And FAfterInit then begin
    //保存されているサーフェスの再生成
    RecoverSurfaces;

    if Assigned(FOnChangeDisplayMode) then begin
      //イベント呼ぶ
      FOnChangeDisplayMode(Self);
      //FOnRestore(Self);
    end;
  end;



end;



//スクリーンモードの列挙のための、コールバック関数
type
TDDSDArray = Array[0..$FFFF] of DDSURFACEDESC2;
PDDSDArray = ^TDDSDArray;

var
gEnumCount:Integer;
gMaxEnumCount:Integer;

function EnumCallBack(lpddsd:LPDDSURFACEDESC2;lpContext: Pointer ):HRESULT; stdcall;
var
  ddsd:DDSURFACEDESC2;
  dest:PDDSDArray;
begin
  Move(lpddsd^,ddsd,sizeof(ddsd));

  dest:=lpContext;
  dest[gEnumCount]:=ddsd;
	Inc(gEnumCount);
	if (gEnumCount = gMaxEnumCount) then begin
    result:=DDENUMRET_CANCEL;
    exit;
  end;
	result:=DDENUMRET_OK;
end;

//画面モードの列挙
function TDDDD.EnumDisplayModes(dwFlags:DWORD; const rule:DDSURFACEDESC2; var ddsds:Array of DDSURFACEDESC2):Integer;
begin
	gEnumCount:=0;
	gMaxEnumCount:=High(ddsds)+1;
	DDraw.EnumDisplayModes(0,@rule,Pointer(@ddsds),Pointer(@EnumCallBack));
  result:=gEnumCount;
end;

procedure TDDDD.ReadPalette(fname:String);
var
  bfh:TBitmapFileHeader;
  bmi:TBitmapInfoHeader;
  fs:TFileStream;
  i,num:Integer;
  quad:TRGBQuad;
begin
  try
    fs:=TFileStream.Create(fname,fmOpenRead);
  except
    PutDebugMessage(fname+'が見つかりません');
    Exit;
  end;

  try
    fs.Read(bfh,sizeof(bfh));
    if bfh.bfType <> ((Ord('M') shl 8 ) + Ord('B')) then begin
      if DDDD_HaltOnError then
        Halt
      else begin
        EDDDD:=ExDDDD.Create('不正なビットマップです');
        raise EDDDD;
      end;
    end;

    fs.Read(bmi,sizeof(bmi));
    num:=bmi.biClrUsed;
    if num=0 then
      num:=256;

    for i:=0 to num-1 do begin
      fs.Read(quad,4);
      Palette[i].peBlue  := quad.rgbBlue;
      Palette[i].peGreen := quad.rgbGreen;
      Palette[i].peRed   := quad.rgbRed;
      Palette[i].peFlags := PC_NOCOLLAPSE;
    end;
  finally
    fs.Free;
  end;
end;

//QDAファイルに入ったBMPファイルから、パレットを読む
procedure TDDDD.ReadPaletteFromQDA(qdaName:String; bmpID:String);
var
  bfh:TBitmapFileHeader;
  bmi:TBitmapInfoHeader;
  ms:TMemoryStream;
  i,num:Integer;
  quad:TRGBQuad;
begin
  try
    ms:=ExtractFromQDAFile(qdaName,bmpID);
  except
    PutDebugMessage(qdaName + 'からの' + bmpID + 'の抽出に失敗しました');
    Exit;
  end;

  try
    ms.Read(bfh,sizeof(bfh));
    if bfh.bfType <> ((Ord('M') shl 8 ) + Ord('B')) then begin
      if DDDD_HaltOnError then
        Halt
      else begin
        EDDDD:=ExDDDD.Create('不正なビットマップです');
        raise EDDDD;
      end;
    end;

    ms.Read(bmi,sizeof(bmi));
    num:=bmi.biClrUsed;
    if num=0 then
      num:=256;

    for i:=0 to num-1 do begin
      ms.Read(quad,4);
      Palette[i].peBlue  := quad.rgbBlue;
      Palette[i].peGreen := quad.rgbGreen;
      Palette[i].peRed   := quad.rgbRed;
      Palette[i].peFlags := PC_NOCOLLAPSE;
    end;
  finally
    ms.Free;
  end;
end;



/////////////パレットの実体化処理

{$HINTS OFF} //RealizePalette二連のところで、ヒントを出すので、抑止する。
procedure TDDDD.UpdatePalette;
var
  pal:TLogPal;
  procedure UpdatePaletteOnWindow; //Windowモードでの面倒なパレット更新
  var
    hPal:HPALETTE;
    hd:HDC;
    i:Integer;
    tmp:PLogPalette;
  begin
    pal.Version:=$300;
    pal.NumberOfEntries := 256;

    //システムパレットのクリア
    for i:=0 to 255 do begin
      with pal.aEntries[i] do begin
        peRed:=0;
        peGreen:=0;
        peBlue:=0;
        peFlags:=PC_NOCOLLAPSE;
      end;
    end;
    hd := GetDC(0);
    tmp:=Pointer(@pal);
    hPal := CreatePalette(tmp^);
    if (hPal<>0) then begin
      hPal := SelectPalette(hd,hPal,False);
      RealizePalette(hd);
      hPal := SelectPalette(hd,hPal,False);
      RealizePalette(hd);
    end;

    //パレットの設定
    GetSystemPaletteEntries(hd,0,256,pal.aEntries);
    ReleaseDC(0,hd);
    for i:=10 to 245 do
      pal.aEntries[i]:=Palette[i];
    hPal:=CreatePalette(tmp^);
    hd:=GetDC(FOwnerHWnd);
    SelectPalette(hd,hPal,False);
    RealizePalette(hd);
    ReleaseDC(FOwnerHWnd,hd);
  end;
begin
  if FBitDepth = 8 then begin
    if FFullScreen then
    	TRYDD(DDPalette.SetEntries(0, 0, 256,Pointer(@Palette)),'パレットが更新できませんでした')
    else //ウィンドウ内実行だと、パレットエントリーがずれる
    	//TRYDD(DDPalette.SetEntries(0,10, 236,@Palette),'パレットが更新できませんでした');
      UpdatePaletteOnWindow;
  end;
end;
{$HINTS ON}


procedure TDDDD.WaitVBlank;
begin
  DDraw.WaitForVerticalBlank(DDWAITVB_BLOCKBEGIN,0);
end;

procedure TDDDD.DoInit(Sender:TObject);
var
  fNeedChange:Boolean;
begin

  //まず表示させよう
  //TForm(Owner).Show;

  FOwnerHWnd:=TForm(Owner).Handle;

  //もしも、ウィンドウモードで初期化してて、色数に対してセンシティプならその旨チェック
  if AutoDisplayModeInitialize And (not InitializeFullScreen) And (InitialBitDepth <> 0) then begin
    if BitDepth <> InitialBitDepth then begin
      MessageDlg(Format('画面モードが不適切です。色数を %d ビットに設定して、起動しなおしてください。',[InitialBitDepth]),mtWarning, [mbOK], 0);
      Application.Terminate;
    end;
  end;

  //まず、現在の色数のウィンドウモードで適当にDirectDrawを初期化
  SetDisplayMode(False,128,128,BitDepth,0,'');


  //自動初期化用に、プロパティの値を参照する
  if AutoDisplayModeInitialize then begin
    FScrWidth:=InitialScreenWidth;
    FScrHeight:=InitialScreenHeight;
    FFullScreen:=InitializeFullScreen;
    FBitDepth:=InitialBitDepth;
  end;


  if FAtFirst then begin

    fNeedChange:=False;
    FAtFirst:=False;

    if FAutoDisplayModeInitialize then begin
      //全画面モードの場合、ビデオカードがサポートしているかチェック
      if FFullScreen then
        fNeedChange := not IsAvailableDisplaymode(FScrWidth,FScrHeight,FBitDepth,0);

      //サポートしているときだけ画面モードの初期化
      if not fNeedChange then
        SetDisplayMode(FFullScreen, FScrWidth,FScrHeight,FBitDepth,0,'');
    end else
      fNeedChange:=True;


    //フックしたイベントハンドラを呼ぶ
    if Assigned(FOwnerOnCreate) then
      FOwnerOnCreate(Owner);

    //「初期化ルーチンを呼んだ」フラグを立てる
    FAfterInit:=True;

    //初期化ルーチンへ飛ぶ
    if Assigned(FOnInit) then
      FOnInit(Sender,fNeedChange);


    //フォームのイベントハンドラをフック
    FNewProc:=MakeObjectInstance(WndProc);
    FOwnerWndProc:=Pointer(SetWindowLong(FOwnerHWnd, GWL_WNDPROC, Longint(FNewProc)));

  end;

end;

procedure TDDDD.DoRestore(Sender:TObject);
begin
  if TForm(Owner).Active then begin
    if Assigned(FOwnerOnPaint) then
      FOwnerOnPaint(Owner);
    if not FSuppressRestore then begin
      Self.Restore;
      UpdatePalette;
      if Assigned(FOnRestore) then
        FOnRestore(Self);
    end;
  end;
end;



function TDDDD.getVBlankStatus:BOOL;
var
  ret:BOOL;
begin
	DDraw.GetVerticalBlankStatus(@ret);
  result:=ret;
end;

procedure TDDDD.SetAutoDisplayModeInitialize(fVal:Boolean);
begin
  FAutoDisplayModeInitialize:=fVal;
end;


procedure TDDDD.DispMenu;
begin
  if FFullScreen then begin
    //ウィンドウを画面一杯に
    TForm(Owner).Top:=0;
    TForm(Owner).Left:=0;
    TForm(Owner).Width:=Screen.Width;
    TForm(Owner).Height:=Screen.Height;
  end;
  DDraw.FlipToGDISurface;
  DrawMenuBar(FOwnerHWnd);
  RedrawWindow(FOwnerHWnd, Nil, 0, RDW_FRAME);
end;

procedure TDDDD.HideMenu;
begin
  //今の所、何もしない(^^;)
end;

//イベントハンドラ
procedure TDDDD.WndProc(var msg:TMessage);
var
  mmi:PMINMAXINFO;
begin
  case msg.msg of
    WM_ENTERMENULOOP: begin
      DispMenu;
      if Assigned(FOnEnterMenuLoop) then
        FOnEnterMenuLoop(Self);
    end;
    WM_EXITMENULOOP: begin
      HideMenu;
      if Assigned(FOnExitMenuLoop) then
        FOnExitMenuLoop(Self);
    end;
    WM_MOVE: begin
      //フルスクリーン時は、常に左上隅にフォームを置く
      if FFullScreen then begin
        if msg.lParam<>0 then begin
          TForm(Owner).Left:=0;
          TForm(Owner).Top:=0;
        end;
      end;
    end;
    WM_GETMINMAXINFO: begin
      //フルスクリーンモードでは、サイズの変更を不可に
      if FFullScreen then begin
        mmi:=PMinMaxInfo(Pointer(msg.lParam));
        with mmi^ do begin
          ptMaxSize:=Point(Screen.Width,Screen.Height);
          ptMaxPosition:=Point(0,0);
          ptMinTrackSize:=Point(Screen.Width,Screen.Height);
          ptMaxTrackSize:=Point(Screen.Width,Screen.Height);
        end;
      end;
    end;
    WM_SIZE: begin
      //フルスクリーンモードでは、ウィンドウの最大化禁止
      if FFullScreen then begin
        if TForm(Owner).WindowState = wsMaximized then begin
          TForm(Owner).WindowState := wsNormal;
          TForm(Owner).Height:=Screen.Height;
          TForm(Owner).Width:=Screen.Width;
        end;
      end;
    end;
    WM_QUERYNEWPALETTE: begin
      //パレットの更新
      UpdatePalette;
    end;
  end;
  Msg.Result:=CallWindowProc(FOwnerWndProc, FOwnerHWnd, Msg.Msg, Msg.wParam, Msg.lParam);
  //PutTestMessage(Format('おーおー %.8x %.8x',[msg.msg,msg.Result]));
end;

function  TDDDD.GetClipping:Boolean;
begin
  result:=FBackBuffer.Clipping;
end;

procedure TDDDD.SetClipping(v:Boolean);
begin
  FBackBuffer.Clipping:=v;
end;

function  TDDDD.GetClipRect:TRect;
begin
  result:=FBackBuffer.ClipRect;
end;

procedure TDDDD.SetClipRect(const r:TRect);
begin
  FBackBuffer.ClipRect:=r;
end;

procedure TDDDD.setDisableScreenSaver(v:Boolean);
begin
  FDisableScreenSaver:=v;
  if v then
    SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,0,Nil,SPIF_SENDWININICHANGE)
  else
    SystemParametersInfo(SPI_SETSCREENSAVEACTIVE,1,Nil,SPIF_SENDWININICHANGE)
end;


procedure TDDDD.Update3D(FrScene:IDirect3DRMFrame3);
begin
  asm
    FInit;
  end;
  //FViewPort.Clear(;
  if FrScene<>Nil then
    FViewPort.Render(FrScene);
  FD3DRMDevice.Update;
  asm
    Finit;
  end;
end;

function  TDDDD.getEye:IDirect3DRMFrame3;
begin
  if Assigned(FViewPort) then begin
    FViewPort.getCamera(IDirect3DRMFrame3(FEye));
    result:=FEye;
  end else
    result:=Nil;
end;

procedure TDDDD.setEye(v:IDirect3DRMFrame3);
begin
  FEye:=v;
  if Assigned(FViewPort) then
    FViewPort.SetCamera(v)
  else begin
    TRYDD(FD3DRM.CreateViewport(FD3DRMDevice,v,0,0,FD3DRMDevice.GetWidth,FD3DRMDevice.GetHeight,FViewport),'Viewportの作成に失敗しました');
    ViewPort.SetBack(5000);
  end;
end;


//ある解像度がサポートされているかチェックする
function  TDDDD.isAvailableDisplayMode(x,y,depth,freq:DWord):Boolean;
var
  rule:DDSURFACEDESC2;
  descs:Array[0..255] of DDSURFACEDESC2; //とりあえず、周波数込みでも256個も画面モードを持ってるカードは無いでしょ
  i,nModes:Integer;
begin
  //とりあえず、無条件に全部列挙
  ZeroMemory(@rule,SizeOf(rule));
  rule.dwSize:=SizeOf(rule);

  nModes:=EnumDisplayModes(DDEDM_REFRESHRATES,rule,descs);

  if nModes > 256 then
    nModes:=256;

  for i:=0 to nModes-1 do begin
    with descs[i] do begin
      if ((dwWidth=x) Or (x=0)) And ((dwHeight=y) Or (y=0)) And ((ddpfPixelFormat.dwRGBBitCount=depth) Or (depth=0)) And ((dwRefreshRate=freq) Or (freq=0)) then begin
        result:=True;
        Exit;
      end;
    end;
  end;
  result:=False;
end;


//サーフェスのKeepメソッド内部で呼び出す
procedure TDDDD.KeepSurface(Sender:TDDDDSurface);
var
  i:Integer;
  newKeeper:TDDDDSUrfaceKeeper;
begin

  //重複したオブジェクトがないか、検査
  For i:=0 to SurfaceKeepList.Count-1 do begin
    if TDDDDSurfaceKeeper(SurfaceKeepList.Items[i]).FTarget = Sender then begin
      TDDDDSurfaceKeeper(SurfaceKeepList.Items[i]).Free;
      SurfaceKeepList.Delete(i);
      Break;
    end;
  end;

  //保存
  newKeeper:=TDDDDSurfaceKeeper.Create(Self, Sender);
  newKeeper.FID:=NSurfaceCreated;
  SurfaceKeepList.Add(newKeeper);

  Inc(NSurfaceCreated);

  //保存したことをデバッグレポートに表示
  PutTestMessage(Format('サーフェス ID:%dを追加しました',[newKeeper.FID]));
end;


//サーフェスのデストラクタで呼び出す
procedure TDDDD.SurfaceDestroyed(Sender:TDDDDSurface);
var
  i:Integer;
begin

  For i:=0 to SurfaceKeepList.Count-1 do begin
    if TDDDDSurfaceKeeper(SurfaceKeepList.Items[i]).FTarget = Sender then begin
      //解放したことをデバッグレポートに表示
      PutTestMessage(Format('サーフェス、ID:%dを解放します',[TDDDDSurfaceKeeper(SurfaceKeepList.Items[i]).FID]));

      Sender.FSurf:=Nil;
      TDDDDSurfaceKeeper(SurfaceKeepList.Items[i]).Free;
      SurfaceKeepList.Delete(i);
      Break;
    end;
  end;

end;


//テクスチャのコンストラクタで呼び出す
procedure TDDDD.KeepTexture(Sender:TDDDDTexture);
var
  i:Integer;
  newKeeper:TDDDDTextureKeeper;
begin

  //重複したオブジェクトがないか、検査
  For i:=0 to TextureKeepList.Count-1 do begin
    if TDDDDTextureKeeper(TextureKeepList.Items[i]).FTarget = Sender then begin
      Sender.FSurf:=Nil;
      TDDDDTextureKeeper(TextureKeepList.Items[i]).Free;
      TextureKeepList.Delete(i);
      Break;
    end;
  end;

  //保存
  newKeeper:=TDDDDTextureKeeper.Create(Self, Sender);
  newKeeper.FID:=NTextureCreated;
  TextureKeepList.Add(newKeeper);

  Inc(NTextureCreated);

  //保存したことをデバッグレポートに表示
  PutTestMessage(Format('テクスチャリスト ID:%dを追加しました',[newKeeper.FID]));
end;


//テクスチャのデストラクタで呼び出す
procedure TDDDD.TextureDestroyed(Sender:TDDDDTexture);
var
  i:Integer;
begin

  For i:=0 to TextureKeepList.Count-1 do begin
    if TDDDDTextureKeeper(TextureKeepList.Items[i]).FTarget = Sender then begin
      //解放したことをデバッグレポートに表示
      PutTestMessage(Format('テクスチャ、ID:%dを解放します',[TDDDDTextureKeeper(TextureKeepList.Items[i]).FID]));

      TDDDDTextureKeeper(TextureKeepList.Items[i]).Free;
      TextureKeepList.Delete(i);

      Break;
    end;
  end;

end;


//保存されているサーフェスの復元
procedure TDDDD.RestoreSurfaces;
var
  i:Integer;
begin
  For i:=0 to SurfaceKeepList.Count-1 do begin
    TDDDDSurfaceKeeper(SurfaceKeepList.Items[i]).Restore;
  end;
  For i:=0 to TextureKeepList.Count-1 do begin
    TDDDDTextureKeeper(TextureKeepList.Items[i]).Restore;
  end;
end;


//保存されているサーフェスのクリーンナップ
procedure TDDDD.CleanUpSurfaces;
var
  i:Integer;
begin
  For i:=0 to TextureKeepList.Count-1 do begin
    TDDDDTextureKeeper(TextureKeepList.Items[i]).Release;
  end;
  For i:=0 to SurfaceKeepList.Count-1 do begin
    TDDDDSurfaceKeeper(SurfaceKeepList.Items[i]).Release;
  end;
end;

//保存されているサーフェスの再生成・復元
procedure TDDDD.RecoverSurfaces;
var
  i:Integer;
begin
  For i:=0 to TextureKeepList.Count-1 do begin
    TDDDDTextureKeeper(TextureKeepList.Items[i]).Recover;
  end;
  For i:=0 to SurfaceKeepList.Count-1 do begin
    TDDDDSurfaceKeeper(SurfaceKeepList.Items[i]).Recover;
  end;
end;










function TDDDD.PhysicalToTColor(dw: DWord): TColor;
begin
  result:=BackBuffer.PhysicalToTColor(dw);
end;

function TDDDD.ARGBToPhysical(a, r, g, b: BYTE): DWORD;
begin
  result:=BackBuffer.ARGBToPhysical(a,r,g,b);
end;

function TDDDD.TColorToPhysical(col: TColor): DWORD;
begin
  result:=BackBuffer.TColorToPhysical(col);
end;



//デバッグオプションの設定
procedure TDDDD.SetDebugOption(const Value: TDDDDDebugOption);
begin
  FDebugOption := Value;

  DDDD_HaltOnError := ddoHaltOnError in Value;
  DDDD_DetailedLog := ddoDetailedLog in Value;
  DDDD_DebugMessage := ddoDebugMessage in Value;
end;


end.
