|
|
楼主 |
发表于 2005-11-2 15:53:00
|
显示全部楼层
Re:我用DELPHI+DIRECTX7 SDK方式编了一个程序,可是退出的时候
最简单的没问题,但是我建了一个离屏表面和一个键盘控制以后,就出问题了..
我把全部代码贴出来..大家帮我看一下...同样的代码,我用C就没问题..怪事..
program KS;
//-----------------------------------------------------------------------------
// Include files
//-----------------------------------------------------------------------------
uses
Windows,
Messages,
DirectDraw,
DIRECTINPUT,
SysUtils,
DDUtil ;
{$R *.res}
const
//---------------------------------------------------------------------------
// Local definitions
//---------------------------------------------------------------------------
NAME : PChar = 'DDExample2';
TITLE : PChar = 'Direct Draw Example 2';
//---------------------------------------------------------------------------
// Default settings
//---------------------------------------------------------------------------
TIMER_ID = 1;
TIMER_RATE = 500;
var
//---------------------------------------------------------------------------
// Global data
//---------------------------------------------------------------------------
PDD : IDirectDraw7; // DirectDraw 对象
DDSPrimary : IDirectDrawSurface7; // DirectDraw 主表面
DDSBack : IDirectDrawSurface7; // DirectDraw 后台表面
DDSBuff : IDirectDrawSurface7; // DirectDraw 离屏表面
DDSWORK : IDirectDrawSurface7; // DirectDraw 工作表面
DDINPUT : IDIRECTINPUT7;
DDDEV : IDIRECTINPUTDEVICE;
// DDPal : IDIRECTDRAWPALETTE; // The primary surface palette
g_bActive : Boolean = False; // Is application active?
DDBLTFX : TDDBLTFX;
KeyBuf:Array[0..255] Of Byte;
h_Wnd : HWND;
X,Y:INTEGER;
//---------------------------------------------------------------------------
// Local data
//---------------------------------------------------------------------------
szBackground : PChar = 'ZJ.bmp';
szMsg : PChar = 'Page Flipping Test: Press F12 to exit';
szFrontMsg : PChar = 'Front buffer (F12 to quit)';
szBackMsg : PChar = 'Back buffer (F12 to quit)';
//-----------------------------------------------------------------------------
// Name: ReleaseAllObjects
// Desc: Finished with all objects we use; release them
//-----------------------------------------------------------------------------
procedure ReleaseAllObjects;
begin
if Assigned(pDD) then
begin
if Assigned(DDSBack) then
begin
DDSBack := nil;
end;
if Assigned(DDSPrimary) then
begin
DDSPrimary := nil;
end;
if Assigned(DDSBUFF) then
begin
DDSBUFF := nil;
end;
if Assigned(DDSWORK) then
begin
DDSWORK := nil;
end;
PDD:=NIL;
if assigned(ddinput) then
begin
dddev.Unacquire ;
end;
end;
end;
//-----------------------------------------------------------------------------
// Name: InitFail
// Desc: This function is called if an initialization function fails
//-----------------------------------------------------------------------------
function InitFail(h_Wnd : HWND; hRet : HRESULT; Text : string) : HRESULT;
begin
ReleaseAllObjects;
MessageBox(h_Wnd, PChar(Text + ': ' + DDErrorString(hRet)), TITLE, MB_OK);
DestroyWindow(h_Wnd);
Result := hRet;
end;
//-----------------------------------------------------------------------------
// Name: UpdateFrame
// Desc: Displays the proper text for the page
//-----------------------------------------------------------------------------
var
phase : Boolean = False;
procedure UpdateFrame(h_Wnd : HWND);
var
h_DC : HDC;
rc : TRect;
size : TSize;
begin
// The back buffer already has a loaded bitmap, so don't clear it
if DDSBack.GetDC(h_DC) = DD_OK then
begin
SetBkColor(h_DC, RGB(0, 0, 255));
SetTextColor(h_DC, RGB(255, 255, 0));
if phase then
begin
GetClientRect(h_Wnd, rc);
GetTextExtentPoint(h_DC, szMsg, StrLen(szMsg), size);
TextOut(h_DC, (rc.right - size.cx) div 2, (rc.bottom - size.cy) div 2, szMsg, StrLen(szMsg));
TextOut(h_DC, 0, 0, szFrontMsg, StrLen(szFrontMsg));
phase := False;
end
else
begin
TextOut(h_DC, 0, 0, szBackMsg, StrLen(szBackMsg));
phase := True;
end;
DDSBack.ReleaseDC(h_DC);
end;
end;
//-----------------------------------------------------------------------------
// Name: WindowProc
// Desc: The Main Window Procedure
//-----------------------------------------------------------------------------
function WindowProc(h_Wnd: HWND; aMSG: Cardinal; wParam: Cardinal; lParam: Integer) : Integer; stdcall;
var
hRet : HRESULT;
begin
case aMSG of
// Pause if minimized
WM_ACTIVATE:
begin
if HIWORD(wParam) = 0 then
g_bActive := True
else
g_bActive := False;
Result := 0;
Exit;
end;
// Clean up and close the app
WM_DESTROY:
begin
ReleaseAllObjects;
PostQuitMessage(0);
Result := 0;
Exit;
end;
WM_CLOSE:
BEGIN
destroywindow(h_Wnd);
exit;
end;
// Handle any non-accelerated key commands
WM_KEYDOWN:
begin
case wParam of
VK_ESCAPE,
VK_F12:
begin
PostMessage(h_Wnd, WM_CLOSE, 0, 0);
Result := 0;
Exit;
end;
end;
end;
// Turn off the cursor since this is a full-screen app
WM_SETCURSOR:
begin
SetCursor(0);
Result := 1;
Exit;
end;
end;
Result := DefWindowProc(h_Wnd, aMSG, wParam, lParam);
end;
//-----------------------------------------------------------------------------
// Name: InitApp
// Desc: Do work required for every instance of the application:
// Create the window, initialize data
//-----------------------------------------------------------------------------
function InitApp(hInst : THANDLE; nCmdShow : Integer) : HRESULT;
var
wc : WNDCLASS;
ddsd : TDDSurfaceDesc2;
ddscaps : TDDSCaps2;
hRet : HRESULT;
tycl: TDIDataFormat;
begin
// Set up and register window class
wc.style := CS_HREDRAW or CS_VREDRAW;
wc.lpfnWndProc := @WindowProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := hInst;
wc.hIcon := LoadIcon(hInst, 'MAINICON');
wc.hCursor := LoadCursor(0, IDC_ARROW);
wc.hbrBackground := GetStockObject(BLACK_BRUSH);
wc.lpszMenuName := NAME;
wc.lpszClassName := NAME;
RegisterClass(wc);
// Create a window
h_Wnd := CreateWindowEx(WS_EX_TOPMOST,
NAME,
TITLE,
WS_POPUP,
0,
0,
300,200,
// GetSystemMetrics(SM_CXSCREEN),
// GetSystemMetrics(SM_CYSCREEN),
0,
0,
hInst,
nil);
if h_Wnd = 0 then
begin
Result := 0;
Exit;
end;
ShowWindow(h_Wnd, nCmdShow);
UpdateWindow(h_Wnd);
SetFocus(h_Wnd);
///////////////////////////////////////////////////////////////////////////
// Create the main DirectDraw object
///////////////////////////////////////////////////////////////////////////
hRet := DirectDrawCreateEx(nil, pDD, IDirectDraw7, nil);
if hRet <> DD_OK then
begin
Result := InitFail(h_Wnd, hRet, 'DirectDrawCreateEx FAILED');
Exit;
end;
// Get exclusive mode
hRet := pDD.SetCooperativeLevel(h_Wnd, DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN);
if hRet <> DD_OK then
begin
Result := InitFail(h_Wnd, hRet, 'SetCooperativeLevel FAILED');
Exit;
end;
// Set the video mode to 640x480x8
hRet := pDD.SetDisplayMode(1024, 768,32, 0, 0);
if hRet <> DD_OK then
begin
Result := InitFail(h_Wnd, hRet, 'SetDisplayMode FAILED');
Exit;
end;
// Create the primary surface with 1 back buffer
FillChar(ddsd, SizeOf(ddsd), 0);
ddsd.dwSize := SizeOf(ddsd);
ddsd.dwFlags := DDSD_CAPS or DDSD_BACKBUFFERCOUNT;
ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX;
ddsd.dwBackBufferCount := 1;
hRet := pDD.CreateSurface(ddsd, DDSPrimary, nil);
if hRet <> DD_OK then
begin
Result := InitFail(h_Wnd, hRet, 'CreateSurface FAILED');
Exit;
end;
// Get a pointer to the back buffer
FillChar(ddscaps, SizeOf(ddscaps), 0);
ddscaps.dwCaps := DDSCAPS_BACKBUFFER;
hRet := DDSPrimary.GetAttachedSurface(ddscaps, DDSBack);
if hRet <> DD_OK then
begin
Result := InitFail(h_Wnd, hRet, 'GetAttachedSurface FAILED');
Exit;
end;
//开始创建离屏页面，先清空页面描述
//填充页面描述
ddsd.dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;
ddsd.ddsCaps.dwCaps :=DDSCAPS_OFFSCREENPLAIN or DDSCAPS_SYSTEMMEMORY ; //这是离屏页面
ddsd.dwHeight:=193; //高
ddsd.dwWidth:=384; //宽
hRet:=pDD.CreateSurface(ddsd, DDSBuff, nil ) ;
if hRet <> DD_OK then
begin
Result := InitFail(h_Wnd, hRet, 'GetAttachedSurface FAILED');
Exit;
end;
//创建键盘设备
tycl:=c_dfDIKeyboard ;
hret:=DirectInputCreateEX(getmodulehandle(nil),DIRECTINPUT_VERSION,IID_IDIRECTINPUT7,ddinput,nil);
if hRet <> DD_OK then
begin
Result := InitFail(h_Wnd, hRet, 'GetAttachedSurface FAILED');
Exit;
end;
IF ddinput.CreateDevice(GUID_SYSKEYBOARD,dddev,nil)=DI_OK THEN
if dddev.SetDataFormat(tycl)=DI_OK then
//IF dddev.SetCooperativeLevel(h_Wnd,DISCL_EXCLUSIVE OR DISCL_FOREGROUND)=DI_OK THEN
IF dddev.SetCooperativeLevel(h_Wnd, DISCL_FOREGROUND)=DI_OK THEN
DDDEV.Acquire ;
// 调入位图到离屏表面
// DDSBuff :=DDLoadBitmap(PDD,szBackground,0,0);
hRet := DDReLoadBitmap(DDSBuff, szBackground);
if hRet <> DD_OK then
begin
Result := InitFail(h_Wnd, hRet, 'DDReLoadBitmap FAILED');
Exit;
end;
ddsetcolorkey(DDSBuff,rgb(255,0,255));
ddBltFx.dwSize:=sizeof(DDBLTFX);
ddBltFx.dwFillColor:=0; //如是纯红则为dwRBitMask，
Result := DD_OK;
end;
function game() : HRESULT;
var
hRet : HRESULT;
pic:integer;
rect,rect1:trect;
begin
FillChar(KeyBuf, SizeOf(KeyBuf), 0);
//hret:=dddev.GetDeviceState(sizeof(keybuf),@keybuf);
if failed(dddev.GetDeviceState(sizeof(keybuf),@keybuf)) then
begin
hret:=dddev.Acquire ;
while (hret= DIERR_INPUTLOST) OR (HRET=DIERR_OTHERAPPHASPRIO)
DO hret:=dddev.Acquire ;
end;
pic:=0;
if keybuf[DIK_LEFT] AND $80<>0 then
BEGIN
IF X>0 THEN DEC(X);
pic:=1;
END;
if keybuf[DIK_RIGHT] AND $80<>0 then
BEGIN
IF X<800-64 THEN INC(X);
pic:=2;
END;
if keybuf[DIK_UP] AND $80<>0 then
BEGIN
IF Y>0 THEN DEC(y);
END;
if keybuf[DIK_DOWN] AND $80<>0 then
BEGIN
IF Y<600-64 THEN INC(Y);
END;
RECT.Left:=pic*64;
RECT.Top:=0;
RECT.Right :=pic*64+63;
RECT.Bottom :=63;
RECT1.Left:=0;
RECT1.Top:=0;
RECT1.Right :=1024;
RECT1.Bottom :=768;
DDSBack.blt(@rect1,NIL,@rect1,DDBLT_WAIT or DDBLT_COLORFILL,@DDBLTFX);
DDSBack.BltFast(X,Y,DDSBuff,@RECT,DDBLTFAST_SRCCOLORKEY OR DDBLTFAST_WAIT);
DDSPrimary.Flip(nil, 0);
Result := DD_OK;
end;
//-----------------------------------------------------------------------------
// Name: WinMain
// Desc: Initialization, message loop
//-----------------------------------------------------------------------------
var
aMSG : MSG;
begin
if InitApp(GetModuleHandle(nil), SW_SHOW) <> DD_OK then
begin
Exit;
end;
X:=400;Y:=300;
while (true) do
begin
if peekmessage(amsg,0,0,0,PM_REMOVE) THEN
BEGIN
IF (AMSG.message=WM_QUIT) then break;
TranslateMessage(aMSG);
DispatchMessage(aMSG);
END;
IF g_bActive THEN GAME;
end;
end. |
|
发表于 2005-11-2 10:22:00
