воспроизведением видео через DirectX
Помогите с глюком:
Я скачал пример по воспроизведением видео через DirectX и в нём гюк. когда воспроизводится видео форма виснет если что вот код:
"unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
Open1: TMenuItem;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Open1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ActiveX, DirectShow9;
var
pGraphBuilder: IGraphBuilder = nil;
pMediaControl: IMediaControl = nil;
pMediaEvent : IMediaEvent = nil;
procedure TForm1.FormCreate(Sender: TObject);
begin
CoInitialize(nil);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CoUninitialize;
end;
procedure TForm1.Open1Click(Sender: TObject);
var
hr: HRESULT;
evCode: Integer;
begin
if not OpenDialog1.Execute then exit;
if Assigned(pGraphBuilder) then pGraphBuilder := nil;
if Assigned(pMediaControl) then pMediaControl := nil;
if Assigned(pMediaEvent) then pMediaEvent := nil;
hr := CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC, IID_IGraphBuilder, pGraphBuilder);
if FAILED(hr) then begin
ShowMessage('Íå óäàåòñÿ ñîçäàòü GraphBuilder');
exit;
end;
hr := pGraphBuilder.QueryInterface(IID_IMediaControl, pMediaControl);
if FAILED(hr) then begin
ShowMessage('Íå óäàåòñÿ ïîëó÷èòü èíòåðôåéñ MediaControl');
exit;
end;
hr := pGraphBuilder.QueryInterface(IID_IMediaEvent, pMediaEvent);
if FAILED(hr) then begin
ShowMessage('Íå óäàåòñÿ ïîëó÷èòü èíòåðôåéñ MediaEvent');
exit;
end;
hr := pGraphBuilder.RenderFile(StringToOleStr(OpenDialog 1.FileName), '');
if FAILED(hr) then begin
ShowMessage('Íå óäàåòñÿ ïðîðåíäåðèòü ôàéë');
exit;
end;
hr := pMediaControl.Run;
if FAILED(hr) then begin
ShowMessage('Íå óäàåòñÿ âîñïðîèçâåñòè ôàéë');
exit;
end;
pMediaEvent.WaitForCompletion(INFINITE, evCode);
end;
end."
|