- unit Unit1;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtnrs, System.Win.ComObj, EventSink, Winapi.ActiveX,
- Vcl.ExtCtrls, Vcl.StdCtrls;
- const
- CLASS_Player: TGUID ='{A9332148-C691-4B9D-91FC-B9C461DBE9DD}';
- type
- PIUnknown = ^IUnknown;
- TAtlAxAttachControl =function(Control: IUnknown; hwind: hwnd; ppUnkContainer: PIUnknown): HRESULT;stdcall;
- _IPlayerEvents =dispinterface
- ['{31D6469C-1DA7-47C0-91F9-38F0C39F9B89}']
- {
- function OnMessage(nMessage: Integer; wParam: Integer; lParam: Integer): HResult; dispid 1;
- function OnStateChanged(nOldState: Integer; nNewState: Integer): HResult; dispid 2;
- function OnOpenSucceeded: HResult; dispid 3;
- function OnSeekCompleted(nPosition: Integer): HResult; dispid 4;
- function OnBuffer(nPercent: Integer): HResult; dispid 5;
- function OnVideoSizeChanged: HResult; dispid 6;
- function OnDownloadCodec(const strCodecPath: WideString): HResult; dispid 7;
- function OnEvent(nEventCode: Integer; nEventParam: Integer): HResult; dispid 8;
- }
- end;
- TfrmMain =class(TForm)
- pnlCom: TPanel;
- btnOpen: TButton;
- dlgOpen1: TOpenDialog;
- btnPath: TButton;
- procedure FormCreate(Sender: TObject);
- procedure btnOpenClick(Sender: TObject);
- procedure btnPathClick(Sender: TObject);
- private
- { Private declarations }
- APlayer: Variant;
- APlayerCreateSuccess: Boolean;
- EventSink: TEventSink;
- function InitAPlayer: Boolean;
- function CreateComObjectFromDll(CLSID: TGUID; DllHandle: THandle): IUnknown;
- procedure EventSinkInvoke(Sender: TObject; DispID: Integer;
- const IID: TGUID; LocaleID: Integer; Flags: Word;
- Params: tagDISPPARAMS; VarResult, ExcepInfo, ArgErr: Pointer);
- public
- { Public declarations }
- end;
- var
- frmMain: TfrmMain;
- implementation
- {$R *.dfm}
- { TForm1 }
- procedure TfrmMain.btnOpenClick(Sender: TObject);
- begin
- if notAPlayerCreateSuccessthen Exit;
- ifdlgOpen1.Execute(Handle)then
- begin
- APlayer.Open(dlgOpen1.FileName);
- end;
- end;
- procedure TfrmMain.btnPathClick(Sender: TObject);
- begin
- if notAPlayerCreateSuccessthen Exit;
- ShowMessage(APlayer.GetConfig(2));
- end;
- function TfrmMain.CreateComObjectFromDll(CLSID: TGUID;
- DllHandle: THandle): IUnknown;
- var
- Factory: IClassFactory;
- DllGetClassObject: function(constCLSID, IID: TGUID;varObj): HResult;stdcall;
- hr: HRESULT;
- begin
- DllGetClassObject := GetProcAddress(DllHandle,'DllGetClassObject');
- ifAssigned(DllGetClassObject)then
- begin
- hr := DllGetClassObject(CLSID, IClassFactory, Factory);
- ifhr = S_OKthen
- try
- hr := Factory.CreateInstance(nil, IUnknown, Result);
- ifhr <> S_OKthen
- begin
- MessageBox(Handle, '创建APlayer实例失败!','错误', MB_OK + MB_ICONERROR);
- end;
- except
- MessageBox(Handle, PChar('创建APlayer实例失败!错误代码:'+ IntToStr(GetLastError)),'错误', MB_OK + MB_ICONERROR);
- end;
- end;
- end;
- procedure TfrmMain.EventSinkInvoke(Sender: TObject; DispID: Integer;
- const IID: TGUID; LocaleID: Integer; Flags: Word; Params: tagDISPPARAMS;
- VarResult, ExcepInfo, ArgErr: Pointer);
- var
- ov: OleVariant;
- begin
- {
- 这里需要注明Params这个参数, 包含了事件的参数
- 如:
- Params.rgvarg[0] 代表第一个参数
- Params.rgvarg[1] 代表第二个参数
- ......
- Params.rgvarg[65535] 代表第65535个参数
- 最多65535个参数
- 具体可以参考 tagDISPPARAMS 的定义
- }
- case dispid of
- // function OnMessage(nMessage: Integer; wParam: Integer; lParam: Integer): HResult; dispid 1;$00000001:
- begin
- end;
- // function OnStateChanged(nOldState: Integer; nNewState: Integer): HResult; dispid 2;$00000002:
- begin
- end;
- // function OnOpenSucceeded: HResult; dispid 3;$00000003:
- begin
- end;
- // function OnSeekCompleted(nPosition: Integer): HResult; dispid 4;$00000004:
- begin
- end;
- // function OnBuffer(nPercent: Integer): HResult; dispid 5;$00000005:
- begin
- end;
- // function OnVideoSizeChanged: HResult; dispid 6;$00000006:
- begin
- end;
- // function OnDownloadCodec(const strCodecPath: WideString): HResult; dispid 7;$00000007:
- begin
- ov := OleVariant(Params.rgvarg[0]);
- MessageBox(Handle, PChar('缺少解码器文件:'+ VarToStr(ov)),'错误', MB_OK + MB_ICONERROR);
- end;
- // function OnEvent(nEventCode: Integer; nEventParam: Integer): HResult; dispid 8;$00000008:
- begin
- end;
- end
- end;
- procedure TfrmMain.FormCreate(Sender: TObject);
- begin
- ReportMemoryLeaksOnShutdown := DebugHook <>0;
- APlayerCreateSuccess := InitAPlayer;
- end;
- function TfrmMain.InitAPlayer: Boolean;
- var
- hModule, hDll: THandle;
- AtlAxAttachControl: TAtlAxAttachControl;
- begin
- hModule := LoadLibrary('atl.dll');
- ifhModule <32 then
- begin
- Exit(False);
- end;
- AtlAxAttachControl := TAtlAxAttachControl(GetProcAddress(hModule,'AtlAxAttachControl'));
- EventSink := TEventSink.Create(Self);
- EventSink.OnInvoke := EventSinkInvoke;
- if notAssigned(AtlAxAttachControl)then
- Exit(False);
- try
- hDll := LoadLibrary('APlayer.dll');
- APlayer := CreateComObjectFromDll(CLASS_Player, hDll)as IDispatch;
- ifVarIsNull(APlayer)then
- begin
- Exit(False);
- end;
- EventSink.Connect(APlayer, _IPlayerEvents);
- AtlAxAttachControl(APlayer, pnlCom.Handle, nil);
- Result := True;
- except
- Result := False;
- end;
- end;
- end.
来源: http://www.cnblogs.com/dpower/p/6775086.html