Delphi 环境下使用DirectDraw实现简单的全屏游戏

注：demo来源于《windows游戏编程大师技巧》demo6-3，本文章用Delphi实现该demo。

首先，使用Windows API函数实现原生态窗体，然后调用DDraw类实现效果。

部分注释用英文写在代码里（为了能无障碍看懂英文文档，所以在边学代码边学好英语，呵呵~~）

运行效果为，循环随机在全屏幕上绘制像素点：

program Test_6_1;uses  Windows,  Messages,  DirectX, DXDraws,  uUtil in '..\Library\DirectDraw_demo\uUtil.pas';const//set the resolution of displayer of you  SCREEN_WIDTH = 1920;  SCREEN_HEIGHT = 1080;                    var  MyClassName : string;  MyWindowName : string;var  gbl_MSG : MSG;  gbl_HDC : HDC;  gbl_HW : HWND;  gbl_hinst : HINST;var  FDirectDrawSurface : TDirectDrawSurface;  FDirectDraw : TDirectDraw;  ddsd : TDDSurfaceDesc_DX6;//call back functionfunction MyWndProc(hW: HWnd; messages: UInt; wParams: WPARAM; lParams: LPARAM): LRESULT; stdcall;var  ps : PAINTSTRUCT;  local_hdc : HDC;begin  Result := 0;  case messages of    WM_COMMAND:    begin    end;    WM_PAINT:    begin      local_hdc := BeginPaint(hW, ps);      EndPaint(hW, ps);    end;    WM_DESTROY:    begin      PostQuitMessage(0);    end  else    Result := DefWindowProc(hW, messages, wParams, lParams);  end;end;//initializefunction Game_Init(pParam: PChar = nil; num_Params : Integer = 0): Integer;begin  Randomize;  //create a instance of TDirectDraw，use DDraw7 by default  FDirectDraw := TDirectDraw.Create(nil);  //set ccoperative level between window and dx  //you can simply set flag to ddscl_normal, to be a windowed game  //if you use ddscl_fullscreen please ddscl_exclusive  FDirectDraw.IDDraw7.SetCooperativeLevel(gbl_HW, DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE or DDSCL_ALLOWREBOOT);  //set display mode  FDirectDraw.IDDraw7.SetDisplayMode(SCREEN_WIDTH, SCREEN_HEIGHT, 16, 0, 0);  FDirectDrawSurface := TDirectDrawSurface.Create(FDirectDraw);  //fill structure TDDSurfaceDesc  FillChar(ddsd, SizeOf(TDDSurfaceDesc_DX6), #0);  ddsd.dwSize := SizeOf(TDDSurfaceDesc_DX6);  ddsd.dwFlags := DDSD_CAPS;  ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;  //create surface  FDirectDrawSurface.CreateSurface(ddsd);end;//finalizefunction Game_ShutDown(pParam: PChar = nil; num_Params : Integer = 0): Integer;begin  if Assigned(FDirectDraw) then  begin    FDirectDraw.Free;    FDirectDraw := nil;  end;  if Assigned(FDirectDrawSurface) then  begin    FDirectDrawSurface.Free;    FDirectDrawSurface := nil;  end;end;//game loopfunction Game_Main(pParam: PChar = nil; num_Params : Integer = 0): Integer;var  ddsd : TDDSurfaceDesc_DX6;  iPitch : Integer;  pSurface : PChar;  i, x, y: Integer;  color : COLOR16;begin  if KeyDown(VK_ESCAPE) then    SendMessage(gbl_HW, WM_CLOSE, 0, 0);  FillChar(ddsd, SizeOf(TDDSurfaceDesc_DX6), #0);  ddsd.dwSize := Sizeof(TDDSurfaceDesc_DX6);  //lock  FDirectDrawSurface.Lock(ddsd);  iPitch := ddsd.lPitch;  pSurface := ddsd.lpSurface;  color := RGB(255, 0, 0);  for i := 0 to 1000 - 1 do  begin    x := Random(SCREEN_WIDTH) * 2;    y := Random(SCREEN_HEIGHT);    move(color, pSurface[x + y * iPitch], SizeOf(COLOR16));  end;  //unlock  FDirectDrawSurface.UnLock;end;{$R *.res}// main loopbegin  gbl_hinst := GetModuleHandle(nil);  MyClassName := 'Test';  MyWindowName := 'MyTest_6_1';  if MyRegisterClass(gbl_hinst, @MyWndProc, PChar(MyClassName)) = 0 then  begin    MessageBox(0, 'RegisterClass defeat', 'Error', MB_OKCANCEL);    Exit;  end;  if not InitInstance(gbl_hinst, SW_SHOW, PChar(MyClassName), PChar(MyWindowName), gbl_HW) then  begin    MessageBox(0, 'InitInstance defeat', 'Error', MB_OKCANCEL);    Exit;  end;  Game_Init();  //if use peekmessage,please add one line code : 'Sleep(100);' ,used to slow the effect//  while True do//  begin//    if PeekMessage(gbl_MSG, 0, 0, 0, PM_REMOVE) then//    begin//      if gbl_MSG.message = WM_QUIT then//        Break;////      TranslateMessage(gbl_MSG);//      DispatchMessage(gbl_MSG);//    end;////    Game_Main();//  end;  while GetMessage(gbl_MSG, 0, 0, 0) do  begin    TranslateMessage(gbl_MSG);    DispatchMessage(gbl_MSG);    Game_Main();  end;  Game_ShutDown();end.

然后，请包含下面这个单元：

unit uUtil;interfaceuses  Windows, Messages;function KeyDown(const Key : Integer): Boolean;function MyRegisterClass(hInst : HINST; pProc: Pointer; pClassName : PChar): WORD; overload;function MyRegisterClass(const wClass : TWndClassEx): WORD; overload;function InitInstance(hInst : HINST; nCmdShow : Integer; pClassName, pWindowName : PChar; out hW : HWND): Boolean;implementationfunction KeyDown(const Key : Integer): Boolean;begin  Result := GetAsyncKeyState(Key) <> 0;end;function MyRegisterClass(hInst : HINST; pProc: Pointer; pClassName : PChar): WORD;var  wclass: TWndClassEx;begin  //Don't forget to set all the properties, or you will failed to register  wclass.cbSize := SizeOf(WNDCLASSEXW);                                 //set size of this structure  wclass.style := CS_HREDRAW or CS_VREDRAW;                             //set style of general property of this form  wclass.lpfnWndProc := pProc;                                         //callback function  wclass.cbClsExtra := 0;  wclass.cbWndExtra := 0;  wclass.hInstance := hInst;                                           //set instance  wclass.hIcon := LoadIcon(0, IDI_APPLICATION);  wclass.hCursor := LoadCursor(0, IDC_ARROW);  wclass.hbrBackground := GetStockObject(WHITE_BRUSH);  wclass.lpszMenuName := nil;  wclass.lpszClassName := pClassName;  wclass.hIconSm := LoadIcon(wclass.hInstance, MAKEINTRESOURCE(0));   //set small icon  Result := RegisterClassEx(wclass);end;function MyRegisterClass(const wClass : TWndClassEx): WORD;begin  Result := RegisterClassEx(wClass);end;function InitInstance(hInst : HINST; nCmdShow : Integer; pClassName, pWindowName: PChar; out hW : HWND): Boolean;begin  Result := False;  hW := CreateWindow(pClassName, pWindowName, WS_OVERLAPPEDWINDOW,      CW_USEDEFAULT, 0, CW_USEDEFAULT, 0, 0, 0, hInst, nil);  if hW <> 0 then  begin    ShowWindow(hW, nCmdShow);    UpdateWindow(hW);    Result := True;  end;end;end.

注意：请将：

const  SCREEN_WIDTH = 1920;  SCREEN_HEIGHT = 1080;   

设置为你电脑当前的分辨率，否者效果可能会有问题。

另外，不要用在win10系统下使用或者学习，因为win10已经将DDraw抛弃（集成到d3d中去了）。我在win10下试验过，显示效果会有问题。

最后，请包含一下DelphiX中的DirectX, DXDraws单元，或者编译一下DelphiX的dpk工程文件，即可编译通过。DelphiX源代码网上有很多前辈已经共享过，下载下来即可。（我也上传了DelphiX全部源代码，访问我的资源页能找到。）