Code:
//------------------------------------------------------
// VCL-DIRECT X In Practice
//------------------------------------------------------
// Code : Arius Myst
// Desc : Sets Up And Initializes A Device ( Full ).
//------------------------------------------------------
// Files Needed:
//------------------------------------------------------
// Headers : Clooties DirectX 9 Headers
// Common : Clooties Common Framework
// Url : HTTP://CLOOTIE.NAROD.RU
//------------------------------------------------------
// Comment : This file was written using the C++
// tutorials present in the DirectX 9
// SDK Documentation as a base theory.
// Clooties Delphi samples were used as
// reference material when i was unsure
// of Delphi - C++ Comparisons.
//------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Direct3d9, D3DX9, ExtCtrls;
// Uses Clause, Added The Following:
// Direct3d9
// D3DX9
type
TForm1 = class(TForm)
Timer1: TTimer;
Timer2: TTimer;
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
// ...::: Private Declarations :::...
public
// ...::: Public Declarations :::...
Procedure Render(); // Render Procedure : Called EveryTime We Want To Render A Frame.
Procedure CleanUp(); // CleanUp Procedure : Called When The Program Terminates.
Procedure Err(Cm: String); // Error Procedure : Called When We Catch An Error.
Procedure Diag(); // We Will Call This Every Render Pass. Draws Text To Screen.
end;
var
Form1 : TForm1; // Form1 : Delphi Generated Application Window. We Will Use It As Our Screen.
GfxDevice : IDirect3DDevice9 = Nil; // GfxDevice : The Systems Graphics Chip.
D3DObj : IDirect3D9 = Nil; // D3DObj : Direct3D Object. Will Be Used To Create GfxDevice.
TextFnt : ID3DXFont; // TextFnt : DirectX Font.
FontObj : TFont; // FontObj : Font Object.
FPS : Integer; // FPS : Will Count The Frames.
FPS2 : Integer; // FPS2 : Will Hold The Amount Of Frames Counted In FPS For Every Second.
TxtRect : TRect; // TxtRect : Rect For Holding Our Text.
Full : HWnd;
Inst : HInst;
implementation
{$R *.dfm}
//-------------- ...::: Diag :::... -----------------
//
// Type: Custom Procedure
// Desc: Displays Diagnostics. Including Frame Per Second.
//
//-----------------------------------------------------------
Procedure TForm1.Diag();
Begin
TxtRect.Left := 0;
TxtRect.Right := 100;
TxtRect.Top := 0;
TxtRect.Bottom := 40;
//TextFnt.InitDeviceObjects(GfxDevice);
TextFnt._Begin;
TextFnt.DrawTextA(PChar(' [ VCL - DirectX 9 ] '#10+' [ FPS ] '+IntToStr(FPS2)), -1, TxtRect, DT_LEFT, D3DColor_XRGB( 147, 203, 255 ));
TextFnt._End;
End;
//-------------- ...::: Err :::... -----------------
//
// Type: Custom Procedure
// Desc: Displays An Error Message And Terminates The
// Application.
//
//-----------------------------------------------------------
Procedure TForm1.Err(Cm: String);
Begin
ShowMessage(Cm);
Close;
End;
//-------------- ...::: Initialize :::... -----------------
//
// Type: Function
// Desc: Initializes The Device To The Given Window Handle.
//
//-----------------------------------------------------------
Function Initialize(Window: hWnd): HRESULT;
Var
Present: TD3DPresentParameters; // Present : Settings For The Display
Begin
// D3D Object Initialization:
//---------------------------
D3DObj := Direct3DCreate9( D3D_SDK_VERSION ); // Create Our Direct3D Object
If (D3DObj = Nil) Then Form1.Err('Failed To Initialize D3DObj( Direct3D Object ) - Line 63'); // If The Creation Of Our Object Fails, We Call The "Err" Custom Procedure With A String Describing The Problem
//---------------------------
// D3D Object Finished
// Present Initialization:
//---------------------------
FillChar(Present, SizeOf(Present), 0); // Allocate Memory For Present( Because Its A Structure Of Bytes ). ?????????? Could Be Wrong ??????????
Present.Windowed := True; // We Want A Windowed Display As Opposed To A Fullscreen One.
Present.SwapEffect := D3DSwapEffect_Discard; // Fills Buffer With Noise After It Has Been Presented( Displayed On Screen/Flipped ).
Present.BackBufferFormat := D3DFMT_Unknown; // We Are In Windowed Mode And Want To Use The Current Display Mode Format.
//---------------------------
// Present Finished
// Gfx Device Initialization:
//---------------------------
Result := D3DObj.CreateDevice( D3DAdapter_Default, D3DDevType_HAL, Window, D3DCreate_Software_VertexProcessing, @Present, GfxDevice); // Initializes GfxDevice. For A More In-Depth Description See The Dx9 SDK.
If Failed( Result ) then // If The Device Failed To Initialize
Begin
Result := E_FAIL; // Function Result Becomes E_FAIL
Form1.Err('Device Failed To Initialize, GfxDevice - Line 85'); // We Call Our Error Procedure Once More
End;
//SetCooperativeLevel( Window, DDSCL_EXCLUSIVE );
//SetDisplayMode(800, 600, 32);
// TextFnt Initialization:
//---------------------------
FontObj := TFont.Create();
With FontObj Do
Begin
Name := 'Tahoma';
Size := 8;
End;
D3DXCreateFont(GfxDevice, FontObj.Handle, TextFnt);
//TextFnt.InitDeviceObjects(GfxDevice);
//---------------------------
// TextFnt Finished
End;
//-------------- ...::: Render :::... -----------------
//
// Type: Custom Procedure
// Desc: Fills The Back Buffer With A Colour And Then
// flips The Buffers, Displaying The Colour In
// its wake.
//
//-----------------------------------------------------------
Procedure TForm1.Render;
Begin
GfxDevice.Clear(0, nil, D3DClear_Target, D3DColor_XRGB( 46, 66, 90 ), 1.0, 0); // Clear The BackBuffer To A Dark Pascal Blue.
GfxDevice.BeginScene; // Begins The Scene.
// Calls To Loops Of Graphics/Scenes Can Go Here.
Diag();
GfxDevice.EndScene; // Ends The Scene.
GfxDevice.Present(Nil, Nil, 0, Nil);
FPS := FPS + 1; // We Add One To Our FrameCount
End;
//-------------- ...::: Cleanup :::... -----------------
//
// Type: Custom Procedure
// Desc: Releases Created Objects. Modded Clootie Code:
//
//-----------------------------------------------------------
Procedure TForm1.CleanUp;
Begin
if (GfxDevice <> nil) then
{$IFDEF TMT}
GfxDevice.Release;
{$ELSE}
GfxDevice := nil;
{$ENDIF}
if (D3DObj <> nil) then
{$IFDEF TMT}
D3DObj.Release;
{$ELSE}
D3DObj := nil;
{$ENDIF}
End;
procedure TForm1.FormShow(Sender: TObject);
begin
FPS := 0;
//Full := CreateWindowEx(WS_EX_PALETTEWINDOW, 'h', '', WS_POPUP,
// 0, 0, {screen.width, screen.height}50, 50, 0, 0, Inst, nil);
Initialize(Form1.Handle); // We Want To Use Form1 As A Drawing Surface
ShowWindow(Full, SW_SHOW);
Timer1.Enabled := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.Title := 'VCL-DIRECT X In Practice'; // Added Purely To Keep Things Clean.
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Timer1.Enabled := False;
Timer2.Enabled := False;
Cleanup();
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer2.Enabled := True; // We Enable Timer2. Timer2 Fills Our "FPS2" Integer With The FrameCount At Second Intervals.
Render; // As We Aren't Actually Rendering Anything. I've Added The Render Call Here.
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
FPS2 := FPS;
FPS := 0;
end;
End.
At the moment its in a window. But do i need to set up the reolution and colout depth before switching to fullscreen and if so how?.
Bookmarks