Помогите, скажите, где скачать такой Direct Draw, что бы компилировался следующий код:
/////////////////////////////////////////////////////////////////////////////// // ddex1_api.dpr /////////////////////////////////////////////////////////////////////////////// // Delphi conversion of the ddex1 example contained in Microsoft's DirectX sdk. // Based on Eric Unger's conversions of the DirectX headers. They're available // at _http://www.delphi-jedi.org. Bug reports to meyerhoff@earthling.net. // // FPC Port by Thomas Schatzl (tom_at_work@yline.com) /////////////////////////////////////////////////////////////////////////////// // Description: // Direct Draw example program 1. Creates a Direct Draw object and then a // primary surface with a back buffer. Slowly flips between the primary surface // and the back buffer. Press F12 or Escape to terminate the program. /////////////////////////////////////////////////////////////////////////////// program ddex1_api;
//----------------------------------------------------------------------------- // Include files //----------------------------------------------------------------------------- uses Windows, DirectDraw, SysUtils, directdrawfpc;
const //--------------------------------------------------------------------------- // Local definitions //--------------------------------------------------------------------------- NAME : PChar = 'DDExample1'; TITLE : PChar = 'Direct Draw Example 1';
var //--------------------------------------------------------------------------- // Global data //--------------------------------------------------------------------------- g_pDD : IDirectDraw4; // DirectDraw object g_pDDSPrimary : IDirectDrawSurface4; // DirectDraw primary surface g_pDDSBack : IDirectDrawSurface4; // DirectDraw back surface g_bActive : Boolean = False; // Is application active?
//--------------------------------------------------------------------------- // Local data //--------------------------------------------------------------------------- szMsg : PChar = 'Page Flipping Test: Press F12 to exit'; szFrontMsg : PChar = 'Front buffer (F12 to quit)'; szBackMsg : PChar = 'Back buffer (F12 to quit)';
var x : longint = 0;
//----------------------------------------------------------------------------- // Name: ReleaseAllObjects // Desc: Finished with all objects we use; release them //----------------------------------------------------------------------------- procedure ReleaseAllObjects; begin if Assigned(g_pDD) then begin if Assigned(g_pDDSBack) then begin g_pDDSBack := nil; end; if Assigned(g_pDDSPrimary) then begin g_pDDSPrimary := nil; end; g_pDD := nil; 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; ddbltfx : TDDBltFx; rc : TRect; size : TSize; begin // Use the blter to do a color fill to clear the back buffer FillChar(ddbltfx, SizeOf(ddbltfx), 0); ddbltfx.dwSize := SizeOf(ddbltfx); ddbltfx.dwFillColor := 0; IDirectDrawSurface4_Blt(g_pDDSBack, nil, nil, nil, DDBLT_COLORFILL or DDBLT_WAIT, @ddbltfx);
if IDirectDrawSurface4_GetDC(g_pDDSBack, 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; IDirectDrawSurface4_ReleaseDC(g_pDDSBack, h_DC); end; end; //----------------------------------------------------------------------------- // Name: WindowProc // Desc: The Main Window Procedure //----------------------------------------------------------------------------- function WindowProc(h_Wnd: HWND; aMSG: Cardinal; wParam: Cardinal; Param: Integer) : Integer; stdcall; var hRet : HRESULT; s : string; 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;
// 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(LoadIcon(0, IDC_ARROW)); Result := 1; Exit; end; // Update and flip surfaces WM_TIMER: begin if g_bActive and (TIMER_ID = wParam) then begin UpdateFrame(h_Wnd); while True do begin hRet := IDirectDrawSurface4_Flip(g_pDDSPrimary, nil, 0); if hRet = DD_OK then Break; if hRet = DDERR_SURFACELOST then begin hRet := IDirectDrawSurface4__Restore(g_pDDSPrimary); if hRet <> DD_OK then Break; end; if hRet <> DDERR_WASSTILLDRAWING then Break; end; end; 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 h_Wnd : HWND; wc : WNDCLASS; ddsd : TDDSurfaceDesc2; ddscaps : TDDSCaps2; hRet : HRESULT; pDDTemp : IDirectDraw; 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 the main DirectDraw object /////////////////////////////////////////////////////////////////////////// hRet := DirectDrawCreate(nil, pDDTemp, nil); if hRet <> DD_OK then begin Result := InitFail(h_Wnd, hRet, 'DirectDrawCreate FAILED'); Exit; end; hRet := IDirectDraw_QueryInterface(pDDTemp, IID_IDirectDraw4, g_pDD); if hRet <> DD_OK then begin Result := InitFail(h_Wnd, hRet, 'QueryInterface FAILED'); Exit; end; pDDTemp := nil;
// Get exclusive mode hRet := IDirectDraw4_SetCooperativeLevel(g_pDD, 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 := IDirectDraw4_SetDisplayMode(g_pDD, 640, 480, 8, 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 := IDirectDraw4_CreateSurface(g_pDD, ddsd, g_pDDSPrimary, 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 := IDirectDrawSurface4_GetAttachedSurface(g_pDDSPrimary, ddscaps, g_pDDSBack); if hRet <> DD_OK then begin Result := InitFail(h_Wnd, hRet, 'GetAttachedSurface FAILED'); Exit; end;
// Create a timer to flip the pages if TIMER_ID <> SetTimer(h_Wnd, TIMER_ID, TIMER_RATE, nil) then begin Result := InitFail(h_Wnd, hRet, 'SetTimer FAILED'); Exit; end;
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;
while GetMessage(@aMSG, 0, 0, 0) do begin TranslateMessage(aMSG); DispatchMessage(aMSG); end; end.
вроде написанно правильно, а он не компилирует ( компилятор дельфи 7.0)