24.06.2011, 20:41
|
Прохожий
|
|
Регистрация: 24.06.2011
Сообщения: 7
Репутация: 10
|
|
Помогите з direct x в delphi
direct x просто не запускається . вот код програми:
Код:
unit MAIN;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
ActnList, ToolWin, ImgList,direct3d9, AppEvnts;
type
TMainForm = class(TForm)
ApplicationEventsmain: TApplicationEvents;
procedure FileNew1Execute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApplicationEventsmainIdle(Sender: TObject; var Done: Boolean);
procedure ApplicationEventsmainMinimize(Sender: TObject);
procedure ApplicationEventsmainRestore(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
fd3d:idirect3d9;
fd3ddevice:idirect3ddevice9;
factive:boolean;
function InitD3D: HResult;
function cleardevice:Hresult;
function renderscene:Hresult;
procedure freed3d;
procedure CreateMDIChild(const Name: string);
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses CHILDWIN, about;
procedure TMainForm.CreateMDIChild(const Name: string);
var
Child: TMDIChild;
begin
{ create a new MDI child window }
Child := TMDIChild.Create(Application);
Child.Caption := Name;
if FileExists(Name) then Child.Memo1.Lines.LoadFromFile(Name);
end;
procedure TMainForm.FileNew1Execute(Sender: TObject);
begin
CreateMDIChild('NONAME' + IntToStr(MDIChildCount + 1));
end;
function TMainForm.InitD3D :Hresult;
var d3ddisplayinfo:Td3ddisplaymode;
d3dparameters:Td3dpresentparameters;
begin
result:=e_fail;
fd3d:=direct3dcreate9(d3d_sdk_version);
if fd3d=nil then exit;
result:=Fd3d.GetAdapterDisplayMode(d3dAdapter_default,d3ddisplayinfo);
if failed(result) then exit;
zeromemory(@d3dparameters,sizeof(d3dparameters));
d3dparameters.windowed:=true;
d3dparameters.SwapEffect:=d3dswapeffect_discard;
d3dparameters.BackBufferFormat:=d3ddisplayinfo.Format;
result:=fd3d.CreateDevice(D3DADAPTER_DEFAULT, d3ddevtype_hal, handle, d3dcreate_software_vertexprocessing, @d3dparameters, fd3ddevice);
end;
procedure Tmainform.freed3d;
begin
fd3ddevice:=nil;
fd3d:=nil;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
if failed(initd3d) then
begin
showmessage('drx error');
halt;
end;
end;
procedure Tmainform.FormDestroy(sender:Tobject);
begin
freed3d;
end;
function Tmainform.cleardevice:Hresult;
begin
result:=e_fail;
if fd3ddevice=nil then exit;
result:=fd3ddevice.clear(0,nil,d3dclear_target,d3dcolor_xrgb(0,0,0),1,0);
end;
function Tmainform.renderscene:Hresult;
begin
result:=cleardevice;
if failed(result) then exit;
fd3ddevice.Present(nil,nil,0,nil);
end;
procedure TMainForm.ApplicationEventsmainIdle(Sender: TObject; var Done: Boolean);
begin
if factive then
begin
renderscene;
end;
done:=false;
end;
procedure TMainForm.ApplicationEventsmainMinimize(Sender: TObject);
begin
factive:=false
end;
procedure TMainForm.ApplicationEventsmainRestore(Sender: TObject);
begin
factive:=true;
end;
procedure TMainForm.FormActivate(Sender: TObject);
begin
factive:=true;
end;
end
.
|