Delphi,在DelphiXE下使用DirectX的初步摸索

最新推荐文章于 2024-09-05 23:09:34 发布

NumberTop

最新推荐文章于 2024-09-05 23:09:34 发布

阅读量335

点赞数 5

分类专栏：游戏文章标签： windows 开发语言

本文链接：https://blog.csdn.net/NumberTop/article/details/139710467

版权

游戏专栏收录该内容

3 篇文章 0 订阅

订阅专栏

昨天刚安装了 DelphiXE ， Delphi2010以上的版本自带了 DirectX 的SDK。

不多说了，先上代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Direct3D8, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Device : IDirect3DDevice8;
  pd3d   : IDirect3D8;
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  parms : D3DPRESENT_PARAMETERS ;
  hr : HRESULT ;
begin
  memo1.Clear;
  pd3d := Direct3DCreate8 ( D3D_SDK_VERSION ) ;

  parms.BackBufferWidth := 0 ;
  parms.BackBufferHeight := 0 ;
  parms.BackBufferFormat := D3DFMT_A8R8G8B8 ;
  parms.BackBufferCount := 1 ;
  parms.MultiSampleType := D3DMULTISAMPLE_NONE ;
  parms.SwapEffect := D3DSWAPEFFECT_COPY ;
  parms.Windowed := TRUE ;
  parms.hDeviceWindow := Self.Handle ;
  parms.EnableAutoDepthStencil := FALSE ;
  parms.AutoDepthStencilFormat := D3DFMT_UNKNOWN ;
  parms.Flags := 0 ;
  parms.FullScreen_RefreshRateInHz := 0 ;
  parms.FullScreen_PresentationInterval := D3DPRESENT_INTERVAL_DEFAULT ;

  hr := pd3d.CreateDevice( D3DADAPTER_DEFAULT , D3DDEVTYPE_REF , Self.Handle , D3DCREATE_SOFTWARE_VERTEXPROCESSING , parms , Device ) ;
  if ( FAILED ( hr ) )  then
  begin
    Memo1.Lines.Add('不能创建 HAL 设备!') ;
    hr := pd3d.CreateDevice( D3DADAPTER_DEFAULT , D3DDEVTYPE_REF , Self.Handle , D3DCREATE_SOFTWARE_VERTEXPROCESSING , parms , Device ) ;
    if ( FAILED ( hr ) ) then
    begin
      Memo1.Lines.Add('不能创建 REF 设备!') ;
      Self.Close ;
    end
    else
    begin
      Memo1.Lines.Add('成功创建 REF 设备') ;
    end;
  end
  else
  begin
    Memo1.Lines.Add ('成功创建 HAL 设备') ;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Device <> nil then      //用完要记得放掉
    Device := nil;
  if pd3d <> nil then
    pd3d := nil;
end;

end.
//窗体文件
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 282
  ClientWidth = 418
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 16
    Top = 24
    Width = 377
    Height = 250
    Lines.Strings = (
     '')
    TabOrder = 0
  end
end