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

//initialize
function 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;

//finalize
function 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 loop
function 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 loop
begin
  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;

interface

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


implementation


function 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全部源代码，访问我的资源页能找到。）