Подскажите, как реализовать...

← →
ProgRAMmer Dimonych © (2007-04-05 23:55) [0]

... в приложении без VCL (на WinAPI) событие TApplicationEvents.OnIdle?

Пробовал так, но выводится только синий фон и только после щелчка мыши... :(

program GraceSaver;

uses
Windows, Messages, SysUtils, Direct3D9, D3DX9;

{$R *.res}
type
TMyVert=record
X,Y,Z:Single;
nX,nY,nZ:Single;
tu,tv:Single;
end;

const
FVF_MY=D3DFVF_XYZ or D3DFVF_NORMAL or D3DFVF_TEX1;

var
Instance:HWND;
WindowClass:TWndClass;
Handle:HWnd;
Msg:TMsg;
//
DXObj:IDirect3D9;
DXDev:IDirect3DDevice9;
DXVB:IDirect3DVertexBuffer9;
DXIB:IDirect3DIndexBuffer9;
Material:D3DMaterial9;
Light:D3DLight9;
DXTex1,DXTex2:IDirect3DTexture9;
//
LastTick:DWORD;
TagCnt:Integer;
//
ScrW,ScrH:Integer;
DrawIt:Boolean;

//
//
//

function Init:HRESULT;
var
dm:TD3DDisplayMode;
pp:TD3DPresent_Parameters;
begin
Result:=E_FAIL;
DXObj:=nil; DXDev:=nil;
DXObj:=Direct3DCreate9(D3D_SDK_VERSION);
if DXObj=nil then Exit;
if Failed(DXObj.GetAdapterDisplayMode(0,dm)) then Exit;
ZeroMemory(@pp,SizeOf(pp));
pp.Windowed:=True;
pp.BackBufferFormat:=dm.Format;
pp.SwapEffect:=D3DSWAPEFFECT_DISCARD;
pp.EnableAutoDepthStencil:=True;
pp.AutoDepthStencilFormat:=D3DFMT_D16;
if Failed(DXObj.CreateDevice(0,D3DDEVTYPE_HAL,Handle,D3DCREATE_HARDWARE_VERTEXPROCE SSING,@pp,DXDev)) then Exit;
if Failed(DXDev.SetRenderState(D3DRS_CULLMODE,D3DCULL_CW)) then Exit;
if Failed(DXDev.SetRenderState(D3DRS_ZENABLE,D3DZB_TRUE)) then Exit;
LastTick:=GetTickCount;
Result:=D3D_OK;
end;

procedure DeInit;
begin
if Assigned(DXTex2) then begin DXTex2._Release; DXTex2:=nil; end;
if Assigned(DXTex1) then begin DXTex1._Release; DXTex1:=nil; end;
if Assigned(DXIB) then begin DXIB._Release; DXIB:=nil; end;
if Assigned(DXVB) then begin DXVB._Release; DXVB:=nil; end;
if Assigned(DXDev) then begin DXDev._Release; DXDev:=nil; end;
if Assigned(DXObj) then begin DXObj._Release; DXObj:=nil; end;
end;

function LightMaterial:HRESULT;
var
DirVector:TD3DVector;
begin
Result:=E_FAIL;
ZeroMemory(@Material,SizeOf(Material));
Material.Diffuse.r:=1; Material.Ambient.r:=1;
Material.Diffuse.g:=1; Material.Ambient.g:=1;
Material.Diffuse.b:=0; Material.Ambient.b:=0;
Material.Diffuse.a:=1; Material.Ambient.a:=1;
if Failed(DXDev.SetMaterial(Material)) then Exit;
//
ZeroMemory(@Light,SizeOf(Light));
Light._Type:=D3DLIGHT_DIRECTIONAL;
with Light.Diffuse do begin r:=1; g:=1; b:=1; end;
Light.Range:=1000;
DirVector:=D3DXVector3(0,0,1);
D3DXVec3Normalize(Light.Direction,DirVector);
if Failed(DXDev.SetLight(0,Light)) then Exit;
if Failed(DXDev.LightEnable(0,True)) then Exit;
if Failed(DXDev.SetRenderState(D3DRS_LIGHTING,Cardinal(True))) then Exit;
if Failed(DXDev.SetRenderState(D3DRS_AMBIENT,0)) then Exit;
Result:=D3D_OK;
end;

function Matrix:HRESULT;
var
WorldX,WorldY:TD3DMATRIX;
World,View,Proj:TD3DXMATRIX;
ThisTick:DWORD;
Angle:Single;
begin
Result:=E_FAIL;
ThisTick:=GetTickCount;
if ThisTick-LastTick>50 then
begin
Angle:=TagCnt*D3DX_PI/180;
D3DXMatrixRotationX(WorldX,Angle);
D3DXMatrixRotationY(WorldY,Angle);
D3DXMatrixMultiply(World,WorldX,WorldY);
if Failed(DXDev.SetTransform(D3DTS_WORLD,World)) then Exit;
TagCnt:=(TagCnt+2) mod 360;
end;
D3DXMatrixLookAtLH(View,D3DXVector3(0,0,-5*Sin(GetTickCount/1000)-8),D3DXVector3(0,Sin(GetTickCount/200),0),D3DXVector3(0,1,0));
if Failed(DXDev.SetTransform(D3DTS_VIEW,View)) then Exit;
D3DXMatrixPerspectiveFovLH(Proj,D3DX_PI/4,ScrW/ScrH,1,100);
if Failed(DXDev.SetTransform(D3DTS_PROJECTION,Proj)) then Exit;
Result:=D3D_OK;
end;

function Render:HRESULT;
begin
Result:=E_FAIL;
if DXDev=nil then Exit;
if Failed(DXDev.Clear(0,nil,D3DCLEAR_TARGET or D3DCLEAR_ZBUFFER,D3DCOLOR_XRGB(0,0,100),1,0)) then Exit;
if Failed(DXDev.BeginScene) then Exit;
if Failed(LightMaterial) then Exit;
if Failed(Matrix) then Exit;
if Failed(DXDev.SetStreamSource(0,DXVB,0,SizeOf(TMyVert))) then Exit;
if Failed(DXDev.SetFVF(FVF_MY)) then Exit;
if Failed(DXDev.SetIndices(DXIB)) then Exit;
if Failed(DXDev.SetTexture(0,DXTex1)) then Exit;
if Failed(DXDev.SetTexture(1,DXTex2)) then Exit;
if Failed(DXDev.SetTextureStageState(0,D3DTSS_COLORARG1,D3DTA_TEXTURE)) then Exit;
if Failed(DXDev.SetTextureStageState(0,D3DTSS_COLOROP,D3DTOP_SELECTARG1)) then Exit;
if Failed(DXDev.SetTextureStageState(1,D3DTSS_TEXCOORDINDEX,0)) then Exit;
if Failed(DXDev.SetTextureStageState(1,D3DTSS_COLORARG1,D3DTA_TEXTURE)) then Exit;
if Failed(DXDev.SetTextureStageState(1,D3DTSS_COLOROP,13)) then Exit;
if Failed(DXDev.DrawIndexedPrimitive(D3DPT_TRIANGLELIST,0,0,36,0,12)) then Exit;
//if Failed(DXDev.SetTexture(0,nil)) then Exit;
if Failed(DXDev.EndScene) then Exit;
if Failed(DXDev.Present(nil,nil,0,nil)) then Exit;
Result:=D3D_OK;
end;

← →
ProgRAMmer Dimonych © (2007-04-05 23:55) [1]

function InitVB:HRESULT;
const
Verts:array [1..24] of TMyVert=
((X:1;Y:-1;Z:-1;nX:0;nY:0;nZ:-1;tu:0;tv:1),
(X:1;Y:1;Z:-1;nX:0;nY:0;nZ:-1;tu:1;tv:1),
(X:-1;Y:1;Z:-1;nX:0;nY:0;nZ:-1;tu:1;tv:0),
(X:-1;Y:-1;Z:-1;nX:0;nY:0;nZ:-1;tu:0;tv:0),

(X:-1;Y:-1;Z:-1;nX:-1;nY:0;nZ:0;tu:0;tv:1),
(X:-1;Y:1;Z:-1;nX:-1;nY:0;nZ:0;tu:1;tv:1),
(X:-1;Y:1;Z:1;nX:-1;nY:0;nZ:0;tu:1;tv:0),
(X:-1;Y:-1;Z:1;nX:-1;nY:0;nZ:0;tu:0;tv:0),

(X:-1;Y:-1;Z:1;nX:0;nY:0;nZ:1;tu:0;tv:1),
(X:-1;Y:1;Z:1;nX:0;nY:0;nZ:1;tu:1;tv:1),
(X:1;Y:1;Z:1;nX:0;nY:0;nZ:1;tu:1;tv:0),
(X:1;Y:-1;Z:1;nX:0;nY:0;nZ:1;tu:0;tv:0),

(X:1;Y:-1;Z:1;nX:1;nY:0;nZ:0;tu:0;tv:1),
(X:1;Y:1;Z:1;nX:1;nY:0;nZ:0;tu:1;tv:1),
(X:1;Y:1;Z:-1;nX:1;nY:0;nZ:0;tu:1;tv:0),
(X:1;Y:-1;Z:-1;nX:1;nY:0;nZ:0;tu:0;tv:0),

(X:1;Y:-1;Z:-1;nX:0;nY:-1;nZ:0;tu:0;tv:1),
(X:-1;Y:-1;Z:-1;nX:0;nY:-1;nZ:0;tu:1;tv:1),
(X:-1;Y:-1;Z:1;nX:0;nY:-1;nZ:0;tu:1;tv:0),
(X:1;Y:-1;Z:1;nX:0;nY:-1;nZ:0;tu:0;tv:0),

(X:1;Y:1;Z:1;nX:0;nY:1;nZ:0;tu:0;tv:1),
(X:-1;Y:1;Z:1;nX:0;nY:1;nZ:0;tu:1;tv:1),
(X:-1;Y:1;Z:-1;nX:0;nY:1;nZ:0;tu:1;tv:0),
(X:1;Y:1;Z:-1;nX:0;nY:1;nZ:0;tu:0;tv:0));
Index:array [1..36] of Word=
(0,1,2, 2,3,0,
4,5,6, 6,7,4,
8,9,10, 10,11,8,
12,13,14, 14,15,12,
16,17,18, 18,19,16,
20,21,22, 22,23,20);
var
pVerts,pIndex:Pointer;
SV,SI:Cardinal;
begin
Result:=E_FAIL;
SV:=SizeOf(Verts); SI:=SizeOf(Index);
//if Failed(D3DXCreateTextureFromFileEx(DXDev,"DSC.bmp",0,0,0,0,D3DFMT_UNKNOWN,D3DPOO L_DEFAULT,D3DX_DEFAULT,D3DX_DEFAULT,$FF000000,nil,nil,DXTex1)) then Exit;
if Failed(D3DXCreateTextureFromFile(DXDev,"DSC.bmp",DXTex1)) then Exit;
if Failed(D3DXCreateTextureFromFileEx(DXDev,"Grace.bmp",0,0,0,0,D3DFMT_UNKNOWN,D3DP OOL_DEFAULT,D3DX_DEFAULT,D3DX_DEFAULT,$FF000000,nil,nil,DXTex2)) then Exit;
if Failed(DXDev.CreateVertexBuffer(SV,0,FVF_MY,D3DPOOL_DEFAULT,DXVB,nil)) then Exit;
if Failed(DXVB.Lock(0,SV,pVerts,0)) then Exit;
CopyMemory(pVerts,@Verts,SV);
if Failed(DXVB.Unlock) then Exit;
if Failed(DXDev.CreateIndexBuffer(SI,0,D3DFMT_INDEX16,D3DPOOL_DEFAULT,DXIB,nil)) then Exit;
if Failed(DXIB.Lock(0,SI,pIndex,0)) then Exit;
CopyMemory(pIndex,@Index,SI);
if Failed(DXIB.Unlock) then Exit;
Result:=D3D_OK;
end;

//
//
//

procedure DoExit;
begin
DrawIt:=False;
DeInit;
ShowCursor(True);
Halt;
end;

function WindowProc(HWn,Msg,WPr,LPr:LongInt):LongInt; stdcall;
begin
Result:=DefWindowProc(HWn,Msg,WPr,LPr);
if Msg=WM_DESTROY then DoExit;
if Msg=WM_KEYDOWN then
if WPr=VK_ESCAPE then
DoExit;
if DrawIt then
begin
if Failed(Render) then DoExit;
ValidateRect(Handle,nil);
end;
end;

begin
DrawIt:=False;
Instance:=GetModuleHandle(nil);
WindowClass.style:=CS_HReDraw or CS_VReDraw;
WindowClass.lpfnWndProc:=@WindowProc;
WindowClass.hInstance:=Instance;
WindowClass.hbrBackground:=COLOR_BTNFACE;
WindowClass.lpszClassName:="GraceSaver";
WindowClass.hCursor:=LoadCursor(0,IDC_ARROW);
RegisterClass(WindowClass);
Handle:=CreateWindowEx(0,"GraceSaver","",WS_POPUP,1,1,200,200,0,0,Instance,nil);
ShowWindow(Handle,SW_MAXIMIZE);
UpdateWindow(Handle);
ShowCursor(False);
if Failed(Init) then DoExit;
if Failed(InitVB) then DoExit;
DrawIt:=True;
ZeroMemory(@Msg,SizeOf(Msg));
while True do
begin
if PeekMessage(Msg,0,0,0,PM_REMOVE) then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end.

← →
Real © (2007-04-06 00:03) [2]

Где ты этот кошмар нырыл? Тока не говори что сам писал :)

← →
DrPass © (2007-04-06 00:13) [3]

> if PeekMessage(Msg,0,0,0,PM_REMOVE) then
> begin
> TranslateMessage(Msg);
> DispatchMessage(Msg);
> end;

else DoOnIdle;

> Real © (06.04.07 00:03) [2]
> Где ты этот кошмар нырыл? Тока не говори что сам писал :)
Говорю: сам, с помощью одной книжки...

> DrPass © (06.04.07 00:13) [3]
>
> > if PeekMessage(Msg,0,0,0,PM_REMOVE) then
> > begin
> > TranslateMessage(Msg);
> > DispatchMessage(Msg);
> > end;
>
> else DoOnIdle;
Спасибо, наверное, я мог бы и сам догадаться... Только почему-то весь этот код ничего, кроме фона не рисует, хотя все переменные вроде правильно заполняются, да и сама программа скопирована с абсолютно рабочего приложения с VCL (форма с единственным TApplicationEvents). В чём может быть причина?

Подскажите, как реализовать... Найти похожие ветки