vidrenderer.pas

为Delphi2005做了改动 DSPack 2.3.3 (Sep 2004). DSPack is a set of Components and class to write Multimedia

    (*********************************************************************
     *                                                                   *
     * The contents of this file are used with permission, subject to    *
     * the Mozilla Public License Version 1.1 (the "License"); you may   *
     * not use this file except in compliance with the License. You may  *
     * obtain a copy of the License at                                   *
     * http://www.mozilla.org/MPL/MPL-1.1.html                           *
     *                                                                   *
     * Software distributed under the License is distributed on an       *
     * "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or    *
     * implied. See the License for the specific language governing      *
     * rights and limitations under the License.                         *
     *                                                                   *
     * (C) 2004 Milenko Mitrovic <[e-mail]>                    *
     *                                                                   *
     *********************************************************************)

unit VidRenderer;

interface

uses
  BaseClass, DirectShow9, Windows, SysUtils, Classes, Forms, ActiveX, Graphics,
  Messages, formRenderer;

const
  CLSID_DelphiVideoRenderer: TGUID = '{DB2CF44E-B672-4F18-B407-9169FE84D1EB}';

  DEFWIDTH = 320;                    // Initial window width
  DEFHEIGHT = 240;                   // Initial window height


type
  TVideoRenderer = class(TBCBaseVideoRenderer, IPersist, IVideoWindow, IDispatch,
                         IBasicVideo, IBasicVideo2, IAMFilterMiscFlags)
  private
    fAutoShow : Boolean;
    fDispatch : TBCBaseDispatch;
    fFormat   : TVideoInfoHeader;
    fRenderer : TfrmRenderer;
  public
    constructor Create(ObjName: String; Unk: IUnknown; out hr : HResult);
    constructor CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown); override;
    destructor Destroy; override;
    function CheckMediaType(MediaType: PAMMediaType): HResult; override;
    function DoRenderSample(MediaSample: IMediaSample): HResult; override;
    procedure OnReceiveFirstSample(MediaSample: IMediaSample); override;
    function SetMediaType(MediaType: PAMMediaType): HResult; override;
    function Active: HResult; override;
    function Inactive: HResult; override;
    (*** IDispatch methods ***)
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
    function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
    (*** IVideoWindow methods ***)
    function put_Caption(strCaption: WideString): HResult; stdcall;
    function get_Caption(out strCaption: WideString): HResult; stdcall;
    function put_WindowStyle(WindowStyle: Longint): HResult; stdcall;
    function get_WindowStyle(out WindowStyle: Longint): HResult; stdcall;
    function put_WindowStyleEx(WindowStyleEx: Longint): HResult; stdcall;
    function get_WindowStyleEx(out WindowStyleEx: Longint): HResult; stdcall;
    function put_AutoShow(AutoShow: LongBool): HResult; stdcall;
    function get_AutoShow(out AutoShow: LongBool): HResult; stdcall;
    function put_WindowState(WindowState: Longint): HResult; stdcall;
    function get_WindowState(out WindowState: Longint): HResult; stdcall;
    function put_BackgroundPalette(BackgroundPalette: Longint): HResult; stdcall;
    function get_BackgroundPalette(out pBackgroundPalette: Longint): HResult; stdcall;
    function put_Visible(Visible: LongBool): HResult; stdcall;
    function get_Visible(out pVisible: LongBool): HResult; stdcall;
    function put_Left(Left: Longint): HResult; stdcall;
    function get_Left(out pLeft: Longint): HResult; stdcall;
    function put_Width(Width: Longint): HResult; stdcall;
    function get_Width(out pWidth: Longint): HResult; stdcall;
    function put_Top(Top: Longint): HResult; stdcall;
    function get_Top(out pTop: Longint): HResult; stdcall;
    function put_Height(Height: Longint): HResult; stdcall;
    function get_Height(out pHeight: Longint): HResult; stdcall;
    function put_Owner(Owner: OAHWND): HResult; stdcall;
    function get_Owner(out Owner: OAHWND): HResult; stdcall;
    function put_MessageDrain(Drain: OAHWND): HResult; stdcall;
    function get_MessageDrain(out Drain: OAHWND): HResult; stdcall;
    function get_BorderColor(out Color: Longint): HResult; stdcall;
    function put_BorderColor(Color: Longint): HResult; stdcall;
    function get_FullScreenMode(out FullScreenMode: LongBool): HResult; stdcall;
    function put_FullScreenMode(FullScreenMode: LongBool): HResult; stdcall;
    function SetWindowForeground(Focus: Longint): HResult; stdcall;
    function NotifyOwnerMessage(hwnd: Longint; uMsg, wParam, lParam: Longint): HResult; stdcall;
    function SetWindowPosition(Left, Top, Width, Height: Longint): HResult; stdcall;
    function GetWindowPosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
    function GetMinIdealImageSize(out pWidth, pHeight: Longint): HResult; stdcall;
    function GetMaxIdealImageSize(out pWidth, pHeight: Longint): HResult; stdcall;
    function GetRestorePosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
    function HideCursor(HideCursor: LongBool): HResult; stdcall;
    function IsCursorHidden(out CursorHidden: LongBool): HResult; stdcall;
    (*** IBasicVideo methods ***)
    function get_AvgTimePerFrame(out pAvgTimePerFrame: TRefTime): HResult; stdcall;
    function get_BitRate(out pBitRate: Longint): HResult; stdcall;
    function get_BitErrorRate(out pBitErrorRate: Longint): HResult; stdcall;
    function get_VideoWidth(out pVideoWidth: Longint): HResult; stdcall;
    function get_VideoHeight(out pVideoHeight: Longint): HResult; stdcall;
    function put_SourceLeft(SourceLeft: Longint): HResult; stdcall;
    function get_SourceLeft(out pSourceLeft: Longint): HResult; stdcall;
    function put_SourceWidth(SourceWidth: Longint): HResult; stdcall;
    function get_SourceWidth(out pSourceWidth: Longint): HResult; stdcall;
    function put_SourceTop(SourceTop: Longint): HResult; stdcall;
    function get_SourceTop(out pSourceTop: Longint): HResult; stdcall;
    function put_SourceHeight(SourceHeight: Longint): HResult; stdcall;
    function get_SourceHeight(out pSourceHeight: Longint): HResult; stdcall;
    function put_DestinationLeft(DestinationLeft: Longint): HResult; stdcall;
    function get_DestinationLeft(out pDestinationLeft: Longint): HResult; stdcall;
    function put_DestinationWidth(DestinationWidth: Longint): HResult; stdcall;
    function get_DestinationWidth(out pDestinationWidth: Longint): HResult; stdcall;
    function put_DestinationTop(DestinationTop: Longint): HResult; stdcall;
    function get_DestinationTop(out pDestinationTop: Longint): HResult; stdcall;
    function put_DestinationHeight(DestinationHeight: Longint): HResult; stdcall;
    function get_DestinationHeight(out pDestinationHeight: Longint): HResult; stdcall;
    function SetSourcePosition(Left, Top, Width, Height: Longint): HResult; stdcall;
    function GetSourcePosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
    function SetDefaultSourcePosition: HResult; stdcall;
    function SetDestinationPosition(Left, Top, Width, Height: Longint): HResult; stdcall;
    function GetDestinationPosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
    function SetDefaultDestinationPosition: HResult; stdcall;
    function GetVideoSize(out pWidth, Height: Longint): HResult; stdcall;
    function GetVideoPaletteEntries(StartIndex, Entries: Longint; out pRetrieved: Longint; out pPalette): HResult; stdcall;
    function GetCurrentImage(var BufferSize: Longint; var pDIBImage): HResult; stdcall;
    function IsUsingDefaultSource: HResult; stdcall;
    function IsUsingDefaultDestination: HResult; stdcall;
    (*** IBasicVideo2 methods ***)
    function GetPreferredAspectRatio(out plAspectX, plAspectY: Longint): HResult; stdcall;
    (*** IAMFilterMiscFlags methods ***)
    function GetMiscFlags: ULONG; stdcall;
  end;

implementation

function CheckConnected(Pin : TBCBasePin; out Res : HRESULT) : Boolean;
begin
  if not Pin.IsConnected then
  begin
    Res := VFW_E_NOT_CONNECTED;
    Result := False;
  end else
  begin
    Res := S_OK;
    Result := True;
  end;
end;

constructor TVideoRenderer.Create(ObjName: String; Unk: IUnknown; out hr: HResult);
begin
  inherited Create(CLSID_DelphiVideoRenderer, 'Delphi Video Renderer', Unk, hr);
  fDispatch := TBCBaseDispatch.Create;
  fRenderer := TfrmRenderer.Create(nil);
  fAutoShow := True;
end;

constructor TVideoRenderer.CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown);
var
  hr: HRESULT;
begin
  Create(Factory.Name, Controller, hr);
end;

destructor TVideoRenderer.Destroy;
begin
  if Assigned(fDispatch) then FreeAndNil(fDispatch);
  if Assigned(fRenderer) then FreeAndNil(fRenderer);
  inherited Destroy;
end;

function TVideoRenderer.Active: HResult;
begin
  if fAutoShow then fRenderer.Show;
  Result := inherited Active;
end;

function TVideoRenderer.Inactive: HResult;
begin
  Result := inherited Inactive;
end;

function TVideoRenderer.CheckMediaType(MediaType: PAMMediaType): HResult;
begin
  if (MediaType = nil) then
  begin
    Result := E_POINTER;
    Exit;
  end;

  if not IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) or
     not IsEqualGUID(MediaType.subtype, MEDIASUBTYPE_RGB24) or
     not IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  Result := NOERROR;
end;

function TVideoRenderer.DoRenderSample(MediaSample: IMediaSample): HResult;
begin
  if (MediaSample = nil) then
  begin
    Result := E_POINTER;
    Exit;
  end;

  fRenderer.DoRenderSample(MediaSample);
  Result := NOERROR;
end;

procedure TVideoRenderer.OnReceiveFirstSample(MediaSample: IMediaSample);
begin
  DoRenderSample(MediaSample);
end;

function TVideoRenderer.SetMediaType(MediaType: PAMMediaType): HResult;
var
  VIH: PVIDEOINFOHEADER;
begin
  if (MediaType = nil) then
  begin
    Result := E_POINTER;
    Exit;
  end;

  VIH := PVIDEOINFOHEADER(MediaType.pbFormat);
  if (VIH = nil) then
  begin
    Result := E_UNEXPECTED;
    Exit;
  end;

  CopyMemory(@fFormat,VIH,SizeOf(TVideoInfoHeader));
  fRenderer.DoInitializeDirectDraw(@fFormat);
  Result := S_OK;
end;
{*** IDispatch methods *** taken from CBaseVideoWindow *** ctlutil.cpp ********}
function TVideoRenderer.GetTypeInfoCount(out Count: Integer): HResult; stdcall;
begin
  Result := fDispatch.GetTypeInfoCount(Count);
end;

function TVideoRenderer.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
begin
  Result := fDispatch.GetTypeInfo(IID_IVideoWindow,Index,LocaleID,TypeInfo);
end;

function TVideoRenderer.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
begin
  Result := fDispatch.GetIDsOfNames(IID_IVideoWindow,Names,NameCount,LocaleID,DispIDs);
end;

function TVideoRenderer.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
var
  pti : ITypeInfo;
begin
  if not IsEqualGUID(GUID_NULL,IID) then
  begin
    Result := DISP_E_UNKNOWNINTERFACE;
    Exit;
  end;

  Result := GetTypeInfo(0, LocaleID, pti);

  if FAILED(Result) then Exit;

  Result :=  pti.Invoke(Pointer(Self as IVideoWindow),DispID,Flags,
                        TDispParams(Params),VarResult,ExcepInfo,ArgErr);
  pti := nil;
end;
(*** IVideoWindow methods *****************************************************)
function TVideoRenderer.put_Caption(strCaption: WideString): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  fRenderer.Caption := strCaption;
end;

function TVideoRenderer.get_Caption(out strCaption: WideString): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  strCaption := fRenderer.Caption;
end;

function TVideoRenderer.put_WindowStyle(WindowStyle: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  // These styles cannot be changed dynamically
  if (Bool(WindowStyle and WS_DISABLED) or
      Bool(WindowStyle and WS_ICONIC) or
      Bool(WindowStyle and WS_MAXIMIZE) or
      Bool(WindowStyle and WS_MINIMIZE) or
      Bool(WindowStyle and WS_HSCROLL) or
      Bool(WindowStyle and WS_VSCROLL)) then
      begin
        Result := E_INVALIDARG;
        Exit;
      end;
      
  Result := fRenderer.DoSetWindowStyle(WindowStyle,GWL_STYLE);
end;

function TVideoRenderer.get_WindowStyle(out WindowStyle: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Result := fRenderer.DoGetWindowStyle(WindowStyle,GWL_STYLE);
end;

function TVideoRenderer.put_WindowStyleEx(WindowStyleEx: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  // Should we be taking off WS_EX_TOPMOST
  if (GetWindowLong(fRenderer.Handle,GWL_EXSTYLE) and WS_EX_TOPMOST > 0) then
  begin
    if ((WindowStyleEx and WS_EX_TOPMOST) = 0) then
    begin
//      SendMessage(fRenderer.Handle,m_ShowStageTop,WPARAM(FALSE),0);
    end;
  end;

  // Likewise should we be adding WS_EX_TOPMOST
  if (WindowStyleEx and WS_EX_TOPMOST > 0) then
  begin
//    SendMessage(m_hwnd,m_ShowStageTop,(WPARAM) TRUE,(LPARAM) 0);
    WindowStyleEx := WindowStyleEx and not WS_EX_TOPMOST;
    if (WindowStyleEx = 0) then
    begin
      Result := NOERROR;
      Exit;
    end;
  end;

  Result := fRenderer.DoSetWindowStyle(WindowStyleEx,GWL_EXSTYLE);
end;

function TVideoRenderer.get_WindowStyleEx(out WindowStyleEx: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Result := fRenderer.DoGetWindowStyle(WindowStyleEx,GWL_EXSTYLE);
end;

function TVideoRenderer.put_AutoShow(AutoShow: LongBool): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  fAutoShow := AutoShow;