Delphi+DirectX游戏编程

http://www.cnblogs.com/keycode/archive/2010/10/17/1853708.html

Delphi+DirectX游戏编程

先说说如果用Delphi进行游戏编程要些什么，要注意什么。

1 、到网上查找下载 DirectX 7.0 for Delphi 声明档或更高版本(本人源码用的是 7.0 )。查找时最好用DirectDraw . pas,否则DelphiX控件信息会占满你前 100 页的搜索结果。

2 、如果你是用D7或更高版本，DirectX 7.0 for Delphi 声明档的 DirectDraw . pas 第 145 行要改为： {$IFDEF VER150}  否则你无法编译。 8.0 版要更改更多地方。

3 、如果是全屏模式，千万不要用单步执行的方式运行。否则会死的很难看。

4 、推荐一本书《Delphi Graphics and Game Programming Exposed with DirectX 7.0 》，网上能找到英文版下载。

5 、中文翻译表达不准备。如表面、界面等。源码很多是参看推荐书中，但也有很多改进。

先来二段最简单的代码。

实现功能一：将一张图片用全屏模式显示出来(更多注解请看后面笔记)

uese  DirectDraw;

var

  FDirectDraw: IDirectDraw7;  {代表显示器}

  FPrimarySurface: IDirectDrawSurface7;    {代表主页面}

  FBitmap:IDirectDrawSurface7;   {用于存放BMP}



procedure TForm1 . FormCreate(Sender: TObject);

var

  TempDirectDraw: IDirectDraw;

  DDSurface: TDDSurfaceDesc2;

begin

  DirectDrawCreate( Nil ,TempDirectDraw, Nil );

  try

    TempDirectDraw . QueryInterface(IID_IDirectDraw4, FDirectDraw);

   finally

    TempDirectDraw := nil ;

  end ;

  FDirectDraw . SetCooperativeLevel(handle,DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN);

  FDirectDraw . SetDisplayMode( 800 , 600 , 32 , 0 , 0 );

  FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

  DDSurface . dwSize  := SizeOf(TDDSurfaceDesc2);

  DDSurface . dwFlags := DDSD_CAPS;

  DDSurface . ddsCaps . dwCaps := DDSCAPS_PRIMARYSURFACE;

  if FDirectDraw . CreateSurface(DDSurface,FPrimarySurface, Nil )<>DD_OK then Close;

  FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

  DDSurface . dwSize   := SizeOf(TDDSurfaceDesc2);

  DDSurface . dwFlags  := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;

  DDSurface . dwWidth  := 800 ;

  DDSurface . dwHeight := 600 ;

  DDSurface . ddsCaps . dwCaps := DDSCAPS_OFFSCREENPLAIN;

  FDirectDraw . CreateSurface(DDSurface, FBitmap, nil );

end ;

procedure TForm1 . FormShow(Sender: TObject);

var

  BMP:TBitMap;

  SrcRect:TRect;

begin

  BMP:=TBitMap . Create;

  BMP . loadfromfile( './desk.bmp' );

  if FBitmap . GetDC(l_DC)<>DD_OK then close;

  BitBlt(l_DC, 0 , 0 , 800 , 600 ,

              BMP . Canvas . Handle, 0 , 0 , SrcCopy);

  SrcRect := Rect( 0 , 0 , 800 , 600 );

  FBitmap . ReleaseDC(l_DC);

  FPrimarySurface . BltFast( 0 , 0 , FBitmap, @SrcRect, DDBLTFAST_NOCOLORKEY OR DDBLTFAST_WAIT);

  BMP . Free;

end ;



实现功能二：继上面显示图形后，显示几个文字；

procedure TForm1 . FormShow(Sender: TObject);

var

  BMP:TBitMap;

  SrcRect:TRect;

  TempCanvas: TCanvas;

  SrfcDC: HDC;

begin

  BMP:=TBitMap . Create;

  BMP . loadfromfile( './desk.bmp' );

  if FBitmap . GetDC(l_DC)<>DD_OK then close;

  BitBlt(l_DC, 0 , 0 , 800 , 600 ,

              BMP . Canvas . Handle, 0 , 0 , SrcCopy);

  SrcRect := Rect( 0 , 0 , 800 , 600 );

  FBitmap . ReleaseDC(l_DC);

  FPrimarySurface . BltFast( 0 , 0 , FBitmap, @SrcRect, DDBLTFAST_NOCOLORKEY OR DDBLTFAST_WAIT);

  BMP . Free;

  TempCanvas := TCanvas . Create;

  FPrimarySurface . GetDC(SrfcDC);

  with TempCanvas do begin

    Handle := SrfcDC;

    Brush . Color := clBlack;

    FillRect(Rect( 0 , 0 , 640 , 480 ));

    Font . Color := clLime;

    TextOut( 100 , 100 , '显示文字' )

  end ;

  TempCanvas . Handle := 0 ;

  FPrimarySurface . ReleaseDC(SrfcDC);

  TempCanvas . Free;

end ;

游戏的的最基本要素：图形文字，用两段简单的化码就实现了。接下来是游戏最得要的要素了：动起来。

不过，千成不要急。这里我们还不能急于求成。因为这里还有很多东西要补充，结出说明。如果你运行了前两段代码，就会发现，这是全屏方式的，并且，如果弹出桌面后再返回程序，图形就完全变了。即使把画图写字的代码放到OnActive事件中也一样。如果显卡不支持 800 X 600 X 32 色模式，这程序就弹出出去了。所以先解释（一）中的代码。

var

FDirectDraw: IDirectDraw7;  {代表显示器}

FPrimarySurface: IDirectDrawSurface7;    {代表主页面} 有时也会说IDirectDrawSurface7代表的是显存，不一定正确，每个人理解不一样。

FBitmap:IDirectDrawSurface7;   {用于存放BMP} 离屏表面。这个变量不是多余的，虽然也是IDirectDrawSurface7，也可以看成是显存，但它的创建和上面那个变量不一样。可以看成是缓冲。

OnCreate事件中代码：

DirectDrawCreate( nil , TempDirectDraw, nil );

创建一个临时的 DirectDraw 对象。第一、三个参用 nil ，将游戏界面创建到主显示器上。如果有多个显示器，并且要创建到非主显示器上，你要先查找到所有显示器，然后将相应GUID的指针值，代替第一个参数。这里不讨论。（具体可参看DirectX控件源码是如何实现的）

TempDirectDraw . QueryInterface(IID_IDirectDraw7, FDirectDraw);

我们只能通过查询 DirectDraw 对象界面的方法，来取得一个 DirectDraw7 界面

TempDirectDraw := nil ;

现在我们有了 DirectDraw7 界面，临时 DirectDraw 对象不再需要它了

DX对象会在程序关闭时自动释放，也可以不赋 nil 值。前面例子中IDirectDraw7、IDirectDrawSurface7 在程序关闭时都未处理。没有必要。

FDirectDraw . SetCooperativeLevel(handle,DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN);

设置合作水平：全屏模式。第二参数可以是多种组合，具体意义网上能找到，不重复。

FDirectDraw . SetDisplayMode( 800 , 600 , 32 , 0 , 0 );

设置屏幕大小、颜色数： 800 X 600 ， 32 真彩色。现在显卡一般都支持： 8 bit、 16 bit、 32 bit，而 24 色比较特殊，很多显卡都不支持了。我主要讲的是 16 色和 32 色。 24 色除了占的字节数和 32 色不同之外，其它的都和 32 色一样（目前如此）。 8 bit( 256 色)在《Delphi Graphics and Game Programming Exposed with DirectX 7.0 》书中有详细说明。希望你已下载到此书。

如果想以此入门转而进入3D游戏编程的朋友，应主攻 16 色。

FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

DDSurface . dwSize  := SizeOf(TDDSurfaceDesc2);

DDSurface . dwFlags := DDSD_CAPS;

DDSurface . ddsCaps . dwCaps := DDSCAPS_PRIMARYSURFACE;

FDirectDraw . CreateSurface(DDSurface,FPrimarySurface, Nil )<>DD_OK then Close;

这一段代码是创建主页面。这也DX的一大特点，创建对象时是跟据一个数据结构的要求来创建的。因此首先要初始化数据结构，然后再调用DX相应的函数。

FillChar：先对数据结构清零；

DDSurface . dwSize  := SizeOf(TDDSurfaceDesc2); 这也是DX的一个特点，每个数据结构都有数据结构的大小，网上说是为了区别DX版本。这里只要按这种方式写就可以了

DDSurface . dwFlags := DDSD_CAPS;  标志，网上有所以参数说明，不重复

DDSurface . ddsCaps . dwCaps := DDSCAPS_PRIMARYSURFACE;设为主页面（PRIMARYSURFACE）

if FDirectDraw . CreateSurface(DDSurface,FPrimarySurface, Nil )<>DD_OK then Close;

创建主页面，如果创建失败，就关闭程序。

接下来的代码和上面的创建过程一样，就是初始化数据结构时几个参数不同

DDSurface . dwFlags  := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;

DDSurface . ddsCaps . dwCaps := DDSCAPS_OFFSCREENPLAIN; 告诉程序，下面创建的是一个离屏表面，即不显示的页面。

OnShow 代码

这里三个函数要说一下：

GetDC、ReleaseDC，这两个没什么好说的，只要成双出现就行了。

BltFast。这是DX图形拷贝最快的一个函数。说是这么说，但好角Blt速度也差不了多少。

显示文字的代码就不用多说了，参看TCanvas就行了。

----------------------------------------------------------------

以上对DX代码作了简单说明总结。下面再说一下跟图形有关的东东，和几个非常简单特效。

一、抠图。

这个是非常实用，并且用的非常多。 实现起来也非常简单。

**接（一）程序**

var

  ColorKey: TDDColorKey;  //这也是一个数据结构

(*接在最后面*)

  BMP:=TBitMap . Create;

  BMP . loadfromfile( './aaa.bmp' );

  if FBitmap . GetDC(l_DC)<>DD_OK then close;

  BitBlt(l_DC, 0 , 0 , bmp . width, bmp . heigh,

              BMP . Canvas . Handle, 0 , 0 , SrcCopy);

  FBitmap . ReleaseDC(l_DC);    //装入 图形，这里BMP重建，是因为前面FREE了

  ColorKey . dwColorSpaceLowValue  := 0 ;

  ColorKey . dwColorSpaceHighValue := 0 ;   //将黑色作为透明色

  FBitmap . SetColorKey(DDCKEY_SRCBLT, @ColorKey);

  SrcRect := Rect( 0 , 0 , bmp . width, bmp . heigh);

  FPrimarySurface . BltFast( 200 , 100 , FBitmap2, @SrcRect, DDBLTFAST_SRCCOLORKEY OR DDBLTFAST_WAIT);

  BMP . Free;

end ;

注意最后一个参数：DDBLTFAST_SRCCOLORKEY ，（一）中的是DDBLTFAST_NOCOLORKEY。

还应意，DX的透明色一般都用纯黑色。这是因为黑色，在8bit、16bit、24bit、32bit中的值都是零，而其他的颜色就不一定了。如：RGB（ 0 ， 0 ， 255 ）在16bit就不是纯蓝了。

二、BLT函数和它实现的几个特效

var

  MaskRect:TRect;

  PDD:TDDBltFX;  //Blt特效数据结构

(** BLT 填冲色块  **)

  MaskRect := Rect( 100 , 100 , 200 , 200 );

  FillChar(PDD, SizeOf(TDDBltFX), 0 );

  PDD . dwSize := Sizeof(TDDBltFX) ;

  PDD . dwFillColor:=RGB( 200 , 200 , 255 );

  FPrimarySurface . Blt(@MaskRect, nil ,@MaskRect,DDBLT_COLORFILL or  DDBLT_WAIT,@PDD);

(**  FX 境像 **)

  MaskRect := Rect( 200 , 200 , 220 , 216 );

  FillChar(PDD, SizeOf(TDDBltFX), 0 );

  PDD . dwSize := Sizeof(TDDBltFX);

  PDD . dwDDFX := DDBLTFX_MIRRORUPDOWN;

  FPrimarySurface . Blt(@MaskRect, FBitmap, @SrcRect,

                       DDBLT_DDFX or DDBLT_WAIT,@PDD);

注：Blt通过两个TRect就可以直接实现缩放。更多特效可参看TDDBltFX的数据结构中dwDDFX的变量值

------------------------------------------------------------

虽然现在几乎找不到不支持 800 X 600 X 32 的显卡。但还是有必要给出下面这段代码：

uses DirectDraw;

var

  FDirectDraw: IDirectDraw4;

implementation

function EnumModesCallback( const lpDDSurfaceDesc: TDDSurfaceDesc2;

                           lpContext: Pointer ): HResult; stdcall;

begin

  TStringList(lpContext).Add(IntToStr(lpDDSurfaceDesc . dwWidth)+ ' X ' +

                       IntToStr(lpDDSurfaceDesc . dwHeight)+ ', ' +

                       IntToStr(lpDDSurfaceDesc . ddpfPixelFormat . dwRGBBitCount)+

                        'bits/pixel' );

  Result := DDENUMRET_OK;

end ;

procedure TForm1 . FormCreate(Sender: TObject);

var

  TempDirectDraw: IDirectDraw;

begin

  DirectDrawCreate( nil , TempDirectDraw, nil );

  try

    TempDirectDraw . QueryInterface(IID_IDirectDraw4, FDirectDraw);

   finally

    TempDirectDraw := nil ;

  end ;

  {列举显示模式}

  FDirectDraw . EnumDisplayModes( 0 , nil , ListBox1 . Items, EnumModesCallback);

end ;

跟据这段代码，你就可以在显示模式不被支持时，让用户选择另一个模式，或给出一个提示对话框，而不用象我前面给出的例子，强制退出了。

在前面代码中，除列举显式模式程序之外，都是在全屏模式下实现的。如何实现窗口模式呢？又或者，还有更高的要求，只显式在一个Panle控件中呢？这个问题《Delphi Graphics and Game Programming Exposed with DirectX 7.0 》中没有给出答案。在解决非全屏模式的同时我们可以解决另一个问题，前面的显示文字图形的代码，是不能显示控件的。你放的任何控件都会被DX覆盖掉，这给调试带来一定麻烦，特别是全屏模式。

下面将给出非全模式、显示在控件中的方法。之后给出改进（英文书提供）的游戏框架代码。

一、窗口模式

运用窗口模式,首先设置合作水平时必须指明是窗口模式：

FDirectDraw . SetCooperativeLevel(handle,DDSCL_NORMAL);    DDSCL_NORMAL 普通模式

然后建立Clipper——修剪者。指定DX显示范围。并依附在主表面上。如果不指定，你会看到一个很怪异的图中图的情形。

var

   Clipper:IDirectDrawClipper;

  FDirectDraw . CreateClipper( 0 ,Clipper, nil );

  Clipper . SetHWnd( 0 ,Handle);

  FPrimarySurface . SetClipper(Clipper) ;  //依附在主表面上

Clipper . SetHWnd( 0 ,Handle); 这里是指定的是窗口handle。如果你想DX只画在一个控件上，而窗口上其它位置留作它用，如画在panel1上，那么，这一句必须这么写：

    Clipper . SetHWnd( 0 ,panel1 . Handle);

好了。下面全出一个比较全的代码，实现非全屏模式。

Uses

   DirectDraw;

const

  WM_DIRECTXACTIVATE = WM_USER + 200 ;   //自定义消息

  private    //自定义过程，说明在后

    procedure DrawSurfaces;

    procedure FlipSurfaces;

    procedure AppIdle(Sender: TObject; var Done: Boolean );

    procedure AppMessage( var Msg: TMsg; var Handled: Boolean );

    procedure RestoreSurfaces;

var

  FDirectDraw: IDirectDraw7;

  FPrimarySurface: IDirectDrawSurface7;

  oneSurface: IDirectDrawSurface7;

procedure TForm1 . FormActivate(Sender: TObject);

var

  TempDirectDraw: IDirectDraw;

  DDSurface: TDDSurfaceDesc2;

  DDSCaps: TDDSCaps2;

  Clipper:IDirectDrawClipper;

  L_DC:HDC;

  BMP:TBitMap;

begin

  DirectDrawCreate( nil ,TempDirectDraw, Nil );     //在主显示器上创建IDirectDraw对象

  try

    TempDirectDraw . QueryInterface(IID_IDirectDraw7, FDirectDraw);

   finally

    TempDirectDraw := nil ;

  end ;

  Application . OnMessage := AppMessage;          //处理程序消息

  FDirectDraw . SetCooperativeLevel(handle,DDSCL_NORMAL);  //设置合作水平

//  FDirectDraw.SetDisplayMode(800,600,32,0,0);          //显示模式不用设置

  FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

  DDSurface . dwSize  := SizeOf(TDDSurfaceDesc2);

  DDSurface . dwFlags := DDSD_CAPS;

  DDSurface . ddsCaps . dwCaps := DDSCAPS_PRIMARYSURFACE;

  DDSurface . dwBackBufferCount := 1 ;     //后台反转表面数一个

  if FDirectDraw . CreateSurface(DDSurface,FPrimarySurface, Nil )<>DD_OK then Close; //建立主表面

  FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

  DDSurface . dwSize  := SizeOf(TDDSurfaceDesc2);

  DDSurface . dwFlags:=DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS;

  DDSurface . dwWidth := 800 ;

  DDSurface . dwHeight := 600 ;

  DDSurface . ddsCaps . dwCaps := DDSCAPS_OFFSCREENPLAIN ;

  FDirectDraw . CreateSurface(DDSurface,oneSurface, nil );   //建立离屏表面

  FDirectDraw . CreateClipper( 0 ,Clipper, nil );

  Clipper . SetHWnd( 0 ,Handle);

  FPrimarySurface . SetClipper(Clipper) ;

  PostMessage(Handle, WM_ACTIVATEAPP, 1 , 0 );  //发送消息，开始循环

end ;



procedure TForm1 . AppMessage( var Msg: TMsg; var Handled: Boolean );

begin

  case Msg . Message of

    WM_ACTIVATEAPP:

      {如果窗口不是活动窗口进，停止动画}

      if not Boolean (Msg . wParam) then

         Application . OnIdle := nil

      else

        {如果变成活动窗口，发送自定义消息}

        PostMessage(Application . Handle, WM_DIRECTXACTIVATE, 0 , 0 );

    WM_DIRECTXACTIVATE:

      begin

        {收到自定义消息，重装所有界面(跟据需要重装他们的内存),重连 OnIdle 事件,

         重画所有表面    }

        RestoreSurfaces;

        Application . OnIdle := AppIdle;  //

        DrawSurfaces;

      end ;

    WM_SYSCOMMAND:

      begin

        {关闭屏保}

        Handled := (Msg . wParam = SC_SCREENSAVE);

      end ;

  end ;

end ;

procedure TForm1 . AppIdle(Sender: TObject; var Done: Boolean );

begin  //如果程序有空，就做下面两件事

  DrawSurfaces;

  FlipSurfaces;

end ;

procedure TForm1 . DrawSurfaces;  //离屏表面装入图片，如果控制好按顺序装入不同的图形，

var                       //并控制好时间，就实现了动画,具本可看DirectX 7.0 for Delphi

                          //声明档例子

  BMP:TBitmap;

  L_DC:HDC;

begin

  BMP:=TBitMap . Create;

  BMP . LoadFromFile( 'Desk.bmp' );

  oneSurface . GetDC(L_DC);

  BitBlt(l_DC, 0 , 0 , 800 , 600 ,

              BMP . Canvas . Handle, 0 , 0 , SrcCopy);

  oneSurface . ReleaseDC(L_DC);

end ;

procedure TForm1 . FlipSurfaces;  //把离屏表面的图形画到主表面上去

var

  rcSrc,rcDest:TRECT;

  P:TPoint;

begin

  P . X:= 0 ;P . y:= 0 ;

  P:=ClientToScreen(P);   //如果你想用控件，这里是：P:=Panel1.ClientToScreen(P);

  rcDest:=GetClientRect;

  OffsetRect(rcDest,P . x,P . y);  //计算出窗口客户区RECT在屏幕中的绝对位置，

                               //计算不正确，呵呵……自己试试

  SetRect(rcSrc, 0 , 0 , 800 , 600 );

  FPrimarySurface . Blt(@rcDest, oneSurface, @rcSrc, DDBLT_WAIT, nil );

end ;

procedure TForm1 . RestoreSurfaces; //表面恢复

begin

  FPrimarySurface . _Restore;

  oneSurface . _Restore;

end ;

好了，这时你放几个控件到窗口上，如：按钮、Panel、Memo，这时。它们是显示的DX图形上面了。

如果你没有设置窗口的BorderStyle:=bsSizeable; 那你可以试试改变窗口的大小，看看Blt的自动缩放动能。

如果看过DirectX 7.0 for Delphi声明档例子，你这时会产生一个疑惑：因为它用的方法是：FPrimarySurface . Flip( nil , 0 ); 非全屏模式下，不能用Flip。虽然FLip很快，非常快。但窗口模式不能用，这也是为什么很多游戏不能在在非全屏模式下运行的原因。我的一个程序，在窗口模式下只有 7 ~ 8 个FPS，而全屏模式下能达到 20 多。鱼和熊掌不能兼得。

关于表面恢复：

这也是全屏模式下的概念，非全屏模式下不会产生这个（我是没发现，正确与否还得论证）。在全屏模式是，DX会把所有的显存空出来给你的程序。当你程序最小化，显示出桌面时，内存中的数据就被破坏了，回到你的程序时，就必须进行恢复。恢复很简单，把丢失了的表面_Restore一下就行了。要命的是内存的的图片数据，你得一个个的恢复。你会说我上面怎么没有恢复图片的代码呀？你认真看一下就知道了，每次Blt之前都装入一次（DrawSurfaces事件），所以在表面恢复后，就没有必要。

玩过全屏游戏的朋友都知道，弹出桌后再回到游戏， 100 %的游戏都不能立刻显示游戏画面，都是黑屏，然后听到硬盘一阵狂响，这是在装入图片数据。然后才能让你继续游戏。

二、游戏框架代码

上面的代码已经有一点框架的雏形了。下面给出的是比较全面的框架，包括全屏和非全屏模式，还有比较详细的说明和心得体会。说明是翻译那本英文书上的，不是很准确，请多包涵。全屏模式下，是采用Blt、还是Flip，自己修改相应代码。看完这个框架，你对DX游戏编程就会有更深的理解了。

这只是一个框架，千万别试着运行它，在你还没有加入必要的代码之前。否则会死得很难看。

uses

  DirectDraw;

const

  CooperAtiveLevel = DDSCL_FULLSCREEN or DDSCL_ALLOWREBOOT or DDSCL_ALLOWMODEX

                     or DDSCL_EXCLUSIVE;

  SurfaceType      = DDSCAPS_COMPLEX or DDSCAPS_FLIP or DDSCAPS_PRIMARYSURFACE;

const

  {自定义消息}

  WM_DIRECTXACTIVATE = WM_USER + 200 ;

type

  TForm_main = class (TForm)

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure FormActivate(Sender: TObject);

    procedure FormKeyDown(Sender: TObject; var Key: Word ;

      Shift: TShiftState);

  private

    {反转一新DGI 表面 用于显示错误}

    procedure ExceptionHandler(Sender: TObject; ExceptionObj: Exception);

    {主循环}

    procedure AppIdle(Sender: TObject; var Done: Boolean );

    {画表面}

    procedure DrawSurfaces;

    {反转 DirectDraw 表面}

    procedure FlipSurfaces;

    {重装丢失的表面}

    procedure RestoreSurfaces;

    { 截取消息功能}

    procedure AppMessage( var Msg: TMsg; var Handled: Boolean );

    { 初始DX为全屏模式 }

    procedure InitDirectDraw;

    { 初始DX为窗口模式 }

    procedure InitDirectDrawWindows;

  public

    { Public declarations }

  end ;

var

  Form_main: TForm_main;

  DXWidth: integer      = 800 ;   {DX 显示宽度}

  DXHeight: integer     = 600 ;   {DX 显示高度}

  DXCOLORDEPTH: integer = 8 ;     {DX 显示颜色数 8为256色}

  BufferCount: integer  = 1 ;     {反转表面个数}

  WindowMode: boolean   = false ; {DX 是用窗口模式，还是全屏模式}

  FDirectDraw : IDirectDraw7;            {DirectDraw 主界面}

  MainSurface : IDirectDrawSurface7;     {原始表面}

  FlipSurFace : IDirectDrawSurface7;     { 反转表面、离屏表面 }

implementation

{$R *.dfm}

{ TForm1 }

{ – 用回调函数保证选择的图形支持 DirectX – }

function EnumModesCallback( const EnumSurfaceDesc: TDDSurfaceDesc2;

                           Information: Pointer ): HResult; stdcall;

begin

  {如果宽、高和颜色深度与指定的常量中一样 ，那么显示模式可以被支持}

    if (EnumSurfaceDesc . dwHeight = DXHEIGHT) and

       (EnumSurfaceDesc . dwWidth = DXWIDTH) and

       (EnumSurfaceDesc . ddpfPixelFormat . dwRGBBitCount = DXCOLORDEPTH) then

      Boolean (Information^) := TRUE ;

  Result := DDENUMRET_OK;

end ;

{ – 当出现异常指令时，这个事件实现简单的背景反转 DGI 表面,这样例外对话框才能被看到 - }

procedure TForm_main . ExceptionHandler(Sender: TObject;

  ExceptionObj: Exception);

begin

  { 断开 OnIdle 事件,停止the rendering loop}

  Application . OnIdle := nil ;

  {如果 DirectDraw 对象已经建立，反转GDI表面 }

  if Assigned(FDirectDraw) then

    FDirectDraw . FlipToGDISurface;

  {显示异常消息}

  MessageDlg(ExceptionObj . Message, mtError, [mbOK], 0 );

  {重新连接 OnIdle 事件到 rendering loop}

  Application . OnIdle := AppIdle;

end ;

procedure TForm_main . AppIdle(Sender: TObject; var Done: Boolean );

begin

{ 表明程序将连续不断的调用些事件}

  Done := FALSE ;

  {如果 DirectDraw 没有初始化, 退出}

  if not Assigned(FDirectDraw) then Exit;

  {注： 这个小游戏的逻辑可以插入控制,如小精灵移动，碰撞，被发现}

  {画表面内容，反转表面}

  DrawSurfaces;

  FlipSurfaces;

end ;

procedure TForm_main . DrawSurfaces;

begin

{ – 此方法当表面要被画时调用 –

  – 它将连续不断的被 AppIdle 事件调用，所有场景，动画都在这个方法里面 - }

{这里将会是程序主要部份}

end ;

{ – 此方法将反转表面 - }

procedure TForm_main . FlipSurfaces;

var

  DXResult: HResult;

  rcSrc,rcDest:TRECT;

  P:TPoint;

begin

{ 执行页面反转。

  注 DDFLIP_WAIT 标记被用了，表明这个函数将不返回，

  只到页面反转已经执行,这将能使程序执行其它的进程，

  只到页面反转函数返回，然而，程序必不断的调用反转函数，保证

  反转成功 }

  if WindowMode then begin  //窗口模式

    P . X:= 0 ;P . y:= 0 ;

    P:=ClientToScreen(P);

    rcDest:=GetClientRect;

    OffsetRect(rcDest,P . x,P . y);

    SetRect(rcSrc, 0 , 0 ,DXWidth,DXHeight);

    DXResult := MainSurface . Blt(@rcDest, FlipSurFace, @rcSrc, DDBLT_WAIT, nil );

  end else   //全屏模式

    DXResult := MainSurface . Flip( nil , DDFLIP_WAIT);

  { 如果表面丢失，重装它们，其他错误，则引发异常

    这主要是针对全屏模式，窗口模式很少发生丢失情况  }

  if DXResult = DDERR_SURFACELOST then RestoreSurfaces

end ;

{ – 此方法当表面内存丢失时被调用 –

  – 并且必须重载。 表面在显示内存中包含了Bitmaps就必须重新初始化 – }

procedure TForm_main . RestoreSurfaces;

begin

  MainSurface . _Restore;

  FlipSurFace . _Restore;

(* 接下来代码是将相应的图形装入到 MainSurface 和 FlipSurFace 中*)

end ;

{ – 消息事件  – }

procedure TForm_main . AppMessage( var Msg: TMsg; var Handled: Boolean );

begin

  case Msg . Message of

    WM_ACTIVATEAPP:

      {如果窗口不是活动窗口进，停止动画}

      if not Boolean (Msg . wParam) then

         Application . OnIdle := nil

      else

        {如果变成活动窗口，发送自定义消息}

        PostMessage(Application . Handle, WM_DIRECTXACTIVATE, 0 , 0 );

    WM_DIRECTXACTIVATE:

      begin

        {收到自定义消息，重装所有界面(跟据需要重装他们的内存),重连 OnIdle 事件,

         重画所有表面    }

        RestoreSurfaces;

        Application . OnIdle := AppIdle;

        DrawSurfaces;

      end ;

    WM_SYSCOMMAND:

      begin

        {关闭屏保}

        Handled := (Msg . wParam = SC_SCREENSAVE);

      end ;

  end ;

end ;

{ - 创建，初始化 DX 对象为全屏模式 -}

procedure TForm_main . InitDirectDraw;

var

  {我们只能从DirectDraw 界面创建DirectDraw7，因些我们要一个临时的界面}

  TempDirectDraw: IDirectDraw;

  {创建DirectDraw7所需的数据结构}

  DDSurface: TDDSurfaceDesc2;

  DDSCaps: TDDSCaps2;

  {标志，用于决定图形模式是否支持}

  SupportedMode: Boolean ;

begin

  {如果 DirectDraw 已经初始化,退出}

  if Assigned(FDirectDraw) then exit;

  {创建临时的 DirectDraw 对象。这将用来创建需要的 DirectDraw7 对象  }

  DirectDrawCreate( nil , TempDirectDraw, nil );

  try

    {我们只能通过查询 DirectDraw 对象界面的方法来取得 DirectDraw7 界面 }

    TempDirectDraw . QueryInterface(IID_IDirectDraw4, FDirectDraw);

  finally

    {现在我们有了 DirectDraw7 对象, 临时 DirectDraw 对象就不在需要了 }

    TempDirectDraw := nil ;

  end ;

{调用 EnumDisplayModes 回调函数，检查显示模式是否支持 }

  FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

  DDSurface . dwSize   := SizeOf(TDDSurfaceDesc2);

  DDSurface . dwFlags  := DDSD_HEIGHT or DDSD_WIDTH or DDSD_PIXELFORMAT;

  DDSurface . dwHeight := DXHEIGHT;

  DDSurface . dwWidth  := DXWIDTH;

  DDSurface . ddpfPixelFormat . dwSize := SizeOf(TDDPixelFormat_DX6);

  DDSurface . ddpfPixelFormat . dwRGBBitCount := DXCOLORDEPTH;

  SupportedMode := FALSE ;

  FDirectDraw . EnumDisplayModes( 0 , @DDSurface, @SupportedMode,

                                        EnumModesCallback );

  {如果需要的显示模式不被DirectX支持,显示一个错误消息，并结束程序}

  if not SupportedMode then begin

    MessageBox(Handle, PChar ( 'The installed DirectX drivers do not support a ' +

               'display mode of: ' +IntToStr(DXWIDTH)+ ' X ' +

               IntToStr(DXHEIGHT)+ ', ' +IntToStr(DXCOLORDEPTH)+ ' bit color' ),

               'Unsupported Display Mode Error' , MB_ICONERROR or MB_OK);

    Close;

    Exit;

  end ;

  {设置合作水平，定义在常量中,为全屏幕式 }

  FDirectDraw . SetCooperativeLevel(Handle, COOPERATIVELEVEL);

  {设置显示模式,常量中定义 }

  FDirectDraw . SetDisplayMode(DXWIDTH, DXHEIGHT, DXCOLORDEPTH, 0 , 0 );

{初始化 DDSurface 结构， 指示我们将建立一个复杂的反转表面，

  并带一个后台缓冲表面 backbuffer }

  FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

  DDSurface . dwSize  := SizeOf(TDDSurfaceDesc2);

  DDSurface . dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;

  DDSurface . ddsCaps . dwCaps := SURFACETYPE;

  DDSurface . dwBackBufferCount := BUFFERCOUNT;

  {创建主表面对象}

  FDirectDraw . CreateSurface(DDSurface, MainSurface, nil );

{指出我们想建立一个后台缓冲表面（表面立刻到主表面反转链的后面）}

  FillChar(DDSCaps, SizeOf(TDDSCaps2), 0 );

  DDSCaps . dwCaps := DDSCAPS_BACKBUFFER;

  {取反转表面}

  MainSurface . GetAttachedSurface(DDSCaps, FlipSurFace) ;

  {在这一刻, 画面以外的缓冲器和其他表面将被建立。其他 DirectDraw 对象也将立刻建立

   如：调色板（palettes）。画面以外的缓冲器的内容也同时被初始化 }

end ;

{ - 创建，初始化 DX 对象为窗口模式

   下面注解只标注和全屏不同的地方,其它注解参看全屏模式

-}

procedure TForm_main . InitDirectDrawWindows;

var

  TempDirectDraw: IDirectDraw;

  DDSurface: TDDSurfaceDesc2;

  Clipper:IDirectDrawClipper;  //窗口模式下的Clipper:修剪

  SupportedMode: Boolean ;

begin

  if Assigned(FDirectDraw) then exit;

  DirectDrawCreate( nil , TempDirectDraw, nil );

  try

    TempDirectDraw . QueryInterface(IID_IDirectDraw4, FDirectDraw);

  finally

    TempDirectDraw := nil ;

  end ;

  FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

  DDSurface . dwSize   := SizeOf(TDDSurfaceDesc2);

  DDSurface . dwFlags  := DDSD_HEIGHT or DDSD_WIDTH or DDSD_PIXELFORMAT;

  DDSurface . dwHeight := DXHEIGHT;

  DDSurface . dwWidth  := DXWIDTH;

  DDSurface . ddpfPixelFormat . dwSize := SizeOf(TDDPixelFormat_DX6);

  DDSurface . ddpfPixelFormat . dwRGBBitCount := DXCOLORDEPTH;

  SupportedMode := FALSE ;

  FDirectDraw . EnumDisplayModes( 0 , @DDSurface, @SupportedMode,

                                        EnumModesCallback );

  {如果需要的显示模式不被DirectX支持,显示一个错误消息，并结束程序}

  if not SupportedMode then begin

    MessageBox(Handle, PChar ( 'The installed DirectX drivers do not support a ' +

               'display mode of: ' +IntToStr(DXWIDTH)+ ' X ' +

               IntToStr(DXHEIGHT)+ ', ' +IntToStr(DXCOLORDEPTH)+ ' bit color' ),

               'Unsupported Display Mode Error' , MB_ICONERROR or MB_OK);

    Close;

    Exit;

  end ;

  FDirectDraw . SetCooperativeLevel(Handle, DDSCL_NORMAL);

{ 窗口模式不需要设置显示模式，如果你一定要设置也行，但不是好事 }

//  FDirectDraw.SetDisplayMode(DXWIDTH, DXHEIGHT, DXCOLORDEPTH, 0, 0);

  FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

  DDSurface . dwSize  := SizeOf(TDDSurfaceDesc2);

  DDSurface . dwFlags := DDSD_CAPS;

  DDSurface . ddsCaps . dwCaps := DDSCAPS_PRIMARYSURFACE;

  FDirectDraw . CreateSurface(DDSurface,MainSurface, Nil );

  FillChar(DDSurface, SizeOf(TDDSurfaceDesc2), 0 );

  DDSurface . dwSize  := SizeOf(TDDSurfaceDesc2);

  DDSurface . dwFlags:=DDSD_WIDTH or DDSD_HEIGHT or DDSD_CAPS;

  DDSurface . dwWidth := 800 ;

  DDSurface . dwHeight := 600 ;

  DDSurface . ddsCaps . dwCaps := DDSCAPS_OFFSCREENPLAIN ;

  FDirectDraw . CreateSurface(DDSurface,FlipSurFace, nil );

{在窗口模式下，必须建立 Clipper ,作用是为了让 DX不要画出界( 别人如是说 )

  并使之依附在主表面上 }

  FDirectDraw . CreateClipper( 0 ,Clipper, nil );

{ 这里的 Handle 可以是控件 Handle，使用控件Handle 和窗体Handle

  在 FlipSurfaces 事件中将会有不同的操作 }

  Clipper . SetHWnd( 0 ,Handle);

  MainSurface . SetClipper(Clipper) ;

end ;

{ – 初始化窗口属性 – }

procedure TForm_main . FormCreate(Sender: TObject);

begin

  {设置程序的异常处理}

  Application . OnException := ExceptionHandler;

  { 初始化窗口属性,全屏模式和窗口模式要求不一样 }

  if WindowMode then begin

    BorderStyle := bsSingle;

    BorderIcons := [biSystemMenu,biMinimize];

   end else begin

    BorderStyle := bsNone;

    ShowCursor( FALSE );           { 不显示鼠标.  是否显式鼠标跟据你程序要求作决定 }

    FormStyle   := fsStayOnTop;  {  注：全屏模式 FormStyle属性必须是：fsStayOnTop}

    Cursor      := crNone;

    BorderIcons := [];

  end ;

end ;

procedure TForm_main . FormDestroy(Sender: TObject);

begin

  {释放异常处理的handler}

  Application . OnException := nil ;

  {显示鼠标}

  ShowCursor( TRUE );

  {记住, 我们没有明确的释放 DirectX 对象, 因为当他们失去上下文连接时，

   他们会自动释放，如当程序关闭时 }

end ;

procedure TForm_main . FormActivate(Sender: TObject);

begin

  if WindowMode then

    InitDirectDrawWindows else

    InitDirectDraw;

  Application . OnMessage := AppMessage;   //连接程序消息事件

  PostMessage(Handle, WM_ACTIVATEAPP, 1 , 0 );

  {发送一个消息，连接 OnIdle 事件,开始主循环 }

end ;

procedure TForm_main . FormKeyDown(Sender: TObject; var Key: Word ;

  Shift: TShiftState);

begin

  Case Key of

    VK_ESCAPE:Close;  //ESC

  end ;

end ;

end .

至此，你可以尝试写一点小小的动画了，如DX7 .0 例子中的小动画。

另，如果你想在全屏幕式下显示控件，比如按钮什么的，那么，你必须进行以下处理： 建立Clipper,依附在主表面上；然后改Flip为Blt。用了Clipper后，就不能用Flip了。

对于图形编程，就应该精通到对每一个象素点的操作。并且可以对每一个象素的R，G，B颜色分量进行操作。DX也应如何。

下面要说的就是，DX如何可以做到对每一个象素点的R、G、B分量进行操作。

var

  SourSf: IDirectDrawSurface7;

  SourSrfcInfo: TDDSurfaceDesc2;

  Sour: pointer ;

  SourSrfcInfo . dwSize := SizeOf(TDDSurfaceDesc2);

  SourSf . Lock( nil , SourSrfcInfo, DDLOCK_SURFACEMEMORYPTR or DDLOCK_WAIT, 0 );

//第一参数放nil,锁整个表面，也可以放@sRect 那么锁定的是 sRect 这个矩形了

   Sour:=SourSrfcInfo . lpSurface;

  SourSf . Unlock( nil );  //解锁

Sour就是SourSf的颜色值的起始地址。如果锁定的是矩形，返回的是矩形第一个点的地址。暂时放下这个Sour，先说说SourSrfcInfo结构。

这个数据结构在Lock之后，取得当前屏幕各种返回值，有些返回值非常重要。

ddpfPixelFormat . dwRGBBitCount 返回当前屏幕的颜色数，如 8 、 16 、 24 、 32 。这对于同时使用全屏非全屏的游戏来说很重要，因为非全屏时，你设置的屏幕大小颜色数是没用的，颜色数是跟据桌面的颜色数来定的，只有通这个值，你才能确定颜色数是多少。

    ddpfPixelFormat . dwRBitMask

    ddpfPixelFormat . dwGBitMask

    ddpfPixelFormat . dwBBitMask

这三个值是返回如何取得颜色RGB的分量。颜色值 and 上面其中一个值就可以取得其中一个分量。也许你会认为这是多此一举。象32bit： 00  RR  GG BB，这分的很清楚呀。但对于16bit来说，它就有 565 和 555 两种方法表示。虽然现在的显卡几乎 100 %是 565 ，但是作为程序员不能心存侥幸，用返回值来处理是 100 %正确（对于图形格式 555 和 565 不在讨论范围，请到网上找资料） 。《轩辕剑 5 》在联想的某种机型上采用窗口模式时不能正确抠图，其中原由未深究，程序员心存侥幸是一定的了。

这个数据结构还有很多值，请自己去查资料、慢慢体会了。

回过头来讲Sour这个变量。取得了首址，我们就可计算得到任何一点的地址值。DX中用的最多的是TRECT，一般也是跟据TRECT来找对应的地址，然后读取它的值。

为了使各种颜色数能通用。这里要增加一个变量：

RGBByteCount:= SourSrfcInfo . ddpfPixelFormat . dwRGBBitCount div 8 ;

这是因为颜色数为 8 bit 时，颜色值占一个 Byte , 16 bit 占 2 个 Byte ， 24 bit 占 3 个 byte ， 32bit占 4 个 Byte 。而指针加 1 只加一个 Byte 。

下面是锁定整个屏幕后，矩形srRect的首址计算方法。

var

  Sour,SrMem: pointer ;

  Sour:=SourSrfcInfo . lpSurface;

  SrMem:= Pointer ( Longint (Sour)+ srRect . Left *RGBByteCount+ SrRect . Top *SourSrfcInfo . lPitch );

第Y行的第一个象素的地址值：Sour := Pointer ( Longint (SrMem)+(SourSrfcInfo . lPitch )*Y );

讲了一大堆，取出来的还是地址，颜色值还是没有取出来，那颜色值怎么取呢？可以参照《Delphi Graphics and Game Programming Exposed with DirectX 7.0 》中 256 色的读法：

  TBytePtr = array [ 0..0 ] of Byte ;

  PBytePtr = ^TBytePtr;

var

  BackMem: PBytePtr；

begin

  BackMem := PBytePtr(Sour);  //第Y行的第一个象素的值

注， 256 色读取的不是颜色值，是索引值。要跟据索引值和颜色表找出对应RGB值。以下不再讨论 256 色。

同样对于 16 色 :

  TWordPtr = array [ 0..0 ] of word ;

  PWordPtr = ^TWordPtr;

16 色每个象素点占 2 个 Byte ,而 word 正好是 2 Byte ;

32 色每个象素占 4 个 Byte ，用Dword:

  TDWordPtr = array [ 0..0 ] of Dword;

  PDWordPtr = ^TDWordPtr;

麻烦来了， 24 色每个象素占 3 Byte ,而没有变量对应它。先定义一个3byte的数据结构，然后再如上定义。我想应该可以，但没做过试验。现在很多显卡不支持 24 色，可能也是这个原因吧。

另一种方法，用汇编通杀。强烈建议使用这种方法。

   asm

     push esi

     mov esi,Sour

     mov eax,[esi]

     ……

   end ;

这时，eax的值就是Sour指针对应的值。注意：这时读取的是一个Dword，然后再分吧， 1 个， 2 个， 3 个。用汇编能读多少就读多少，不要因为是 16 色，而写成这样 movzx edx, word ptr [esi]，如果用MMX能用 movq mm0,[esi] 一次读入一个8byte，就不要用movd mm0,[esi] 读入4byte。边界例外，要注意别读出界哦~~~（更多MMX请看我的另一篇笔记，网上有更多相关资料可供你查阅）。原因很简单，我在回答“我爱Pascal”的一个问题回答过：mov eax,[esi] 这样的东东是耗时大户，能少读一次是一次，而汇编其他的代码耗时很少，读入后再细分，代码是长点，但耗时绝对少。

值读出来了，进行一系列操作之后，要怎么写回去？这个应该不是问题了。只接把值写回到地址就行了。

   BackMem：= $0000FFFF ；

对于汇编

   asm

     ……

     mov [esi]，eax

     ……

   end ;

给出一个旋转图形特效代码，原理请看那本英文书或网上找资料。因为采用的反算法，每次只能读取计算一个点，因此无法运用上面说的能读几个点读几个点的美好想法。

var

  SinTable: array [ 0..359 ] of single ;     //旋转

  CosTable: array [ 0..359 ] of single ;

function ReadColor(Sour: pointer ;ByteCount: integer ): integer ;  //读取一个象素点的颜色值

begin

  case ByteCount of

    2 : asm                    //16bit

      mov eax,sour

      xor edx,edx           //edx清零

      mov dx,[eax]

      mov @result,edx

    end ;

    3 : asm                  //24bit,24就是麻烦

      mov eax,sour

      xor edx,edx

      movzx dx, byte ptr [eax+ 2 ]

      shl edx, 16

      mov dx, word ptr [eax]

      mov @result,edx

    end ;

    4 : asm                 //32 bit

      mov eax,sour

      mov edx,[eax]

      mov @result,edx

    end ;

  end ;

end ;

procedure writeColor(Dest: pointer ;sour: integer ;ByteCount: integer ); //写象素点

begin

  case ByteCount of

    2 : asm

      mov eax,Dest

      mov edx,sour

      mov [eax],dx

    end ;

    3 : asm

      mov eax,Dest

      mov edx,sour

      mov word ptr [eax],dx

      bswap edx

      mov byte ptr [eax+ 2 ],dh

    end ;

    4 : asm

      mov eax,Dest

      mov edx,sour

      mov [eax],edx

    end ;

  end ;

end ;



function RotateDraw(DestSf: IDirectDrawSurface7;

                     DsRect:TRect;                //目标区域大小、位置

                     SourSf: IDirectDrawSurface7;

                     SrRect:TRect;                 //源区域大小、位置

                     ColorKey: integer ;

                     UseColorKey: boolean ;

                     Theta: integer ):HResult;      //角度 用于Sin函数

var

  DestSrfcInfo, SourSrfcInfo: TDDSurfaceDesc2;

  DestX, DestY, SrcX, SrcY: Integer ;

  SinTheta, CosTheta: Single ;

  CenterX, CenterY: Single ;

  Dest, Sour, DsMem, SrMem: pointer ;

  Width,Height: integer ;

  aa: integer ;

begin

  if Theta< 0 then

    Theta:= 360 +(Theta mod 360 );

  Theta:=Theta mod 360 ;

  SinTheta := SinTable[Theta];

  CosTheta := CosTable[Theta];

  try

    SourSrfcInfo . dwSize := SizeOf(TDDSurfaceDesc2);

    Result:=SourSf . Lock( nil , SourSrfcInfo, DDLOCK_SURFACEMEMORYPTR or

                          DDLOCK_WAIT, 0 );

    DestSrfcInfo . dwSize := SizeOf(TDDSurfaceDesc2);

    Result:=DestSf . Lock(@DsRect, DestSrfcInfo, DDLOCK_SURFACEMEMORYPTR or

                          DDLOCK_WAIT, 0 );

    Sour:= pointer ( Longint (SourSrfcInfo . lpSurface)

                      + srRect . Left * RGBByteCount      //RGBByteCount 是公用变量，调用前要先计算好

                      + SrRect . Top * SourSrfcInfo . lPitch );

    Dest:= DestSrfcInfo . lpSurface;

    Width:=SrRect . Right-srRect . Left;

    Height:=SrRect . Bottom-SrRect . Top;

    CenterX := (Width / 2 );      //中心点

    CenterY := (Height / 2 );

    for DestY := 0 to Height- 1 do begin

      for DestX := 0 to Width- 1 do begin

        {通过目标坐标计算出对应的源坐标点,

        判断如果这点是在源点上，那么就画出来}

        SrcX := Trunc(CenterX + (DestX - CenterX)*CosTheta -

                      (DestY - CenterY)*SinTheta);

        SrcY := Trunc(CenterY + (DestX - CenterX)*SinTheta +

                      (DestY - CenterY)*CosTheta);

        {如果这点在源图形中}

        if (SrcX > 0 ) and (SrcX < Width) and

           (SrcY > 0 ) and (SrcY < Height) then begin

          {拷贝这点到目标点上}

          SrMem := pointer ( Longint (Sour)+ SrcY * SourSrfcInfo . lPitch

                               + SrcX * RGBByteCount);

          aa:=ReadColor(SrMem,RGBByteCount);

          DsMem := pointer ( Longint (Dest)+ DestY * DestSrfcInfo . lPitch

                               + DestX * RGBByteCount);

          if UseColorKey then begin     //是否抠图

            if aa<>ColorKey then

              writeColor(DsMem,aa,RGBByteCount);

          end else

             writeColor(DsMem,aa,RGBByteCount);

        end ;

      end ;

    end ;

  finally

    DestSf . Unlock( nil );

    SourSf . Unlock( nil );

  end ;

end ;

initialization      //在程序一开始运行时先计算好旋转要用的数组

  for iAngle := 0 to 359 do  begin

    SinTable[iAngle] := Sin(iAngle*(PI/ 180 ));

    CosTable[iAngle] := Cos(iAngle*(PI/ 180 ));

  end ;

end .

调用：借用（三）中的框架代码，这里不再重复。注意恢复表面时，要重载图形。

var

  Theta: integer = 0 ;

  TickCount:Dword;

procedure TForm_main . DrawSurfaces;

var

  SrcRect:TRect;

  sRect,aRect:TRect;

  thisTickCount : DWORD;

begin

  thisTickCount := GetTickCount;

  if (thisTickCount - TickCount) > 50 then begin

    TickCount:=thisTickCount;

    dec(Theta, 2 );

  end ;

  sRect:=Rect( 0 , 0 , 110 , 110 );   //源矩形大小，这里别照抄，要跟据你图形大小定

  SrcRect:=Rect( 0 , 0 , 110 , 110 );

  offsetRect(SrcRect, 260 , 30 ); //目标矩形大小，移到(260，30)位置

  RotateDraw(FlipSurFace,SrcRect ,TempSurFace,sRect, 0 , true ,Theta);

end ;

最后说说FPS，这是一个很重要的东西，编写游戏的水平就看这个指标，每秒画多少帧画面。

放一个TTimer控件在窗体上，Interval 设为 100 。

var

   FrameRate: integer ;

   FOldTime2:Dword;

   FPS: integer ;

procedure TForm_main . Timer1Timer(Sender: TObject);

var

  t: DWORD;

  i: integer ;

begin

  t := TimeGetTime;

  i := Max(t-FOldTime2, 1 );

  if i> 1000 then begin

    FPS := Round(FrameRate* 1000 /i);

    FrameRate:= 0 ;

    FOldTime2 := t;

  end ;

end ;

在DrawSurfaces中用文字写出来FPS 值就行了。

-----------------------------------------------------

对于游戏来说，还有声音，输入设备，网络连接，力反馈等等。这些东西就不多讲了。请见谅。

声音处理跟图象处理差不多，建立过程也相似；键盘、鼠标的操作也不是难事。知道DX原理之后，就一通百通。力反馈没有研究，因为没有条件。至于网络，没写过即时战斗游戏也就用不上IPX连网了，也没研究，无权发言。以上所写仅给致力于游戏编程而苦于无法入门的朋友。

只是游戏开发远没有这么简单。首先美工关不是我们程序员能处理的，声音资源也不是我们能把握的。我们能处理的只是代码。就代码而言： 1 、至少要知道汇编，否则你无法优化你的程序。可以参看日本人写的DelphiX控件里面的汇编，你会受益非浅；写个简短的程序，然后调出CPU窗口，只接看汇编代码。 2 、能看懂C语言，必竟游戏是C的天下，源代码N多； 3 、还必须知道一些计算机图形原理，这是因为要进行图形特效处理，你不可能指望美工把各种可能的图形都画好供你调用，甚至不用抠图。FASTBMP控件是个很好的参考，它带有许多图形特效。如果你不想用DX写游戏，甚至可以用它来开发出不错的游戏。而代码竟然跟DX也差不多（初始化除外）。