Delphi 环境下使用DirectDraw实现简单的绘制

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

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

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

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

program Test_6_1;usesWindows,Messages,DirectX, DXDraws,uUtil in '..\Library\DirectDraw_demo\uUtil.pas';const
//set the resolution of displayer of youSCREEN_WIDTH = 1920;SCREEN_HEIGHT = 1080;                    varMyClassName : string;MyWindowName : string;vargbl_MSG : MSG;gbl_HDC : HDC;gbl_HW : HWND;gbl_hinst : HINST;varFDirectDrawSurface : TDirectDrawSurface;FDirectDraw : TDirectDraw;ddsd : TDDSurfaceDesc_DX6;//call back function
function MyWndProc(hW: HWnd; messages: UInt; wParams: WPARAM; lParams: LPARAM): LRESULT; stdcall;
varps : PAINTSTRUCT;local_hdc : HDC;
beginResult := 0;case messages ofWM_COMMAND:beginend;WM_PAINT:beginlocal_hdc := BeginPaint(hW, ps);EndPaint(hW, ps);end;WM_DESTROY:beginPostQuitMessage(0);endelseResult := DefWindowProc(hW, messages, wParams, lParams);end;
end;//initialize
function Game_Init(pParam: PChar = nil; num_Params : Integer = 0): Integer;
beginRandomize;//create a instance of TDirectDraw，use DDraw7 by defaultFDirectDraw := 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_exclusiveFDirectDraw.IDDraw7.SetCooperativeLevel(gbl_HW, DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE or DDSCL_ALLOWREBOOT);//set display modeFDirectDraw.IDDraw7.SetDisplayMode(SCREEN_WIDTH, SCREEN_HEIGHT, 16, 0, 0);FDirectDrawSurface := TDirectDrawSurface.Create(FDirectDraw);//fill structure TDDSurfaceDescFillChar(ddsd, SizeOf(TDDSurfaceDesc_DX6), #0);ddsd.dwSize := SizeOf(TDDSurfaceDesc_DX6);ddsd.dwFlags := DDSD_CAPS;ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;//create surfaceFDirectDrawSurface.CreateSurface(ddsd);end;//finalize
function Game_ShutDown(pParam: PChar = nil; num_Params : Integer = 0): Integer;
beginif Assigned(FDirectDraw) thenbeginFDirectDraw.Free;FDirectDraw := nil;end;if Assigned(FDirectDrawSurface) thenbeginFDirectDrawSurface.Free;FDirectDrawSurface := nil;end;
end;//game loop
function Game_Main(pParam: PChar = nil; num_Params : Integer = 0): Integer;
varddsd : TDDSurfaceDesc_DX6;iPitch : Integer;pSurface : PChar;i, x, y: Integer;color : COLOR16;
beginif KeyDown(VK_ESCAPE) thenSendMessage(gbl_HW, WM_CLOSE, 0, 0);FillChar(ddsd, SizeOf(TDDSurfaceDesc_DX6), #0);ddsd.dwSize := Sizeof(TDDSurfaceDesc_DX6);//lockFDirectDrawSurface.Lock(ddsd);iPitch := ddsd.lPitch;pSurface := ddsd.lpSurface;color := RGB(255, 0, 0);for i := 0 to 1000 - 1 dobeginx := Random(SCREEN_WIDTH) * 2;y := Random(SCREEN_HEIGHT);move(color, pSurface[x + y * iPitch], SizeOf(COLOR16));end;//unlockFDirectDrawSurface.UnLock;end;{$R *.res}// main loop
begingbl_hinst := GetModuleHandle(nil);MyClassName := 'Test';MyWindowName := 'MyTest_6_1';if MyRegisterClass(gbl_hinst, @MyWndProc, PChar(MyClassName)) = 0 thenbeginMessageBox(0, 'RegisterClass defeat', 'Error', MB_OKCANCEL);Exit;end;if not InitInstance(gbl_hinst, SW_SHOW, PChar(MyClassName), PChar(MyWindowName), gbl_HW) thenbeginMessageBox(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) dobeginTranslateMessage(gbl_MSG);DispatchMessage(gbl_MSG);Game_Main();end;Game_ShutDown();end.

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

unit uUtil;interfaceusesWindows, 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;
beginResult := GetAsyncKeyState(Key) <> 0;
end;function MyRegisterClass(hInst : HINST; pProc: Pointer; pClassName : PChar): WORD;
varwclass: TWndClassEx;
begin//Don't forget to set all the properties, or you will failed to registerwclass.cbSize := SizeOf(WNDCLASSEXW);                                 //set size of this structurewclass.style := CS_HREDRAW or CS_VREDRAW;                             //set style of general property of this formwclass.lpfnWndProc := pProc;                                         //callback functionwclass.cbClsExtra := 0;wclass.cbWndExtra := 0;wclass.hInstance := hInst;                                           //set instancewclass.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 iconResult := RegisterClassEx(wclass);
end;function MyRegisterClass(const wClass : TWndClassEx): WORD;
beginResult := RegisterClassEx(wClass);
end;function InitInstance(hInst : HINST; nCmdShow : Integer; pClassName, pWindowName: PChar; out hW : HWND): Boolean;
beginResult := False;hW := CreateWindow(pClassName, pWindowName, WS_OVERLAPPEDWINDOW,CW_USEDEFAULT, 0, CW_USEDEFAULT, 0, 0, 0, hInst, nil);if hW <> 0 thenbeginShowWindow(hW, nCmdShow);UpdateWindow(hW);Result := True;end;
end;end.

注意：请将：

constSCREEN_WIDTH = 1920;SCREEN_HEIGHT = 1080;

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

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

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

Delphi 环境下使用DirectDraw实现简单的绘制相关推荐

初学Arduino环境下WeMos D1制造简单智能垃圾桶项目（蜂鸣器、 SG90舵机、超声波模块）
初学Arduino环境下WeMos D1制造简单智能垃圾桶项目(蜂鸣器. SG90舵机.超声波模块) 项目代码 #include <Servo.h> #define DuoPIN D5 # ...
Ubuntu环境下使用gnuplot由数据表绘制曲线图
在ubuntu中安装NS-3之后,编译DASH仿真器Simulation,在由自适应算法得到仿真结果后可以直接导出数据表,包含仿真时间.每次跳转的视频切片的BitRate等等,这时候可以在Linux环 ...
Thrift 在Windows环境下的编译与简单C++应用
前言 Thrift是Facebook提供的一个跨语言的服务部署框架,可以实现客户端和服务器远程过程调用.相较于Google的grpc框架,Thrift对三方库依赖更少,编译更简单,并且运行效率也更高. ...
在Windows环境下MongoDB搭建和简单操作
更多总结内容参考:怎么样MongoDB搭建Java环境-总结下面主要是在Windows上(WinXP)安装.运行.安装Windows服务的笔记,以作备忘. 1.下载下载地址:http://www. ...
VS2017环境下配置OpenGL的简单方法（glut,glew,freeglut,gltools）
写在前面: 最近要用到OpenGL,光是在VS2015下配置就费了很大的劲,现在将我的成果直接贡献给大家,希望能为需要在VS2015下配置OpenGL的读者省去一些麻烦. 正文: 资源地址1:http ...
LINUX下UDP实现消息镜像通信,linux环境下基于udp socket简单聊天通信
客户端代码:client.c /* * File: main.c * Author: guanyy * * Created on 20161202 * * 主要实现:客户端和服务端相互通信 */ #i ...
php stomp rabbitmq,docker环境下的RabbitMQ部署，Spring AMQP使用
AMQP简介 AMQP,即 Advanced Message Queuing Protocol,高级消息队列协议,是应用层协议的一个开放标准,为面向消息的中间件设计.消息中间件主要用于组件之间的解耦和 ...
Java微服务开发指南-Java环境下的微服务
本文涉及的内容,能让你学到什么? 本书适用于开发微服务的Java开发人员和架构师.我们在开始介绍微服务架构前,先讲述一些抽象的基本概念.不幸的是,使用新技术并不能神奇地解决分布式系统问题.但是我们通过 ...
Java微服务开发指南 -- Java环境下的微服务
Java环境下的微服务本文涉及的内容,能让你学到什么? 本书适用于开发微服务的Java开发人员和架构师.我们在开始介绍微服务架构前,先讲述一些抽象的基本概念.不幸的是,使用新技术并不能神奇地解决分布 ...

Delphi 环境下使用DirectDraw实现简单的绘制

Delphi 环境下使用DirectDraw实现简单的绘制相关推荐

最新文章

热门文章