Code:
unit EngineUnit;\r\n\r\ninterface\r\nuses\r\n Windows, Messages,ActiveX,ComObj,SysUtils, Forms, Direct3D9, D3DX9,\r\n D3DApp, D3DFont, D3DUtil, DXUtil,Directshow9, InputDevice;\r\nconst\r\n WM_GRAPHNOTIFY = WM_APP + 1;\r\nType\r\n TEngine = class;\r\n TMOVIEEngine = class\r\n\r\n GraphBuilder: IGraphBuilder;\r\n MediaControl: IMediaControl;\r\n VideoWindow : IVideoWindow;\r\n MediaEvent :IMediaEventEX;\r\n FEngine : TEngine;\r\n private\r\n public\r\n RenderHWD : THandle;\r\n constructor Create;\r\n Destructor Destroy;override;\r\n procedure Render(Filename : String);\r\n Procedure AssignEngine(Engine : TEngine);\r\n end;\r\n\r\n TVMR9Graph = class\r\n private\r\n FMediawindow : HWND;\r\n RotId : Integer;\r\n // SRC interfaces array\r\n FilterArray :array [0..10] of IBaseFilter;\r\n // SOUND interfaces\r\n DirectSoundFilter : IBaseFilter;\r\n // GRAPH interfaces\r\n //GraphUnknown : IUnKnow;\r\n GraphBuilder : IGraphBuilder;\r\n FilterGraph : IFilterGraph;\r\n FilterGraph2 : IFilterGraph2;\r\n MediaControl: IMediaControl;\r\n //VideoWindow : IVideoWindow;\r\n MediaEvent : IMediaEvent;\r\n MediaEventEX :IMediaEventEX;\r\n // VMR9 interfaces\r\n VMRBaseFilter : IBaseFilter;\r\n VMRFilterConfig : IVMRFilterConfig9;\r\n VMRMixerBitmap: IVMRMixerBitmap9;\r\n VMRMixerControl: IVMRMixerControl9;\r\n VMRMonitorConfig: IVMRMonitorConfig9;\r\n VMRWindowlessControl: IVMRWindowlessControl9;\r\n // DIRECT3D interfaces\r\n D3DDirect3d: IDirect3D9;\r\n D3DDevice: IDirect3DDevice9;\r\n D3DSurface: IDirect3DSurface9;\r\n public\r\n constructor Create;\r\n Destructor Destroy;override;\r\n function AddToRot(pUnkGraph : IFilterGraph): HResult;\r\n procedure RemoveFromRot;\r\n function GetPin(pFilter: IBaseFilter; PinDir: TPinDirection; out ppPin: IPin): HRESULT;\r\n end;\r\n\r\n TEngine = class(CD3DApplication)\r\n m_pFont: CD3DFont; // Font for drawing text\r\n \r\n protected\r\n function OneTimeSceneInit: HRESULT; override;\r\n function AdjustWindowForChange: HRESULT; override;\r\n function InitDeviceObjects: HRESULT; override;\r\n function RestoreDeviceObjects: HRESULT; override;\r\n function InvalidateDeviceObjects: HRESULT; override;\r\n function DeleteDeviceObjects: HRESULT; override;\r\n function Render: HRESULT; override;\r\n function FrameMove: HRESULT; override;\r\n function ConfirmDevice(const pCaps: TD3DCaps9; dwBehavior: DWORD;\r\n adapterFormat: TD3DFormat; backBufferFormat: TD3DFormat): HRESULT; override;\r\n function FinalCleanup: HRESULT; override;\r\n function CheckForLostFullscreen: HResult;\r\n procedure BuildPresentParamsFromSettings; override;\r\n public\r\n fAppForm: TForm;\r\n m_hwndRenderWindow: HWND;\r\n m_hwndRenderFullScreen: HWND;\r\n Mouse : TMouse;\r\n D3DSurface: IDirect3DSurface9;\r\n constructor Create;\r\n procedure AssignWindowsHandles;\r\n function MsgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; override;\r\n\r\n end;\r\n\r\nimplementation\r\n\r\nconstructor TVMR9Graph.Create;\r\nvar\r\n i : Integer;\r\nbegin\r\n FMediaWindow:= 0{nil}; (* default VMR9 config*)\r\n (* SRC interfaces*)\r\n for{while} i:=0 to Pred(10) { i++}\r\n do\r\n begin\r\n FilterArray[i]:= Nil;\r\n end;\r\n DirectSoundFilter:= Nil;\r\n //GraphUnknown:= nil;\r\n GraphBuilder:= nil;\r\n FilterGraph:= nil;\r\n FilterGraph2:= nil;\r\n MediaControl:= nil;\r\n MediaEvent:= nil;\r\n MediaEventEx:= nil;\r\n VMRBaseFilter:= nil;\r\n VMRFilterConfig:= nil;\r\n VMRMixerBitmap:= nil;\r\n VMRMixerControl:= nil;\r\n VMRMonitorConfig:= nil;\r\n VMRWindowlessControl:= nil;\r\n D3DDirect3d:= nil;\r\n D3DDevice:= nil;\r\n D3DSurface:= nil;\r\nend;\r\nDestructor TVMR9Graph.Destroy;\r\nVar\r\n i : Integer;\r\n pSrcFilter : IBaseFilter;\r\nbegin\r\n if MediaEventEx<>nil then\r\n begin\r\n MediaEventEx.SetNotifyWindow(0,WM_APP + 1,0);\r\n end;\r\n (* SRC interfaces*)\r\n for i:=0 to Pred(10) { i++}\r\n do\r\n begin\r\n pSrcFilter := FilterArray[i];\r\n if pSrcFilter<>nil then\r\n begin \r\n pSrcFilter._Release;\r\n FilterArray[i]:= nil;\r\n end;\r\n end;\r\n (* SOUND interfaces*)\r\n if DirectSoundFilter<>nil then\r\n begin \r\n DirectSoundFilter._Release;\r\n DirectSoundFilter:= nil;\r\n end;\r\n (* VMR9 interfaces*)\r\n if VMRFilterConfig<>nil then\r\n begin \r\n VMRFilterConfig._Release;\r\n VMRFilterConfig:= nil;\r\n end;\r\n if VMRMixerBitmap<>nil then\r\n begin\r\n VMRMixerBitmap._Release;\r\n VMRMixerBitmap:= nil;\r\n end;\r\n if VMRMixerControl<>nil then\r\n begin\r\n VMRMixerControl._Release;\r\n VMRMixerControl:= nil;\r\n end;\r\n if VMRMonitorConfig<>nil then\r\n begin\r\n VMRMonitorConfig._Release;\r\n VMRMonitorConfig:= nil;\r\n end;\r\n if VMRWindowlessControl<>nil then\r\n begin\r\n VMRWindowlessControl._Release;\r\n VMRWindowlessControl:= nil;\r\n end;\r\n if VMRBaseFilter<>nil then\r\n begin\r\n VMRBaseFilter._Release;\r\n VMRBaseFilter:= nil;\r\n end;\r\n (* GRAPH interfaces*)\r\n if GraphBuilder<>nil then\r\n begin\r\n GraphBuilder._Release;\r\n GraphBuilder:= nil;\r\n end;\r\n if FilterGraph<>nil then\r\n begin\r\n FilterGraph._Release;\r\n FilterGraph:= nil;\r\n end;\r\n if FilterGraph2<>nil then\r\n begin\r\n FilterGraph2._Release;\r\n FilterGraph2:= nil;\r\n end;\r\n if MediaControl<>nil then\r\n begin\r\n MediaControl._Release;\r\n MediaControl:= nil;\r\n end;\r\n if MediaEvent<>nil then\r\n begin\r\n MediaEvent._Release;\r\n MediaEvent:= nil;\r\n end;\r\n if MediaEventEx<>nil then\r\n begin\r\n MediaEventEx._Release;\r\n MediaEventEx:= nil;\r\n end;\r\n (*if GraphUnknown<>0{nil}\r\n then\r\n begin\r\n m_pGraphUnknown.Release();\r\n m_pGraphUnknown:= 0{nil};\r\n end;*)\r\n (* DIRECT3D interfaces*)\r\n if D3DSurface<>nil then\r\n begin\r\n D3DSurface._Release;\r\n D3DSurface:= nil;\r\n end;\r\n if D3DDevice<>nil then\r\n begin\r\n D3DDevice._Release;\r\n D3DDevice:= nil;\r\n end;\r\n if D3DDirect3d<>nil then\r\n begin\r\n D3DDirect3d._Release;\r\n D3DDirect3d:= nil;\r\n end;\r\nend;\r\n\r\nfunction TVMR9Graph.AddToRot(pUnkGraph : IFilterGraph): HResult;\r\nvar\r\n Moniker: IMoniker;\r\n ROT : IRunningObjectTable;\r\n wsz : WideString;\r\nbegin\r\n result := GetRunningObjectTable(0, ROT);\r\n if (result <> S_OK) then exit;\r\n wsz := format(''FilterGraph %p pid %x'',[pointer(pUnkGraph),GetCurrentProcessId()]);\r\n result := CreateItemMoniker(''!'', PWideChar(wsz), Moniker);\r\n if (result <> S_OK) then exit;\r\n result := ROT.Register(0, pUnkGraph, Moniker, RotId);\r\n Moniker := nil;\r\nend;\r\n\r\nProcedure TVMR9Graph.RemoveFromRot;\r\nvar\r\n ROT: IRunningObjectTable;\r\nbegin\r\n if (SUCCEEDED(GetRunningObjectTable(0, ROT)))then\r\n begin\r\n ROT.Revoke(RotId);\r\n RotId := -1;\r\n ROT := nil;\r\n end;\r\nend;\r\n\r\nfunction TVMR9Graph.GetPin(pFilter: IBaseFilter; PinDir: TPinDirection; out ppPin: IPin): HRESULT;\r\nvar\r\n Enum: IEnumPins;\r\n Found: Cardinal;\r\n Pin: IPin;\r\n PinDirThis : TPinDirection;\r\n iNum : Integer;\r\nbegin\r\n ppPin := nil;\r\n iNum := 0;\r\n if not Assigned(pFilter) then\r\n begin\r\n Result := E_POINTER;\r\n Exit;\r\n end;\r\n\r\n Result := pFilter.EnumPins(Enum);\r\n if FAILED(Result) then Exit;\r\n\r\n Result := E_FAIL;\r\n\r\n while(S_OK = Enum.Next(1, Pin, @Found)) do\r\n begin\r\n Pin.QueryDirection(PinDirThis);\r\n if (PinDir = PinDirThis) then\r\n begin\r\n if (iNum = 0) then\r\n begin\r\n ppPin := Pin; // Return the pin''s interface\r\n Result := S_OK; // Found requested pin, so clear error\r\n break;\r\n end;\r\n inc(iNum);\r\n end;\r\n Pin := nil;\r\n end;\r\n Enum := nil;\r\nend;\r\n\r\nconstructor TEngine.Create;\r\nbegin\r\n inherited;\r\n m_strWindowTitle := ''Movie Sample By Directshow'';\r\n m_bShowCursorWhenFullscreen := True;\r\n m_d3dEnumeration.AppUsesDepthBuffer := True;\r\n\r\n m_pFont := CD3DFont.Create(''Arial'', 12, D3DFONT_BOLD);\r\nend;\r\n\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: OneTimeSceneInit()\r\n// Desc: Called during initial app startup, this function performs all the\r\n// permanent initialization.\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.OneTimeSceneInit: HRESULT;\r\nbegin\r\n // Set cursor to indicate that user can move the object with the mouse\r\n{$IFDEF WIN64}\r\n SetClassLongPtr(m_hWnd, GCLP_HCURSOR, LONG_PTR(LoadCursor(0, IDC_SIZEALL)));\r\n{$ELSE}\r\n SetClassLong(m_hWnd, GCL_HCURSOR, LoadCursor(0, IDC_SIZEALL));\r\n{$ENDIF}\r\n Result:= S_OK;\r\nend;\r\n\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: FrameMove()\r\n// Desc: Called once per frame, the call is the entry point for animating\r\n// the scene.\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.FrameMove: HRESULT;\r\nbegin\r\n Result:= S_OK;\r\nend;\r\n\r\n\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: Render()\r\n// Desc: Called once per frame, the call is the entry point for 3d\r\n// rendering. This function sets up render states, clears the\r\n// viewport, and renders the scene.\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.Render: HRESULT;\r\nbegin\r\n // Clear the viewport\r\n m_pd3dDevice.Clear(0, nil, D3DCLEAR_TARGET or D3DCLEAR_ZBUFFER,\r\n D3DCOLOR_RGBA(0,0,0,0), 1.0, 0);\r\n\r\n // Begin the scene\r\n if SUCCEEDED(m_pd3dDevice.BeginScene) then\r\n begin\r\n // Output statistics\r\n m_pFont.DrawText(2, 0, D3DCOLOR_ARGB(255,255,255,0), m_strFrameStats);\r\n m_pFont.DrawText(2, 20, D3DCOLOR_ARGB(255,255,255,0), m_strDeviceStats);\r\n m_pFont.DrawText(2, 40, D3DCOLOR_ARGB(255,255,0,250), ''Click Mouse Left to play Movie and Click Right to stop'');\r\n m_pFont.DrawText(2, 60, D3DCOLOR_ARGB(255,0,0,250), ''Press Esc Button to Window Mode'');\r\n\r\n // End the scene\r\n m_pd3dDevice.EndScene;\r\n end;\r\n\r\n Result:= S_OK;\r\nend;\r\n\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: AdjustWindowForChange()\r\n// Desc: Adjusts the window properties for windowed or fullscreen mode\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.AdjustWindowForChange: HRESULT;\r\nbegin\r\n if (m_bWindowed) then\r\n begin\r\n ShowWindow(m_hwndRenderFullScreen, SW_HIDE);\r\n m_hWnd:= m_hwndRenderWindow;\r\n end else\r\n begin\r\n if IsIconic(m_hwndRenderFullScreen) then\r\n ShowWindow(m_hwndRenderFullScreen, SW_RESTORE);\r\n\r\n ShowWindow(m_hwndRenderFullScreen, SW_SHOW);\r\n m_hWnd:= m_hwndRenderFullScreen;\r\n end;\r\n Result:= S_OK;\r\nend;\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: InitDeviceObjects()\r\n// Desc: Initialize scene objects.\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.InitDeviceObjects:HRESULT;\r\nVar\r\n hr : HResult;\r\nbegin\r\n // Initialize the font''s internal textures\r\n m_pFont.InitDeviceObjects(m_pd3dDevice);\r\n hr := m_pd3dDevice.CreateOffscreenPlainSurface(m_d3dsdBackBuffer.Width,m_d3dsdBackBuffer.Height,\r\n m_d3dsdBackBuffer.Format,D3DPOOL_SYSTEMMEM,D3DSurface,NIL);\r\n if hr = E_FAIL then\r\n begin\r\n Application.MessageBox(''Can not create a Direct3d surface'',\r\n ''Movie Render'', MB_ICONERROR or MB_OK);\r\n end;\r\n Result:= S_OK;\r\nend;\r\n\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: RestoreDeviceObjects()\r\n// Desc: Initialize scene objects.\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.RestoreDeviceObjects: HRESULT;\r\nbegin\r\n m_pFont.RestoreDeviceObjects;\r\n Result:= S_OK;\r\nend;\r\n\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: InvalidateDeviceObjects()\r\n// Desc:\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.InvalidateDeviceObjects: HRESULT;\r\nbegin\r\n m_pFont.InvalidateDeviceObjects;\r\n Result:= S_OK;\r\nend;\r\n\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: DeleteDeviceObjects()\r\n// Desc: Called when the app is exiting, or the device is being changed,\r\n// this function deletes any device dependent objects.\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.DeleteDeviceObjects: HRESULT;\r\nbegin\r\n m_pFont.DeleteDeviceObjects;\r\n Result:= S_OK;\r\nend;\r\n\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: ConfirmDevice()\r\n// Desc: Called during device initialization, this code checks the device\r\n// for some minimum set of capabilities\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.ConfirmDevice(const pCaps: TD3DCaps9; dwBehavior: DWORD;\r\n adapterFormat: TD3DFormat; backBufferFormat: TD3DFormat): HRESULT;\r\nbegin\r\n Result:= E_FAIL;\r\n\r\n // Need to support post-pixel processing (for alpha blending)\r\n if FAILED(m_pD3D.CheckDeviceFormat(pCaps.AdapterOrdinal, pCaps.DeviceType,\r\n adapterFormat, D3DUSAGE_RENDERTARGET or D3DUSAGE_QUERY_POSTPIXELSHADER_BLENDING,\r\n D3DRTYPE_SURFACE, backBufferFormat))\r\n then Exit;\r\n\r\n // Only D3DFMT_X1R5G5B5, D3DFMT_R5G6B5, or D3DFMT_X8R8G8B8 format\r\n // are supported for fullscreen GDI mode.\r\n if not (backBufferFormat in [D3DFMT_X1R5G5B5, D3DFMT_R5G6B5, D3DFMT_X8R8G8B8]) then Exit;\r\n\r\n Result:= S_OK;\r\nend;\r\n\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: FinalCleanup()\r\n// Desc: Called before the app exits, this function gives the app the chance\r\n// to cleanup after itself.\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.FinalCleanup: HRESULT;\r\nbegin\r\n SAFE_DELETE(m_pFont);\r\n Result:= S_OK;\r\nend;\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: MsgProc()\r\n// Desc: Message proc function to handle user input\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.MsgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;\r\nbegin\r\n Result:= inherited MsgProc(hWnd, uMsg, wParam, lParam);\r\nend;\r\n\r\nprocedure TEngine.AssignWindowsHandles;\r\nbegin\r\n // Note that for the VCL samples, the device window and focus window\r\n // are not the same.\r\n m_hWnd := m_hwndRenderWindow;\r\n m_hWndFocus := m_hwndRenderFullScreen;\r\nend;\r\n\r\n//-----------------------------------------------------------------------------\r\n// Name: CheckForLostFullscreen()\r\n// Desc: If fullscreen and device was lost (probably due to alt-tab),\r\n// automatically switch to windowed mode\r\n//-----------------------------------------------------------------------------\r\nfunction TEngine.CheckForLostFullscreen: HResult;\r\nbegin\r\n Result:= S_OK;\r\n if (m_bWindowed) then Exit;\r\n if (FAILED(m_pd3dDevice.TestCooperativeLevel)) then\r\n begin\r\n ForceWindowed;\r\n fAppForm.SetFocus;\r\n Application.BringToFront;\r\n end;\r\nend;\r\n\r\nprocedure TEngine.BuildPresentParamsFromSettings;\r\nbegin\r\n inherited;\r\n m_d3dpp.Flags:= m_d3dpp.Flags or D3DPRESENTFLAG_LOCKABLE_BACKBUFFER;\r\nend;\r\n\r\nconstructor TMovieEngine.Create;\r\nbegin\r\n inherited;\r\nend;\r\n\r\nDestructor TMovieEngine.Destroy;\r\nbegin\r\n CoUninitialize;\r\n //VideoWindow.put_Visible(FALSE);\r\n //VideoWindow.put_Owner(0);\r\n Inherited Destroy;\r\nend;\r\n\r\nProcedure TMovieEngine.AssignEngine(Engine : TEngine);\r\n\r\nbegin\r\n FEngine := Engine;\r\n RenderHWD := FEngine.m_hWnd;\r\n (*if FEngine.m_bWindowed then\r\n RenderHWD := FEngine.fAppForm.Handle\r\n else\r\n RenderHWD := FEngine.m_hwndRenderFullScreen;*)\r\nend;\r\n\r\nProcedure TMovieEngine.Render(Filename : String);\r\nVar\r\n PWName : array[0..MAX_PATH] of WideChar;\r\n CRect : TRect;\r\nbegin\r\n CoInitialize(nil);\r\n CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER,\r\n IID_IGraphBuilder, GraphBuilder);\r\n { Get the top level interface }\r\n //GraphBuilder := CreateComObject(CLSID_FilterGraph) as IGraphBuilder;\r\n { Have GraphBuilder do all the grunt work of creating filters and connecting pins }\r\n {$IFNDEF UNICODE}\r\n MultiByteToWideChar(CP_ACP, 0, PChar(FileName), -1, PWName, MAX_PATH);\r\n {$ELSE}\r\n lstrcpy(wFileName, strFileName);\r\n {$ENDIF}\r\n if FAILED(GraphBuilder.RenderFile(PWname,nil)) then\r\n begin\r\n Application.MessageBox( ''A¬§A_A"ASA'A_A'A?íA¬?A¬?A"A¬°A'A?í A¬°ASA'A¬ßA¬ºA.A¬§A'Ac ''+\r\n ''The sample will now exit.'',\r\n ''Movie Render'', MB_ICONERROR or MB_OK );\r\n end;\r\n { Get a MediaControl interface to display in }\r\n GraphBuilder.QueryInterface(IID_IMediaControl, MediaControl);\r\n GraphBuilder.QueryInterface(IID_IVideoWindow,VideoWindow);\r\n GraphBuilder.QueryInterface(IID_IMediaEventEX,MediaEvent);\r\n //MediaEvent.SetNotifyWindow(RenderHWD,WM_GRAPHNOTIFY,0);\r\n VideoWindow.put_Owner(RenderHWD);\r\n VideoWindow.put_WindowStyle(WS_CHILD OR WS_CLIPSIBLINGS );//OR WS_CLIPCHILDREN);\r\n //VideoWindow.put_WindowStyleEX(not(WS_EX_CLIENTEDGE or WS_EX_STATICEDGE\r\n // or WS_EX_WINDOWEDGE or WS_EX_DLGMODALFRAME) );\r\n GetClientRect(RenderHWD,CRect);\r\n VideoWindow.SetWindowPosition(CRect.Left,CRect.Top,CRect.Right,CRect.Bottom);\r\n { Run the MPG once }\r\n MediaControl.Run;\r\nend;\r\n\r\nend.
Bookmarks