// Ｑｕａｄｒｕｐｌｅ　Ｄ
// お便利ルーチン集
//
// MCMXCVII, MCMXCVIII, MCMXCIX  SANDMAN  presents!!
//
//
//

unit ddddut;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, DDDD,
  DDraw,StdCtrls,QDArc;


const
  DDBG_MAXCHIP = 1024;  //登録するＢＧ用チップの最大数
  DDBG_UNSEEN = $FFFF; // 非表示のBGを表すチップインデクス


type

//スプライトパターン(=シェイプ)管理用
TDDDDSprShape = record
  Surf :TDDDDGenSurface; //サーフェス
  R    :TRect;    //サーフェス上での位置
end;

TDDDDSprShapeArray = array[0..$FFFFFF] of TDDDDSprShape;
PDDDDSprShapeArray = ^TDDDDSprShapeArray;


//表示情報管理用
TDDDDSprReg = class
  private
    Xm,Xs:Integer;   //X方向の拡大・縮小率
    Ym,Ys:Integer;   //X方向の拡大・縮小率
    ZoomX,ZoomY:Boolean;    //拡大・縮小処理の要・不要
    Owner:TObject;
    function  getWidth:Integer;
    procedure setWidth(val:Integer);
    function  getHeight:Integer;
    procedure setHeight(val:Integer);
    function getPos:TPoint;
    procedure setPos(const val:TPoint);
  public
    IShape:Integer;  //シェイプ番号
    IAnim:Integer;   //アニメ用、実際の表示のときは、IShape+IAnim番のパターンが表示される
    MaxAnim:Integer; //アニメ番号の最大値
    MinAnim:Integer; //アニメ番号の最小値
    X,Y:Integer;     //表示位置
    Z:Integer;       //手前がゼロ、一番奥がTDDDDSprite.ZMax。
    Alpha:Integer;   //α値
    AddMode:Boolean; //加算合成の是非
    Visible:Boolean; //表示・非表示フラグ
    RewindAnim:Boolean;  //Trueでアニメが反復運動になる
    RewindFlag:Boolean;  //現在巻き戻し中かどうか
    property Width:Integer read getWidth write setWidth;
    property Height:Integer read getHeight write setHeight;
    property Pos:TPoint read getPos write setPos;
    procedure ResetSize;  //Zoomをしなくする。
    procedure Show;
    procedure Hide;
    procedure NextFrame;  //アニメ関係
    procedure PrevFrame;
    constructor Create(AOwner:TObject);
end;

TDDDDSprRegArray = array[0..$FFFFFF] of TDDDDSprReg;
PDDDDSprRegArray = ^TDDDDSprRegArray;


//BGチップ管理用
TDDDDBGChip = record
  Surf :TDDDDGenSurface;   //サーフェス
  R    :TRect;     //サーフェス上での位置
  useCk:Boolean;   //透過コピーするか
end;


//統合
TDDDDSprite = class
  private
    FShapes:PDDDDSprShapeArray;
    FRegs:PDDDDSprRegArray;
    FNormalFx:DDBLTFX;  //計算の便宜を図るための定数
    FAlphaFx:DDBLTFX;
    FNumSpr:Integer;    //スプライトの数
    FNumShape:Integer;  //スプライトシェイプの数
    FSortBuf:PInteger;    //Zソートバッファ
    FSortCount:PInteger;  //ビンソート用カウンタ
    FSortShiftFactor:Integer;     //ビンソートバッファ用シフト係数
    //FBatchBuf:PDDDDBltBatch;  //バッチ転送用バッファ
    FZMax:Integer;
    procedure setZMax(v:Integer); //奥行きサイズの設定
    procedure setSprites(idx:Integer; val:TDDDDSprReg);
    function getSprites(idx:Integer):TDDDDSprReg;
  public
    constructor Create(nNeedSpr,nNeedShape:Integer);
    destructor  Destroy; override;
    procedure SetShape(iShape:Integer; Surf:TDDDDGenSurface; const r:TRect);  //パターンとサーフェスの対応づけ
    procedure ChangeShape(iReg,iShape:Integer);          //スプライトレジスタとパターン番号との対応づけ
    procedure Move(iReg, x,y :Integer);
    procedure MovePt(iReg:Integer; const pt:TPoint); //Tpointで移動先を指定
    function  GetPos(iReg:Integer):TPoint;     //スプライトの位置を返す
    procedure Show(iReg:Integer); //表示
    procedure Hide(iReg:Integer);
    procedure SetAlpha(iReg,alpha:Integer);
    procedure SetZoomX(iReg,m,s:Integer);
    procedure SetZoomY(iReg,m,s:Integer);
    procedure NextFrame(iReg:Integer);  //アニメ関係
    procedure PrevFrame(iReg:Integer);
    function  GetFrame(iReg:Integer):Integer;
    procedure SetFrame(iReg,iAnim:Integer);
    procedure SetAnimation(iReg,iMinAnim,iMaxAnim,iCurrent:Integer);  //アニメ状態のセット

    procedure Update;                           //実際に描画する(Sort→UpdateLayerを一括で行う)
    procedure Sort;                             //Z値によって仕分けを行う
    procedure UpdateOneLayer(ZOrder:Integer);   //特定のZ値を持ったスプライトだけを描画

    property  Sprites[idx:Integer]:TDDDDSprReg read getSprites write setSprites; default;
    property  ZMax:Integer read FZMax write setZMax;
end;

TDDDDWordArray = array[0..$0FFFFFFF] of WORD;
PDDDDWordArray = ^TDDDDWordArray;

//BG一面分
TDDDDBG = class
  private
    FChips:Array[0..DDBG_MAXCHIP] of TDDDDBGChip;
    FBGTable:pDDDDWordArray; //BGレジスタの中身はWordなので、VariantでOKだけど
    FRows,FColumns:Integer; //縦・横のチップ数
    FChipWidth,FChipHeight:Integer; //チップ一個の幅・高さ
    FVisible:Boolean;
    FRollX,FRollY:Integer;  //スクロール位置
    FNormalFx:DDBLTFX;  //計算の便宜を図るための定数
    FWIdth,Fheight:Integer;
    procedure SetBGTable(x,y:Integer; iChip:WORD);
    function GetBGTable(x,y:Integer):WORD;
  public
    constructor Create(Col,Row,chWid,chHei:Integer);
    destructor Destroy; override;
    procedure Update;
    procedure SetChipPt(iChip:WORD; surf:TDDDDGenSurface; const pt:TPoint; fCk:Boolean);
    procedure SetChip(iChip:WORD; surf:TDDDDGenSurface; x,y:Integer; fCk:Boolean);
    property RollX:Integer read FRollX write FRollX default 0;
    property RollY:Integer read FRollY write FRollY default 0;
    property BGTable[x,y:Integer]:WORD read GetBGTable write SetBGTable; default;
    property ChipWidth:Integer read FChipWidth;
    property ChipHeight:Integer read FChipHeight;
    property Rows:Integer read FRows;
    property Columns:Integer read FColumns;
    property Width:Integer read FWidth;
    property Height:Integer read FHeight;
end;


//その他の便利ルーチン
procedure ReadBMPHeader(name:String; var bi:TBitmapInfoHeader);
procedure ReadBMPHeaderFromQDA(QDAName, id:String; var bi:TBitmapInfoHeader);


{
procedure InitColorConverter(ddpf:DDPixelFormat); //下の色変換関数を使う前に必ず呼ぶ
function  TColorToDWORD(col:TColor):DWORD;  //ハイカラー以上でのみ働きます
function  RGBToDWORD(r,g,b:BYTE):DWORD;
}

implementation

type
  TIntArray = array[0..$0FFFFFFF] of Integer;
  PIntArray = ^TIntArray;



(******************************************************************************

  DDDDSprReg

******************************************************************************)
constructor TDDDDSprReg.Create(AOwner:TObject);
begin
  Owner:=AOwner;
  Alpha:=0;
  Xs:=1;
  Xm:=1;
  Ys:=1;
  Ym:=1;
  X:=0;
  Y:=0;
  Z:=0;
  ZoomX:=False;
  ZoomY:=False;
  Visible:=False;
  AddMode:=False;
  RewindAnim:=False;
  RewindFlag:=False;
  IShape:=0;
  IAnim:=0;
  MaxAnim:=0;
  MinAnim:=0;
end;

function TDDDDSprReg.getWidth:Integer;
var
  w:Integer;
  r:TRect;
begin
  r:=TDDDDSprite(Owner).FShapes[IShape+IAnim].R;
  w:=abs(r.right-r.left);
  if not ZoomX then
    result:=w
  else
    result:=w * Xm div Xs;
end;

procedure TDDDDSprReg.setWidth(val:Integer);
var
  w:Integer;
  r:TRect;
begin
  r:=TDDDDSprite(Owner).FShapes[IShape+IAnim].R;
  w:=abs(r.right-r.left);
  if val = w then begin
    ZoomX:=False;
    Xm:=1;
    Xs:=1;
  end else begin
    ZoomX:=True;
    Xm:=val;
    Xs:=w;
  end;
end;

function TDDDDSprReg.getHeight:Integer;
var
  h:Integer;
  r:TRect;
begin
  r:=TDDDDSprite(Owner).FShapes[IShape+IAnim].R;
  h:=abs(r.bottom-r.top);
  if not ZoomY then
    result:=h
  else
    result:=h * Ym div Ys;
end;

procedure TDDDDSprReg.setHeight(val:Integer);
var
  h:Integer;
  r:TRect;
begin
  r:=TDDDDSprite(Owner).FShapes[IShape+IAnim].R;
  h:=abs(r.bottom-r.top);
  if val = h then begin
    ZoomY:=False;
    Ym:=1;
    Ys:=1;
  end else begin
    ZoomY:=True;
    Ym:=val;
    Ys:=h;
  end;
end;


procedure TDDDDSprReg.ResetSize;  //Zoomをしなくする。
begin
  ZoomX:=False;
  ZoomY:=False;
  Xm:=1;
  Xs:=1;
  Ym:=1;
  Ys:=1;
end;

function TDDDDSprReg.getPos:TPoint;
begin
  result:=Point(x,y);
end;

procedure TDDDDSprReg.setPos(const val:TPoint);
begin
  x:=val.x;
  y:=val.y;
end;

procedure TDDDDSprReg.Show;
begin
  Visible:=True;
end;

procedure TDDDDSprReg.Hide;
begin
  Visible:=False;
end;


procedure TDDDDSprReg.NextFrame;
begin
  if RewindAnim then begin
    if RewindFlag then begin
      Dec(IAnim);
      if IAnim < MinAnim then begin
        IAnim:=MinAnim+1;
        RewindFlag:=False;
      end;
    end else begin
      Inc(IAnim);
      if IAnim > MaxAnim then begin;
        IAnim:=MaxAnim-1;
        RewindFlag:=True;
      end;
    end;
  end else begin
    Inc(IAnim);
    if IAnim > MaxAnim then
      IAnim:=MinAnim;
  end;
end;

procedure TDDDDSprReg.PrevFrame;
begin
  if RewindAnim then begin
    if not RewindFlag then begin
      Dec(IAnim);
      if IAnim < MinAnim then begin
        IAnim:=MinAnim+1;
        RewindFlag:=True;
      end;
    end else begin
      Inc(IAnim);
      if IAnim > MaxAnim then begin;
        IAnim:=MaxAnim-1;
        RewindFlag:=False;
      end;
    end;
  end else begin
    Dec(IAnim);
    if IAnim < MinAnim then
      IAnim:=MaxAnim;
  end;
end;

(******************************************************************************

  DDDDSprite

******************************************************************************)

procedure TDDDDSprite.setSprites(idx:Integer; val:TDDDDSprReg);
begin
  FRegs^[idx] := val;
end;

function TDDDDSprite.getSprites(idx:Integer):TDDDDSprReg;
begin
  result := FRegs^[idx];
end;

constructor TDDDDSprite.Create(nNeedSpr,nNeedShape:Integer);
var
  i:Integer;
begin
  FNumSpr:=nNeedSpr;
  FNumShape:=nNeedShape;
  FSortBuf:=Nil;


  //スプライトシェイプ領域の確保
  GetMem(FShapes,SizeOf(TDDDDSprShape)*nNeedShape);
  for i:=0 to nNeedShape-1 do begin
    with FShapes^[i] do begin
      Surf :=Nil;
      R    :=Rect(0,0,0,0);
    end;
  end;

  //スプライトレジスタの確保
  GetMem(FRegs,SizeOf(Pointer)*nNeedSpr);
  for i:=0 to nNeedSpr-1 do begin
    FRegs^[i]:=TDDDDSprReg.Create(Self);
  end;

  ZeroMemory(@FNormalFx,sizeof(DDBLTFX));
  FNormalFx.dwSize:=sizeof(DDBLTFX);
  ZeroMemory(@FAlphaFx,sizeof(DDBLTFX));
  FAlphaFx.dwSize:=sizeof(DDBLTFX);

  //バッチ転送バッファの確保
  //GetMem(FBatchBuf,SizeOf(TDDDDBltBatch)*nNeedSpr);


  //Zソート用バッファの確保
  ZMax:=0;
end;

destructor  TDDDDSprite.Destroy;
var
  i:Integer;
begin
  //別に何もしない(^^;)
  for i:=0 to FNumSpr-1 do
    FRegs^[i].Free;
  FreeMem(FRegs);
  FreeMem(FShapes);
  FreeMem(FSortBuf);

  FreeMem(FSortCount);
end;


//パターンとサーフェスの対応づけ
procedure TDDDDSprite.SetShape(iShape:Integer; surf:TDDDDGenSurface; const r:TRect);
begin
  FShapes^[iShape].Surf:=surf;
  FShapes^[iShape].r:=r;
end;

//スプライトレジスタとパターン番号との対応づけ
procedure TDDDDSprite.ChangeShape(iReg,iShape:Integer);
begin
  FRegs^[iReg].IShape:=iShape;
end;

//ZMaxの設定
procedure TDDDDSprite.setZMax(v:Integer);
var
  s:Integer;
begin
  if FSortBuf <> Nil then
    FreeMem(FSortBuf);
  if FSortCount <> Nil then
    FreeMem(FSortCount);

  //シフト係数の計算
  FSortShiftFactor:=0;
  s:=1;
  while s < FNumSpr do begin
    s := s shl 1;
    Inc(FSortShiftFactor);
  end;

  GetMem(FSortBuf,Sizeof(Integer) Shl FSortShiftFactor * (v+1));
  GetMem(FSortCount,Sizeof(Integer) * (v+1));
  FZMax:=v;
end;


{移動}

procedure TDDDDSprite.Move(iReg, x,y :Integer);
begin
  FRegs^[iReg].X:=x;
  FRegs^[iReg].Y:=y;
end;

procedure TDDDDSprite.MovePt(iReg:Integer; const pt:TPoint);
begin
  FRegs^[iReg].X:=pt.x;
  FRegs^[iReg].Y:=pt.y;
end;

function TDDDDSprite.GetPos(iReg:Integer):TPoint;
begin
  result.X:=FRegs^[iReg].X;
  result.Y:=FRegs^[iReg].Y;
end;

{消去・表示}

procedure TDDDDSprite.Show(iReg:Integer);
begin
  FRegs^[iReg].Visible:=True;
end;

procedure TDDDDSprite.Hide(iReg:Integer);
begin
  FRegs^[iReg].Visible:=False;
end;

{表示属性関係}

procedure TDDDDSprite.SetAlpha(iReg,alpha:Integer);
begin
  FRegs^[iReg].Alpha:=alpha;
end;

procedure TDDDDSprite.SetZoomX(iReg,m,s:Integer);
begin
  with FRegs^[iReg] do begin
    Xm:=m;
    Xs:=s;
    ZoomX:= (not (m=s));
  end;
end;

procedure TDDDDSprite.SetZoomY(iReg,m,s:Integer);
begin
  with FRegs^[iReg] do begin
    Ym:=m;
    Ys:=s;
    ZoomY:= (not (m=s));
  end;
end;

{アニメ関係}


procedure TDDDDSprite.NextFrame(iReg:Integer);
begin
  with Fregs^[iReg] do begin
    if RewindAnim then begin
      if RewindFlag then begin
        Dec(IAnim);
        if IAnim < MinAnim then begin
          IAnim:=MinAnim+1;
          RewindFlag:=False;
        end;
      end else begin
        Inc(IAnim);
        if IAnim > MaxAnim then begin;
          IAnim:=MaxAnim-1;
          RewindFlag:=True;
        end;
      end;
    end else begin
      Inc(IAnim);
      if IAnim > MaxAnim then
        IAnim:=MinAnim;
    end;
  end;
end;

procedure TDDDDSprite.PrevFrame(iReg:Integer);
begin
  with Fregs^[iReg] do begin
    if not RewindAnim then begin
      if RewindFlag then begin
        Dec(IAnim);
        if IAnim < MinAnim then begin
          IAnim:=MinAnim+1;
          RewindFlag:=True;
        end;
      end else begin
        Inc(IAnim);
        if IAnim > MaxAnim then begin;
          IAnim:=MaxAnim-1;
          RewindFlag:=False;
        end;
      end;
    end else begin
      Dec(IAnim);
      if IAnim < MinAnim then
        IAnim:=MaxAnim;
    end;
  end;
end;


//現在、何フレーム目かを取得
function  TDDDDSprite.GetFrame(iReg:Integer):Integer;
begin
  result:=Fregs^[iReg].IAnim;
end;

//フレーム番号で直接指定
procedure TDDDDSprite.SetFrame(iReg,iAnim:Integer);
begin
  Fregs^[iReg].IAnim:=iAnim;
end;

//アニメーションパーツの初期化
procedure TDDDDSprite.SetAnimation(iReg,iMinAnim,iMaxAnim,iCurrent:Integer);
begin
  with Fregs^[iReg] do begin
    MaxAnim:=iMaxAnim;
    MinAnim:=iMinAnim;
    IAnim  :=iCurrent;
  end;
end;


//Z値によって仕分けを行う
procedure TDDDDSprite.Sort;
var
  i:Integer;
  pCount:PInteger;    //各レイヤに、いくつ物体があるか
  pSort:PInteger;
  pReg:^TDDDDSprReg;
begin
  //FSortCountのクリア
  pCount:=FSortCount;
  ZeroMemory(pCount,Sizeof(Integer)*(FZMax+1));

  //ビンソート
  pReg:=@FRegs^[FNumSpr-1];
  for i:=FNumSpr-1 downto 0 do begin
    if pReg^.Visible then begin
      pSort:=FSortBuf;
      pCount:=FSortCount;
      if pReg^.Z > FZMax then begin
        DDDD_PutDebugMessage(Format('Z=%dは無効です、Z値は0から%dの範囲にしてください',[pReg^.Z,FZMax]));
        continue;
      end;
      Inc(pCount,pReg^.Z);
      Inc(pSort,pReg^.Z shl FSortShiftFactor + pCount^);
      pSort^:=i;  //FSortBuf[z][FSortCount[z]]:=i
      Inc(pCount^); //FSortCount[z]++
    end;
    Dec(pReg);
  end;
end;

//特定のZ値を持ったスプライトだけを描画
procedure TDDDDSprite.UpdateOneLayer(ZOrder:Integer);
var
  count:Integer;
  pSort:PInteger;
  j:Integer;
  dr:TRect;
begin

  if ZOrder > FZMax then begin
    DDDD_PutDebugMessage(Format('Z=%dは無効です、Z値は0から%dの範囲にしてください',[ZOrder,FZMax]));
    Exit;
  end;

  count:=PIntArray(FSortCount)^[ZOrder];
  pSort:=FSortBuf;

  Inc(pSort,ZOrder Shl FSortShiftFactor);

  //DDDD_PutDebugMessage(Format('Z = %d ... %d',[FZMax-i,count]));

  //不透明体のBlt
  for j:=1 to count do begin

    with FRegs^[pSort^] do begin
      if (IShape+IAnim) >= FNumShape then begin
        DDDD_PutDebugMessage(Format('DDDDSprite.IShape=%dは無効です、IShapeは0から%dの範囲にしてください',[iShape+iAnim,FNumShape-1]));
        Inc(pSort);
        Continue;
      end;
      with FShapes^[IShape+IAnim] do begin
        if not Assigned(surf) then begin
          DDDD_PutDebugMessage(Format('DDDDSprite.Shape[%d]に使うサーフェスが見付かりません',[iShape+iAnim]));
          Inc(pSort);
          Continue;
        end;
        with R do begin

          if (ZoomX or ZoomY) then
            dr := Rect(X,Y,X+(Right-Left)*Xm div Xs,Y+(Bottom-Top)*Ym div Ys)
          else
            dr := Rect(X,Y,X+Right-Left,Y+Bottom-Top);

          if Alpha = 0 then begin
            if (not(ZoomX or ZoomY)) then begin
              if Surf.PutFast(dr.left, dr.top, R, DDBLTFAST_SRCCOLORKEY)<>DD_OK then
                Surf.PutFast(dr.left, dr.top, R, DDBLTFAST_SRCCOLORKEY+DDBLTFAST_WAIT);
            end else begin
              if Surf.Put(dr, R, DDBLT_KEYSRC,FNormalFx)<>DD_OK then
                Surf.Put(dr, R, DDBLT_KEYSRC+DDBLT_WAIT,FNormalFx);
            end;

          end else begin
            FAlphaFx.dwAlphaSrcConst:=Alpha;
            FAlphaFx.dwAlphaSrcConstBitDepth:=8;
            if Surf.Put(dr, R, DDBLT_KEYSRC + DDBLT_ALPHASRCCONSTOVERRIDE,FAlphaFx)<>DD_OK then
              Surf.Put(dr, R, DDBLT_KEYSRC+DDBLT_WAIT,FAlphaFx);
          end;

        end;
      end;
    end;
    Inc(pSort);

  end;
end;


//全表示
procedure TDDDDSprite.Update;
var
  i:Integer;
begin

  //ソートする
  Sort;

  //1レイヤずつ表示
  For i:=0 to ZMax do
    UpdateOneLayer(i);
end;


(******************************************************************************
  TDDDDBGの実装
******************************************************************************)
constructor TDDDDBG.Create(Col,Row,chWid,chHei:Integer);
//var
//  nBuf:Integer;
begin
  FColumns:=Col;
  FRows:=Row;
  FChipWidth:=chWid;
  FChipHeight:=chHei;
  FWidth:=Col*chWid;
  FHeight:=Row*chHei;

  GetMem(FBGTable,(Col*Row)*Sizeof(WORD));
  ZeroMemory(@FNormalFx,sizeof(DDBLTFX));
  FNormalFx.dwSize:=sizeof(DDBLTFX);
  FRollX:=0;
  FRollY:=0;
  FVisible:=True;

  //nBuf:= (1280*1024) div (chWid*chHei);
  //GetMem(FBatchBuf,sizeof(TDDDDPutBatch)*nBuf);
end;

destructor TDDDDBG.Destroy;
begin
  FreeMem(FBGTable);
  //Dispose(FBatchBuf);
end;

procedure TDDDDBG.Update;
var
  x,y,sx,sy,bx,by,rx,ry,ofs_x,ofs_y:Integer;
  wx,wy:Integer;
  rolX,rolY:Integer;
  iChip:WORD;
  DR:TRect;
  //count:Integer;
  //tc:Integer;
begin
  if not FVisible then
    exit;

  //tc:=GetTickCount; //DEBUG

  //count:=0;
  //スクロール位置の正規化
  if FRollX < 0 then
    rolX := (((-FRollX)+FWidth-1) div FWidth) * FWidth + FRollX
  else
    rolX := FRollX mod FWidth;
  if FRollY < 0 then
    rolY := (((-FRollY)+FHeight-1) div FHeight) * FHeight + FRollY
  else
    rolY := FRollY mod FHeight;

  //描画開始オフセット
  ofs_x :=  - (rolX mod FChipWidth );
  ofs_y :=  - (rolY mod FChipHeight);

  //描画開始インデクスの計算
  sx := (rolX + ofs_X) div FChipWidth;
  sy := (rolY + ofs_Y) div FChipHeight;
  //sx := rolX  div FChipWidth;
  //sy := rolY div FChipHeight;

  //描画するキャラクタ数
  wx:=(Screen.Width + FChipWidth - ofs_x -1) div FChipWidth;
  wy:=(Screen.Height + FChipHeight- ofs_y -1) div FChipHeight;


  by := sy;
  while by < 0 do
    Inc(by,FRows);
  by := by mod FRows;

  ry := ofs_y;
  for y:=0 to wy-1 do begin
    bx := sx;
    while bx < 0 do
      Inc(bx,FColumns);
    bx:=bx mod FColumns;
    rx := ofs_x;

    for x:=0 to wx-1 do begin
      iChip := BGTable[bx,by];
      if iChip<>DDBG_UNSEEN then begin
        if iChip > DDBG_MAXCHIP then begin
          DDDD_PutDebugMessage(Format('DDDDBG BGチップ%d番は無効です。0..%dの範囲で指定してください',[iChip,DDBG_MAXCHIP-1]));
          Continue;
        end;
        with FChips[iChip] do begin
          if not Assigned(Surf) then begin
            DDDD_PutDebugMessage(Format('DDDDBG BGチップ%d番に使うサーフェスが見付かりません',[iChip]));
            Continue;
          end;
          {将来、BltBatchがサポートされたときにでも…}
          //with FBatchBuf^[count] do begin
          //  iSurf:=FChips[iChip].iSurf;
          //  srcRect:=R;
          //  destRect:=Rect(rx,ry,rx+ChipWidth-1,ry+ChipHeight-1);
          //end;
          DR:=Rect(rx,ry,rx+ChipWidth,ry+ChipHeight);
          if useCk then begin
            if Surf.PutFast(dr.Left,dr.Top, R, DDBLTFAST_SRCCOLORKEY)<>DD_OK then
              Surf.PutFast(dr.Left,dr.Top, R, DDBLTFAST_SRCCOLORKEY + DDBLTFAST_WAIT)
          end else begin
            if Surf.PutFast(dr.Left,dr.Top, R, 0)<>DD_OK then
              Surf.PutFast(dr.Left,dr.Top, R, DDBLTFAST_WAIT);
          end;
        end;
      end;
      Inc(rx,FChipWidth);
      Inc(bx);
      if bx >= FColumns then
        bx:=0;
      //Inc(count);
    end;

    inc (ry,FChipHeight);
    inc (by);
    if by >= FRows then
      by:=0;

  end;

  //DDDD_PutBatch(@FBatchBuf^[0],count,DDBLT_KEYSRC+DDBLT_WAIT,FNormalFx);

  //DEBUG
  //Dec(tc,GetTickCount);
  //DPS(Format('Blit Area:(%d,%d)  Elapsed : %d',[wx,wy,-tc]));
end;

procedure TDDDDBG.SetChipPt(iChip:WORD; surf:TDDDDGenSurface; const pt:TPoint; fCk:Boolean);
begin
  FChips[iChip].Surf:=surf;
  with FChips[iChip] do begin
    R := Rect(pt.x, pt.y, pt.x+FChipWidth, pt.y+FChipHeight);
    useCk:=fCk;
  end;
end;

procedure TDDDDBG.SetChip(iChip:WORD; surf:TDDDDGenSurface; x,y:Integer; fCk:Boolean);
begin
  FChips[iChip].Surf:=surf;
  with FChips[iChip] do begin
    R := Rect(x, y, x+FChipWidth, y+FChipHeight);
    useCk:=fCk;
  end;
end;

procedure TDDDDBG.SetBGTable(x,y:Integer; iChip:WORD);
begin
  FBGTable^[y*FColumns+x]:=iChip;
end;

function TDDDDBG.GetBGTable(x,y:Integer):WORD;
begin
  result:=FBGTable^[y*FColumns+x];
end;


(******************************************************************************
  その他のお便利ルーチン
******************************************************************************)
procedure ReadBMPHeader(name:String; var bi:TBitmapInfoHeader);
var
  fs:TFileStream;
begin
  fs:=TFileStream.Create(name,fmOpenRead);

  fs.Seek(sizeof(TBitmapFileHeader), soFromBeginning);
  fs.Read(bi,sizeof(TBitmapInfoHeader));
  fs.Free;
end;

procedure ReadBMPHeaderFromQDA(QDAName, id:String; var bi:TBitmapInfoHeader);
var
  ms:TMemoryStream;
begin
  ms:=ExtractFromQDAFile(QDAName,id);

  ms.Seek(sizeof(TBitmapFileHeader), soFromBeginning);
  ms.Read(bi,sizeof(TBitmapInfoHeader));
  ms.Free;
end;


procedure DrawString(Surf:TDDDDGenSurface; x,y:Integer; str:String; canvas:TCanvas);
var
  hd:HDC;
  hf:HFont;
//  hb:HBrush;
//  hp:HPen;
begin
  hd:=Surf.GetDC;

  hf:=SelectObject(hd,canvas.Font.Handle);
  //hb:=SelectObject(hd,canvas.Brush.Handle);
  //hp:=SelectObject(hd,canvas.Pen.Handle);

  TextOut(hd,x,y,PChar(str),Length(str));

  //SelectObject(hd,hp);
  //SelectObject(hd,hb);
  SelectObject(hd,hf);

 Surf.ReleaseDC;
end;


type TColorShift = record
  rr,rl,gr,gl,br,bl:Integer;  //色変換用シフト係数
end;

var
  Shifter:TColorShift;

//色変換ルーチン初期化
{$HINTS OFF}
procedure InitColorConverter(ddpf:DDPixelFormat);
var
  dummy:Integer;
  procedure GetShiftVal(var rr,rl:Integer; bitmask:Integer);
  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(rr,rl, ddpf.dwRBitMask);
    GetShiftVal(gr,gl, ddpf.dwGBitMask);
    GetShiftVal(br,bl, ddpf.dwBBitMask);
  end;
end;
{$HINTS ON}


//TColor($00BBGGRR)からサーフェスメモリでの色に変換
//ただし、8ビットモードではダメ
function  TColorToDWORD(col:TColor):DWORD;
var
  r,g,b:BYTE;
begin
  r:= col And $000000FF;
  g:=(col And $0000FF00) Shr 8;
  b:=(col And $00FF0000) Shr 16;

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

//$00RRGGBBからサーフェスメモリでの色に変換
//ただし、8ビットモードではダメ
function  RGBToDWORD(r,g,b:BYTE):DWORD;
begin
  with Shifter do
    result:=
      ((r Shr rr) Shl rl) Or
      ((g Shr gr) Shl gl) Or
      ((b Shr br) Shl bl);
end;

end.
