开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
VidRenderer.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：37k
源码类别：

Delphi控件源码

开发平台：

Delphi

VidRenderer.pas：源码内容
  2.     (*********************************************************************
  3.      *                                                                   *
  4.      * The contents of this file are used with permission, subject to    *
  5.      * the Mozilla Public License Version 1.1 (the "License"); you may   *
  6.      * not use this file except in compliance with the License. You may  *
  7.      * obtain a copy of the License at                                   *
  8.      * http://www.mozilla.org/MPL/MPL-1.1.html                           *
  9.      *                                                                   *
  10.      * Software distributed under the License is distributed on an       *
  11.      * "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or    *
  12.      * implied. See the License for the specific language governing      *
  13.      * rights and limitations under the License.                         *
  14.      *                                                                   *
  15.      * (C) 2004 Milenko Mitrovic <dcoder@dsp-worx.de>                    *
  16.      *                                                                   *
  17.      *********************************************************************)
  19. unit VidRenderer;
  21. interface
  23. uses
  24.   BaseClass, DirectShow9, Windows, SysUtils, Classes, Forms, ActiveX, Graphics,
  25.   Messages, formRenderer;
  27. const
  28.   CLSID_DelphiVideoRenderer: TGUID = '{DB2CF44E-B672-4F18-B407-9169FE84D1EB}';
  30.   DEFWIDTH = 320;                    // Initial window width
  31.   DEFHEIGHT = 240;                   // Initial window height
  34. type
  35.   TVideoRenderer = class(TBCBaseVideoRenderer, IPersist, IVideoWindow, IDispatch,
  36.                          IBasicVideo, IBasicVideo2, IAMFilterMiscFlags)
  37.   private
  38.     fAutoShow : Boolean;
  39.     fDispatch : TBCBaseDispatch;
  40.     fFormat   : TVideoInfoHeader;
  41.     fRenderer : TfrmRenderer;
  42.   public
  43.     constructor Create(ObjName: String; Unk: IUnknown; out hr : HResult);
  44.     constructor CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown); override;
  45.     destructor Destroy; override;
  46.     function CheckMediaType(MediaType: PAMMediaType): HResult; override;
  47.     function DoRenderSample(MediaSample: IMediaSample): HResult; override;
  48.     procedure OnReceiveFirstSample(MediaSample: IMediaSample); override;
  49.     function SetMediaType(MediaType: PAMMediaType): HResult; override;
  50.     function Active: HResult; override;
  51.     function Inactive: HResult; override;
  52.     (*** IDispatch methods ***)
  53.     function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  54.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  55.     function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  56.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  57.     (*** IVideoWindow methods ***)
  58.     function put_Caption(strCaption: WideString): HResult; stdcall;
  59.     function get_Caption(out strCaption: WideString): HResult; stdcall;
  60.     function put_WindowStyle(WindowStyle: Longint): HResult; stdcall;
  61.     function get_WindowStyle(out WindowStyle: Longint): HResult; stdcall;
  62.     function put_WindowStyleEx(WindowStyleEx: Longint): HResult; stdcall;
  63.     function get_WindowStyleEx(out WindowStyleEx: Longint): HResult; stdcall;
  64.     function put_AutoShow(AutoShow: LongBool): HResult; stdcall;
  65.     function get_AutoShow(out AutoShow: LongBool): HResult; stdcall;
  66.     function put_WindowState(WindowState: Longint): HResult; stdcall;
  67.     function get_WindowState(out WindowState: Longint): HResult; stdcall;
  68.     function put_BackgroundPalette(BackgroundPalette: Longint): HResult; stdcall;
  69.     function get_BackgroundPalette(out pBackgroundPalette: Longint): HResult; stdcall;
  70.     function put_Visible(Visible: LongBool): HResult; stdcall;
  71.     function get_Visible(out pVisible: LongBool): HResult; stdcall;
  72.     function put_Left(Left: Longint): HResult; stdcall;
  73.     function get_Left(out pLeft: Longint): HResult; stdcall;
  74.     function put_Width(Width: Longint): HResult; stdcall;
  75.     function get_Width(out pWidth: Longint): HResult; stdcall;
  76.     function put_Top(Top: Longint): HResult; stdcall;
  77.     function get_Top(out pTop: Longint): HResult; stdcall;
  78.     function put_Height(Height: Longint): HResult; stdcall;
  79.     function get_Height(out pHeight: Longint): HResult; stdcall;
  80.     function put_Owner(Owner: OAHWND): HResult; stdcall;
  81.     function get_Owner(out Owner: OAHWND): HResult; stdcall;
  82.     function put_MessageDrain(Drain: OAHWND): HResult; stdcall;
  83.     function get_MessageDrain(out Drain: OAHWND): HResult; stdcall;
  84.     function get_BorderColor(out Color: Longint): HResult; stdcall;
  85.     function put_BorderColor(Color: Longint): HResult; stdcall;
  86.     function get_FullScreenMode(out FullScreenMode: LongBool): HResult; stdcall;
  87.     function put_FullScreenMode(FullScreenMode: LongBool): HResult; stdcall;
  88.     function SetWindowForeground(Focus: Longint): HResult; stdcall;
  89.     function NotifyOwnerMessage(hwnd: Longint; uMsg, wParam, lParam: Longint): HResult; stdcall;
  90.     function SetWindowPosition(Left, Top, Width, Height: Longint): HResult; stdcall;
  91.     function GetWindowPosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
  92.     function GetMinIdealImageSize(out pWidth, pHeight: Longint): HResult; stdcall;
  93.     function GetMaxIdealImageSize(out pWidth, pHeight: Longint): HResult; stdcall;
  94.     function GetRestorePosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
  95.     function HideCursor(HideCursor: LongBool): HResult; stdcall;
  96.     function IsCursorHidden(out CursorHidden: LongBool): HResult; stdcall;
  97.     (*** IBasicVideo methods ***)
  98.     function get_AvgTimePerFrame(out pAvgTimePerFrame: TRefTime): HResult; stdcall;
  99.     function get_BitRate(out pBitRate: Longint): HResult; stdcall;
  100.     function get_BitErrorRate(out pBitErrorRate: Longint): HResult; stdcall;
  101.     function get_VideoWidth(out pVideoWidth: Longint): HResult; stdcall;
  102.     function get_VideoHeight(out pVideoHeight: Longint): HResult; stdcall;
  103.     function put_SourceLeft(SourceLeft: Longint): HResult; stdcall;
  104.     function get_SourceLeft(out pSourceLeft: Longint): HResult; stdcall;
  105.     function put_SourceWidth(SourceWidth: Longint): HResult; stdcall;
  106.     function get_SourceWidth(out pSourceWidth: Longint): HResult; stdcall;
  107.     function put_SourceTop(SourceTop: Longint): HResult; stdcall;
  108.     function get_SourceTop(out pSourceTop: Longint): HResult; stdcall;
  109.     function put_SourceHeight(SourceHeight: Longint): HResult; stdcall;
  110.     function get_SourceHeight(out pSourceHeight: Longint): HResult; stdcall;
  111.     function put_DestinationLeft(DestinationLeft: Longint): HResult; stdcall;
  112.     function get_DestinationLeft(out pDestinationLeft: Longint): HResult; stdcall;
  113.     function put_DestinationWidth(DestinationWidth: Longint): HResult; stdcall;
  114.     function get_DestinationWidth(out pDestinationWidth: Longint): HResult; stdcall;
  115.     function put_DestinationTop(DestinationTop: Longint): HResult; stdcall;
  116.     function get_DestinationTop(out pDestinationTop: Longint): HResult; stdcall;
  117.     function put_DestinationHeight(DestinationHeight: Longint): HResult; stdcall;
  118.     function get_DestinationHeight(out pDestinationHeight: Longint): HResult; stdcall;
  119.     function SetSourcePosition(Left, Top, Width, Height: Longint): HResult; stdcall;
  120.     function GetSourcePosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
  121.     function SetDefaultSourcePosition: HResult; stdcall;
  122.     function SetDestinationPosition(Left, Top, Width, Height: Longint): HResult; stdcall;
  123.     function GetDestinationPosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
  124.     function SetDefaultDestinationPosition: HResult; stdcall;
  125.     function GetVideoSize(out pWidth, Height: Longint): HResult; stdcall;
  126.     function GetVideoPaletteEntries(StartIndex, Entries: Longint; out pRetrieved: Longint; out pPalette): HResult; stdcall;
  127.     function GetCurrentImage(var BufferSize: Longint; var pDIBImage): HResult; stdcall;
  128.     function IsUsingDefaultSource: HResult; stdcall;
  129.     function IsUsingDefaultDestination: HResult; stdcall;
  130.     (*** IBasicVideo2 methods ***)
  131.     function GetPreferredAspectRatio(out plAspectX, plAspectY: Longint): HResult; stdcall;
  132.     (*** IAMFilterMiscFlags methods ***)
  133.     function GetMiscFlags: ULONG; stdcall;
  134.   end;
  136. implementation
  138. function CheckConnected(Pin : TBCBasePin; out Res : HRESULT) : Boolean;
  139. begin
  140.   if not Pin.IsConnected then
  141.   begin
  142.     Res := VFW_E_NOT_CONNECTED;
  143.     Result := False;
  144.   end else
  145.   begin
  146.     Res := S_OK;
  147.     Result := True;
  148.   end;
  149. end;
  151. constructor TVideoRenderer.Create(ObjName: String; Unk: IUnknown; out hr: HResult);
  152. begin
  153.   inherited Create(CLSID_DelphiVideoRenderer, 'Delphi Video Renderer', Unk, hr);
  154.   fDispatch := TBCBaseDispatch.Create;
  155.   fRenderer := TfrmRenderer.Create(nil);
  156.   fAutoShow := True;
  157. end;
  159. constructor TVideoRenderer.CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown);
  160. var
  161.   hr: HRESULT;
  162. begin
  163.   Create(Factory.Name, Controller, hr);
  164. end;
  166. destructor TVideoRenderer.Destroy;
  167. begin
  168.   if Assigned(fDispatch) then FreeAndNil(fDispatch);
  169.   if Assigned(fRenderer) then FreeAndNil(fRenderer);
  170.   inherited Destroy;
  171. end;
  173. function TVideoRenderer.Active: HResult;
  174. begin
  175.   if fAutoShow then fRenderer.Show;
  176.   Result := inherited Active;
  177. end;
  179. function TVideoRenderer.Inactive: HResult;
  180. begin
  181.   Result := inherited Inactive;
  182. end;
  184. function TVideoRenderer.CheckMediaType(MediaType: PAMMediaType): HResult;
  185. begin
  186.   if (MediaType = nil) then
  187.   begin
  188.     Result := E_POINTER;
  189.     Exit;
  190.   end;
  192.   if not IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) or
  193.      not IsEqualGUID(MediaType.subtype, MEDIASUBTYPE_RGB24) or
  194.      not IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
  195.   begin
  196.     Result := E_INVALIDARG;
  197.     Exit;
  198.   end;
  200.   Result := NOERROR;
  201. end;
  203. function TVideoRenderer.DoRenderSample(MediaSample: IMediaSample): HResult;
  204. begin
  205.   if (MediaSample = nil) then
  206.   begin
  207.     Result := E_POINTER;
  208.     Exit;
  209.   end;
  211.   fRenderer.DoRenderSample(MediaSample);
  212.   Result := NOERROR;
  213. end;
  215. procedure TVideoRenderer.OnReceiveFirstSample(MediaSample: IMediaSample);
  216. begin
  217.   DoRenderSample(MediaSample);
  218. end;
  220. function TVideoRenderer.SetMediaType(MediaType: PAMMediaType): HResult;
  221. var
  222.   VIH: PVIDEOINFOHEADER;
  223. begin
  224.   if (MediaType = nil) then
  225.   begin
  226.     Result := E_POINTER;
  227.     Exit;
  228.   end;
  230.   VIH := PVIDEOINFOHEADER(MediaType.pbFormat);
  231.   if (VIH = nil) then
  232.   begin
  233.     Result := E_UNEXPECTED;
  234.     Exit;
  235.   end;
  237.   CopyMemory(@fFormat,VIH,SizeOf(TVideoInfoHeader));
  238.   fRenderer.DoInitializeDirectDraw(@fFormat);
  239.   Result := S_OK;
  240. end;
  241. {*** IDispatch methods *** taken from CBaseVideoWindow *** ctlutil.cpp ********}
  242. function TVideoRenderer.GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  243. begin
  244.   Result := fDispatch.GetTypeInfoCount(Count);
  245. end;
  247. function TVideoRenderer.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  248. begin
  249.   Result := fDispatch.GetTypeInfo(IID_IVideoWindow,Index,LocaleID,TypeInfo);
  250. end;
  252. function TVideoRenderer.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  253. begin
  254.   Result := fDispatch.GetIDsOfNames(IID_IVideoWindow,Names,NameCount,LocaleID,DispIDs);
  255. end;
  257. function TVideoRenderer.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  258. var
  259.   pti : ITypeInfo;
  260. begin
  261.   if not IsEqualGUID(GUID_NULL,IID) then
  262.   begin
  263.     Result := DISP_E_UNKNOWNINTERFACE;
  264.     Exit;
  265.   end;
  267.   Result := GetTypeInfo(0, LocaleID, pti);
  269.   if FAILED(Result) then Exit;
  271.   Result :=  pti.Invoke(Pointer(Self as IVideoWindow),DispID,Flags,
  272.                         TDispParams(Params),VarResult,ExcepInfo,ArgErr);
  273.   pti := nil;
  274. end;
  275. (*** IVideoWindow methods *****************************************************)
  276. function TVideoRenderer.put_Caption(strCaption: WideString): HResult; stdcall;
  277. begin
  278.   if not CheckConnected(FInputPin,Result) then Exit;
  279.   fRenderer.Caption := strCaption;
  280. end;
  282. function TVideoRenderer.get_Caption(out strCaption: WideString): HResult; stdcall;
  283. begin
  284.   if not CheckConnected(FInputPin,Result) then Exit;
  285.   strCaption := fRenderer.Caption;
  286. end;
  288. function TVideoRenderer.put_WindowStyle(WindowStyle: Longint): HResult; stdcall;
  289. begin
  290.   if not CheckConnected(FInputPin,Result) then Exit;
  292.   // These styles cannot be changed dynamically
  293.   if (Bool(WindowStyle and WS_DISABLED) or
  294.       Bool(WindowStyle and WS_ICONIC) or
  295.       Bool(WindowStyle and WS_MAXIMIZE) or
  296.       Bool(WindowStyle and WS_MINIMIZE) or
  297.       Bool(WindowStyle and WS_HSCROLL) or
  298.       Bool(WindowStyle and WS_VSCROLL)) then
  299.       begin
  300.         Result := E_INVALIDARG;
  301.         Exit;
  302.       end;
  303.       
  304.   Result := fRenderer.DoSetWindowStyle(WindowStyle,GWL_STYLE);
  305. end;
  307. function TVideoRenderer.get_WindowStyle(out WindowStyle: Longint): HResult; stdcall;
  308. begin
  309.   if not CheckConnected(FInputPin,Result) then Exit;
  310.   Result := fRenderer.DoGetWindowStyle(WindowStyle,GWL_STYLE);
  311. end;
  313. function TVideoRenderer.put_WindowStyleEx(WindowStyleEx: Longint): HResult; stdcall;
  314. begin
  315.   if not CheckConnected(FInputPin,Result) then Exit;
  317.   // Should we be taking off WS_EX_TOPMOST
  318.   if (GetWindowLong(fRenderer.Handle,GWL_EXSTYLE) and WS_EX_TOPMOST > 0) then
  319.   begin
  320.     if ((WindowStyleEx and WS_EX_TOPMOST) = 0) then
  321.     begin
  322. //      SendMessage(fRenderer.Handle,m_ShowStageTop,WPARAM(FALSE),0);
  323.     end;
  324.   end;
  326.   // Likewise should we be adding WS_EX_TOPMOST
  327.   if (WindowStyleEx and WS_EX_TOPMOST > 0) then
  328.   begin
  329. //    SendMessage(m_hwnd,m_ShowStageTop,(WPARAM) TRUE,(LPARAM) 0);
  330.     WindowStyleEx := WindowStyleEx and not WS_EX_TOPMOST;
  331.     if (WindowStyleEx = 0) then
  332.     begin
  333.       Result := NOERROR;
  334.       Exit;
  335.     end;
  336.   end;
  338.   Result := fRenderer.DoSetWindowStyle(WindowStyleEx,GWL_EXSTYLE);
  339. end;
  341. function TVideoRenderer.get_WindowStyleEx(out WindowStyleEx: Longint): HResult; stdcall;
  342. begin
  343.   if not CheckConnected(FInputPin,Result) then Exit;
  344.   Result := fRenderer.DoGetWindowStyle(WindowStyleEx,GWL_EXSTYLE);
  345. end;
  347. function TVideoRenderer.put_AutoShow(AutoShow: LongBool): HResult; stdcall;
  348. begin
  349.   if not CheckConnected(FInputPin,Result) then Exit;
  350.   fAutoShow := AutoShow;
  351. end;
  353. function TVideoRenderer.get_AutoShow(out AutoShow: LongBool): HResult; stdcall;
  354. begin
  355.   if not CheckConnected(FInputPin,Result) then Exit;
  356.   AutoShow := fAutoShow;
  357. end;
  359. function TVideoRenderer.put_WindowState(WindowState: Longint): HResult; stdcall;
  360. begin
  361.   if not CheckConnected(FInputPin,Result) then Exit;
  362.   Result := fRenderer.DoShowWindow(WindowState);
  363. end;
  365. function TVideoRenderer.get_WindowState(out WindowState: Longint): HResult; stdcall;
  366. begin
  367.   if not CheckConnected(FInputPin,Result) then Exit;
  369.   WindowState := 0;
  371.   // Is the window visible, a window is termed visible if it is somewhere on
  372.   // the current desktop even if it is completely obscured by other windows
  373.   // so the flag is a style for each window set with the WS_VISIBLE bit
  375.   if fRenderer.Visible then
  376.   begin
  377.     // Is the base window iconic
  378.     if IsIconic(fRenderer.Handle) then
  379.     begin
  380.       WindowState := WindowState or SW_MINIMIZE;
  381.     end
  382.     // Has the window been maximised
  383.     else if IsZoomed(fRenderer.Handle) then
  384.     begin
  385.       WindowState := WindowState or SW_MAXIMIZE;
  386.     end
  387.     // Window is normal
  388.     else
  389.     begin
  390.       WindowState := WindowState or SW_SHOW;
  391.     end
  393.   end else
  394.   begin
  395.     WindowState := WindowState or SW_HIDE;
  396.   end;
  397.   Result := NOERROR;
  398. end;
  400. function TVideoRenderer.put_BackgroundPalette(BackgroundPalette: Longint): HResult; stdcall;
  401. begin
  402.   if not CheckConnected(FInputPin,Result) then Exit;
  403.   Result := E_NOTIMPL;
  404. end;
  406. function TVideoRenderer.get_BackgroundPalette(out pBackgroundPalette: Longint): HResult; stdcall;
  407. begin
  408.   if not CheckConnected(FInputPin,Result) then Exit;
  409.   Result := E_NOTIMPL;
  410. end;
  412. function TVideoRenderer.put_Visible(Visible: LongBool): HResult; stdcall;
  413. begin
  414.   if not CheckConnected(FInputPin,Result) then Exit;
  415.   fRenderer.Visible := Visible;
  416. end;
  418. function TVideoRenderer.get_Visible(out pVisible: LongBool): HResult; stdcall;
  419. begin
  420.   if not CheckConnected(FInputPin,Result) then Exit;
  421.   pVisible := fRenderer.Visible;
  422. end;
  424. function TVideoRenderer.put_Left(Left: Longint): HResult; stdcall;
  425. var
  426.   bSuccess : Boolean;
  427.   WindowRect : TRect;
  428.   WindowFlags : Cardinal;
  429. begin
  430.   if not CheckConnected(FInputPin,Result) then Exit;
  432.   // Get the current window position in a RECT
  433.   GetWindowRect(fRenderer.Handle,WindowRect);
  435.   if (fRenderer.ParentWindow > 0) then
  436.     MapWindowPoints(HWND_DESKTOP, fRenderer.ParentWindow, WindowRect, 2);
  438.   // Adjust the coordinates ready for SetWindowPos, the window rectangle we
  439.   // get back from GetWindowRect is in left,top,right and bottom while the
  440.   // coordinates SetWindowPos wants are left,top,width and height values
  442.   WindowRect.bottom := WindowRect.bottom - WindowRect.top;
  443.   WindowRect.right := WindowRect.right - WindowRect.left;
  444.   WindowFlags := SWP_NOZORDER or SWP_FRAMECHANGED or SWP_NOACTIVATE;
  446.   bSuccess := SetWindowPos(fRenderer.Handle,                // Window handle
  447.                            HWND_TOP,              // Put it at the top
  448.                            Left,                  // New left position
  449.                            WindowRect.top,        // Leave top alone
  450.                            WindowRect.right,      // The WIDTH (not right)
  451.                            WindowRect.bottom,     // The HEIGHT (not bottom)
  452.                            WindowFlags);          // Show window options
  454.   if not bSuccess then Result := E_INVALIDARG
  455.                   else Result := NOERROR;
  456. end;
  458. function TVideoRenderer.get_Left(out pLeft: Longint): HResult; stdcall;
  459. var
  460.   WindowRect : TRect;
  461. begin
  462.   if not CheckConnected(FInputPin,Result) then Exit;
  464.   GetWindowRect(fRenderer.Handle,WindowRect);
  465.   pLeft := WindowRect.left;
  466.   Result := S_OK;
  467. end;
  469. function TVideoRenderer.put_Width(Width: Longint): HResult; stdcall;
  470. var
  471.   bSuccess : Boolean;
  472.   WindowRect : TRect;
  473.   WindowFlags : Cardinal;
  474. begin
  475.   if not CheckConnected(FInputPin,Result) then Exit;
  477.   // Adjust the coordinates ready for SetWindowPos, the window rectangle we
  478.   // get back from GetWindowRect is in left,top,right and bottom while the
  479.   // coordinates SetWindowPos wants are left,top,width and height values
  481.   GetWindowRect(fRenderer.Handle,WindowRect);
  483.   if (fRenderer.ParentWindow > 0)
  484.     then MapWindowPoints(HWND_DESKTOP, fRenderer.ParentWindow, WindowRect, 2);
  487.   WindowRect.bottom := WindowRect.bottom - WindowRect.top;
  488.   WindowFlags := SWP_NOZORDER or SWP_FRAMECHANGED or SWP_NOACTIVATE;
  490.     // This seems to have a bug in that calling SetWindowPos on a window with
  491.     // just the width changing causes it to ignore the width that you pass in
  492.     // and sets it to a mimimum value of 110 pixels wide (Windows NT 3.51)
  494.   bSuccess := SetWindowPos(fRenderer.Handle,                // Window handle
  495.                            HWND_TOP,              // Put it at the top
  496.                            WindowRect.left,       // Leave left alone
  497.                            WindowRect.top,        // Leave top alone
  498.                            Width,                 // New WIDTH dimension
  499.                            WindowRect.bottom,     // The HEIGHT (not bottom)
  500.                            WindowFlags);          // Show window options
  502.   if not bSuccess then Result := E_INVALIDARG
  503.                   else Result := NOERROR;
  504. end;
  506. function TVideoRenderer.get_Width(out pWidth: Longint): HResult; stdcall;
  507. var
  508.   WindowRect : TRect;
  509. begin
  510.   if not CheckConnected(FInputPin,Result) then Exit;
  511.   GetWindowRect(fRenderer.Handle,WindowRect);
  512.   pWidth := WindowRect.right - WindowRect.left;
  513.   Result := NOERROR;
  514. end;
  516. function TVideoRenderer.put_Top(Top: Longint): HResult; stdcall;
  517. var
  518.   bSuccess : Boolean;
  519.   WindowRect : TRect;
  520.   WindowFlags : Cardinal;
  521. begin
  522.   if not CheckConnected(FInputPin,Result) then Exit;
  524.   // Get the current window position in a RECT
  525.   GetWindowRect(fRenderer.Handle,WindowRect);
  527.   if (fRenderer.ParentWindow > 0) then
  528.      MapWindowPoints(HWND_DESKTOP, fRenderer.ParentWindow, WindowRect, 2);
  531.   // Adjust the coordinates ready for SetWindowPos, the window rectangle we
  532.   // get back from GetWindowRect is in left,top,right and bottom while the
  533.   // coordinates SetWindowPos wants are left,top,width and height values
  535.   WindowRect.bottom := WindowRect.bottom - WindowRect.top;
  536.   WindowRect.right := WindowRect.right - WindowRect.left;
  537.   WindowFlags := SWP_NOZORDER or SWP_FRAMECHANGED or SWP_NOACTIVATE;
  539.   bSuccess := SetWindowPos(fRenderer.Handle,                // Window handle
  540.                            HWND_TOP,              // Put it at the top
  541.                            WindowRect.left,       // Leave left alone
  542.                            Top,                   // New top position
  543.                            WindowRect.right,      // The WIDTH (not right)
  544.                            WindowRect.bottom,     // The HEIGHT (not bottom)
  545.                            WindowFlags);          // Show window flags
  547.   if not bSuccess then Result := E_INVALIDARG
  548.                   else Result := NOERROR;
  549. end;
  551. function TVideoRenderer.get_Top(out pTop: Longint): HResult; stdcall;
  552. var
  553.   WindowRect : TRect;
  554. begin
  555.   if not CheckConnected(FInputPin,Result) then Exit;
  556.   GetWindowRect(fRenderer.Handle,WindowRect);
  557.   pTop := WindowRect.Top;
  558.   Result := NOERROR;
  559. end;
  561. function TVideoRenderer.put_Height(Height: Longint): HResult; stdcall;
  562. var
  563.   bSuccess : Boolean;
  564.   WindowRect : TRect;
  565.   WindowFlags : Cardinal;
  566. begin
  567.   if not CheckConnected(FInputPin,Result) then Exit;
  569.   // Adjust the coordinates ready for SetWindowPos, the window rectangle we
  570.   // get back from GetWindowRect is in left,top,right and bottom while the
  571.   // coordinates SetWindowPos wants are left,top,width and height values
  573.   GetWindowRect(fRenderer.Handle,WindowRect);
  575.   if (fRenderer.ParentWindow > 0) then
  576.      MapWindowPoints(HWND_DESKTOP, fRenderer.ParentWindow, WindowRect, 2);
  578.   WindowRect.right := WindowRect.right - WindowRect.left;
  579.   WindowFlags := SWP_NOZORDER or SWP_FRAMECHANGED or SWP_NOACTIVATE;
  581.   bSuccess := SetWindowPos(fRenderer.Handle,                // Window handle
  582.                            HWND_TOP,              // Put it at the top
  583.                            WindowRect.left,       // Leave left alone
  584.                            WindowRect.top,        // Leave top alone
  585.                            WindowRect.right,      // The WIDTH (not right)
  586.                            Height,                // New height dimension
  587.                            WindowFlags);          // Show window flags
  589.   if not bSuccess then Result := E_INVALIDARG
  590.                   else Result := NOERROR;
  591. end;
  593. function TVideoRenderer.get_Height(out pHeight: Longint): HResult; stdcall;
  594. var
  595.   WindowRect : TRect;
  596. begin
  597.   if not CheckConnected(FInputPin,Result) then Exit;
  599.   GetWindowRect(fRenderer.Handle,WindowRect);
  600.   pHeight := WindowRect.bottom - WindowRect.top;
  601.   Result := NOERROR;
  602. end;
  604. function TVideoRenderer.put_Owner(Owner: OAHWND): HResult; stdcall;
  605. begin
  606.   if not CheckConnected(FInputPin,Result) then Exit;
  607.   fRenderer.ParentWindow := Owner;
  609.   // Don't call this with the filter locked
  610.   fRenderer.DoPaintWindow(True);
  611.   {$IFDEF DEBUG}
  612.   DbgLog(Self,'Changed parent to $' + inttohex(hwndParent,8));
  613.   {$ENDIF}
  614.   Result := NOERROR;
  615. end;
  617. function TVideoRenderer.get_Owner(out Owner: OAHWND): HResult; stdcall;
  618. begin
  619.   if not CheckConnected(FInputPin,Result) then Exit;
  620.   Owner := fRenderer.ParentWindow;
  621. end;
  623. function TVideoRenderer.put_MessageDrain(Drain: OAHWND): HResult; stdcall;
  624. begin
  625.   if not CheckConnected(FInputPin,Result) then Exit;
  626.   fRenderer.MessageDrain := Drain;
  627. end;
  629. function TVideoRenderer.get_MessageDrain(out Drain: OAHWND): HResult; stdcall;
  630. begin
  631.   if not CheckConnected(FInputPin,Result) then Exit;
  632.   Drain := fRenderer.MessageDrain;
  633. end;
  635. function TVideoRenderer.get_BorderColor(out Color: Longint): HResult; stdcall;
  636. begin
  637.   if not CheckConnected(FInputPin,Result) then Exit;
  638.   Result := E_NOTIMPL;
  639. end;
  641. function TVideoRenderer.put_BorderColor(Color: Longint): HResult; stdcall;
  642. begin
  643.   if not CheckConnected(FInputPin,Result) then Exit;
  644.   Result := E_NOTIMPL;
  645. end;
  647. function TVideoRenderer.get_FullScreenMode(out FullScreenMode: LongBool): HResult; stdcall;
  648. begin
  649.   if not CheckConnected(FInputPin,Result) then Exit;
  650.   Result := E_NOTIMPL;
  651. end;
  653. function TVideoRenderer.put_FullScreenMode(FullScreenMode: LongBool): HResult; stdcall;
  654. begin
  655.   if not CheckConnected(FInputPin,Result) then Exit;
  656.   Result := E_NOTIMPL;
  657. end;
  659. function TVideoRenderer.SetWindowForeground(Focus: Longint): HResult; stdcall;
  660. begin
  661.   if not CheckConnected(FInputPin,Result) then Exit;
  662.   SendMessage(fRenderer.Handle,WM_SHOWWINDOW,Focus,0);
  663. end;
  665. function TVideoRenderer.NotifyOwnerMessage(hwnd: Longint; uMsg, wParam, lParam: Longint): HResult; stdcall;
  666. begin
  667.   if not CheckConnected(FInputPin,Result) then Exit;
  669.   // Only interested in these Windows messages
  670.   case uMsg of
  671.     WM_SYSCOLORCHANGE,
  672.     WM_PALETTECHANGED,
  673.     WM_PALETTEISCHANGING,
  674.     WM_QUERYNEWPALETTE,
  675.     WM_DEVMODECHANGE,
  676.     WM_DISPLAYCHANGE,
  677.     WM_ACTIVATEAPP:
  678.     begin
  679.       // If we do not have an owner then ignore
  680.       if (fRenderer.ParentWindow = 0) then
  681.       begin
  682.         Result := NOERROR;
  683.         Exit;
  684.       end;
  685.       SendMessage(fRenderer.Handle,uMsg,wParam,lParam);
  686.     end;
  687.     // do NOT fwd WM_MOVE. the parameters are the location of the parent
  688.     // window, NOT what the renderer should be looking at.  But we need
  689.     // to make sure the overlay is moved with the parent window, so we
  690.     // do this.
  691.     WM_MOVE: PostMessage(fRenderer.Handle,WM_PAINT,0,0);
  692.   end;
  693. end;
  695. function TVideoRenderer.SetWindowPosition(Left, Top, Width, Height: Longint): HResult; stdcall;
  696. var
  697.   bSuccess : Boolean;
  698.   WindowFlags : Cardinal;
  699. begin
  700.   if not CheckConnected(FInputPin,Result) then Exit;
  702.   // Set the new size and position
  703.   WindowFlags := SWP_NOZORDER or SWP_FRAMECHANGED or SWP_NOACTIVATE;
  705.   ASSERT(IsWindow(fRenderer.Handle));
  706.   bSuccess := SetWindowPos(fRenderer.Handle,         // Window handle
  707.                            HWND_TOP,       // Put it at the top
  708.                            Left,           // Left position
  709.                            Top,            // Top position
  710.                            Width,          // Window width
  711.                            Height,         // Window height
  712.                            WindowFlags);   // Show window flags
  713.   ASSERT(bSuccess);
  714.   {$IFDEF DEBUG}
  715.     DbgLog(Self,'SWP failed error : ' + inttohex(GetLastError,8));
  716.   {$ENDIF}
  717.   if not bSuccess then Result := E_INVALIDARG
  718.                   else Result := NOERROR;
  719. end;
  721. function TVideoRenderer.GetWindowPosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
  722. var
  723.   WindowRect : TRect;
  724. begin
  725.   if not CheckConnected(FInputPin,Result) then Exit;
  727.   // Get the current window coordinates
  729.   GetWindowRect(fRenderer.Handle,WindowRect);
  731.   // Convert the RECT into left,top,width and height values
  733.   pLeft := WindowRect.left;
  734.   pTop := WindowRect.top;
  735.   pWidth := WindowRect.right - WindowRect.left;
  736.   pHeight := WindowRect.bottom - WindowRect.top;
  738.   Result := NOERROR;
  739. end;
  741. function TVideoRenderer.GetMinIdealImageSize(out pWidth, pHeight: Longint): HResult; stdcall;
  742. var
  743.   State : TFilterState;
  744.   DefaultRect : TRect;
  745. begin
  746.   if not CheckConnected(FInputPin,Result) then Exit;
  748.   // Must not be stopped for this to work correctly
  749.   GetState(0,State);
  750.   if (State = State_Stopped) then
  751.   begin
  752.     Result := VFW_E_WRONG_STATE;
  753.     Exit;
  754.   end;
  756.   DefaultRect := Rect(0,0,DEFWIDTH,DEFHEIGHT);
  757.   pWidth := DefaultRect.Right - DefaultRect.Left;
  758.   pHeight := DefaultRect.Bottom - DefaultRect.Top;
  759.   Result := NOERROR;
  760. end;
  762. function TVideoRenderer.GetMaxIdealImageSize(out pWidth, pHeight: Longint): HResult; stdcall;
  763. var
  764.   State : TFilterState;
  765.   DefaultRect : TRect;
  766. begin
  767.   if not CheckConnected(FInputPin,Result) then Exit;
  769.   // Must not be stopped for this to work correctly
  770.   GetState(0,State);
  771.   if (State = State_Stopped) then
  772.   begin
  773.     Result := VFW_E_WRONG_STATE;
  774.     Exit;
  775.   end;
  777.   DefaultRect := Rect(0,0,DEFWIDTH,DEFHEIGHT);
  778.   pWidth := DefaultRect.Right - DefaultRect.Left;
  779.   pHeight := DefaultRect.Bottom - DefaultRect.Top;
  780.   Result := NOERROR;
  781. end;
  783. function TVideoRenderer.GetRestorePosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
  784. var
  785.   Place : TWindowPlacement;
  786.   WorkArea : TRect;
  787. begin
  788.   if not CheckConnected(FInputPin,Result) then Exit;
  790.   // Use GetWindowPlacement to find the restore position
  792.   Place.length := sizeof(TWindowPlacement);
  793.   GetWindowPlacement(fRenderer.Handle,@Place);
  795.   // We must take into account any task bar present
  797.   if SystemParametersInfo(SPI_GETWORKAREA,0,@WorkArea,0) then
  798.   begin
  799.     if (fRenderer.ParentWindow = 0) then
  800.     begin
  801.       inc(Place.rcNormalPosition.top,WorkArea.top);
  802.       inc(Place.rcNormalPosition.bottom,WorkArea.top);
  803.       inc(Place.rcNormalPosition.left,WorkArea.left);
  804.       inc(Place.rcNormalPosition.right,WorkArea.left);
  805.     end;
  806.   end;
  808.   // Convert the RECT into left,top,width and height values
  810.   pLeft := Place.rcNormalPosition.left;
  811.   pTop := Place.rcNormalPosition.top;
  812.   pWidth := Place.rcNormalPosition.right - Place.rcNormalPosition.left;
  813.   pHeight := Place.rcNormalPosition.bottom - Place.rcNormalPosition.top;
  815.   Result := NOERROR;
  816. end;
  818. function TVideoRenderer.HideCursor(HideCursor: LongBool): HResult; stdcall;
  819. begin
  820.   if not CheckConnected(FInputPin,Result) then Exit;
  821.   Result := E_NOTIMPL;
  822. end;
  824. function TVideoRenderer.IsCursorHidden(out CursorHidden: LongBool): HResult; stdcall;
  825. begin
  826.   if not CheckConnected(FInputPin,Result) then Exit;
  827.   Result := E_NOTIMPL;
  828. end;
  829. (*** IBasicVideo methods ******************************************************)
  830. function TVideoRenderer.get_AvgTimePerFrame(out pAvgTimePerFrame: TRefTime): HResult; stdcall;
  831. begin
  832.   if not CheckConnected(FInputPin,Result) then Exit;
  833.   pAvgTimePerFrame := fFormat.AvgTimePerFrame;
  834.   Result := NOERROR;
  835. end;
  837. function TVideoRenderer.get_BitRate(out pBitRate: Longint): HResult; stdcall;
  838. begin
  839.   if not CheckConnected(FInputPin,Result) then Exit;
  840.   pBitRate := fFormat.dwBitRate;
  841.   Result := NOERROR;
  842. end;
  844. function TVideoRenderer.get_BitErrorRate(out pBitErrorRate: Longint): HResult; stdcall;
  845. begin
  846.   if not CheckConnected(FInputPin,Result) then Exit;
  847.   pBitErrorRate := fFormat.dwBitErrorRate;
  848.   Result := NOERROR;
  849. end;
  851. function TVideoRenderer.get_VideoWidth(out pVideoWidth: Longint): HResult; stdcall;
  852. begin
  853.   if not CheckConnected(FInputPin,Result) then Exit;
  854.   pVideoWidth := fFormat.bmiHeader.biWidth;
  855.   Result := NOERROR;
  856. end;
  858. function TVideoRenderer.get_VideoHeight(out pVideoHeight: Longint): HResult; stdcall;
  859. begin
  860.   if not CheckConnected(FInputPin,Result) then Exit;
  861.   pVideoHeight := fFormat.bmiHeader.biHeight;
  862.   Result := NOERROR;
  863. end;
  865. function TVideoRenderer.put_SourceLeft(SourceLeft: Longint): HResult; stdcall;
  866. begin
  867.   if not CheckConnected(FInputPin,Result) then Exit;
  868.   Result := E_NOTIMPL;
  869. end;
  871. function TVideoRenderer.get_SourceLeft(out pSourceLeft: Longint): HResult; stdcall;
  872. begin
  873.   if not CheckConnected(FInputPin,Result) then Exit;
  874.   Result := E_NOTIMPL;
  875. end;
  877. function TVideoRenderer.put_SourceWidth(SourceWidth: Longint): HResult; stdcall;
  878. begin
  879.   if not CheckConnected(FInputPin,Result) then Exit;
  880.   Result := E_NOTIMPL;
  881. end;
  883. function TVideoRenderer.get_SourceWidth(out pSourceWidth: Longint): HResult; stdcall;
  884. begin
  885.   if not CheckConnected(FInputPin,Result) then Exit;
  886.   Result := E_NOTIMPL;
  887. end;
  889. function TVideoRenderer.put_SourceTop(SourceTop: Longint): HResult; stdcall;
  890. begin
  891.   if not CheckConnected(FInputPin,Result) then Exit;
  892.   Result := E_NOTIMPL;
  893. end;
  895. function TVideoRenderer.get_SourceTop(out pSourceTop: Longint): HResult; stdcall;
  896. begin
  897.   if not CheckConnected(FInputPin,Result) then Exit;
  898.   Result := E_NOTIMPL;
  899. end;
  901. function TVideoRenderer.put_SourceHeight(SourceHeight: Longint): HResult; stdcall;
  902. begin
  903.   if not CheckConnected(FInputPin,Result) then Exit;
  904.   Result := E_NOTIMPL;
  905. end;
  907. function TVideoRenderer.get_SourceHeight(out pSourceHeight: Longint): HResult; stdcall;
  908. begin
  909.   if not CheckConnected(FInputPin,Result) then Exit;
  910.   Result := E_NOTIMPL;
  911. end;
  913. function TVideoRenderer.put_DestinationLeft(DestinationLeft: Longint): HResult; stdcall;
  914. begin
  915.   if not CheckConnected(FInputPin,Result) then Exit;
  916.   Result := E_NOTIMPL;
  917. end;
  919. function TVideoRenderer.get_DestinationLeft(out pDestinationLeft: Longint): HResult; stdcall;
  920. begin
  921.   if not CheckConnected(FInputPin,Result) then Exit;
  922.   Result := E_NOTIMPL;
  923. end;
  925. function TVideoRenderer.put_DestinationWidth(DestinationWidth: Longint): HResult; stdcall;
  926. begin
  927.   if not CheckConnected(FInputPin,Result) then Exit;
  928.   Result := E_NOTIMPL;
  929. end;
  931. function TVideoRenderer.get_DestinationWidth(out pDestinationWidth: Longint): HResult; stdcall;
  932. begin
  933.   if not CheckConnected(FInputPin,Result) then Exit;
  934.   Result := E_NOTIMPL;
  935. end;
  937. function TVideoRenderer.put_DestinationTop(DestinationTop: Longint): HResult; stdcall;
  938. begin
  939.   if not CheckConnected(FInputPin,Result) then Exit;
  940.   Result := E_NOTIMPL;
  941. end;
  943. function TVideoRenderer.get_DestinationTop(out pDestinationTop: Longint): HResult; stdcall;
  944. begin
  945.   if not CheckConnected(FInputPin,Result) then Exit;
  946.   Result := E_NOTIMPL;
  947. end;
  949. function TVideoRenderer.put_DestinationHeight(DestinationHeight: Longint): HResult; stdcall;
  950. begin
  951.   if not CheckConnected(FInputPin,Result) then Exit;
  952.   Result := E_NOTIMPL;
  953. end;
  955. function TVideoRenderer.get_DestinationHeight(out pDestinationHeight: Longint): HResult; stdcall;
  956. begin
  957.   if not CheckConnected(FInputPin,Result) then Exit;
  958.   Result := E_NOTIMPL;
  959. end;
  961. function TVideoRenderer.SetSourcePosition(Left, Top, Width, Height: Longint): HResult; stdcall;
  962. begin
  963.   if not CheckConnected(FInputPin,Result) then Exit;
  964.   Result := E_NOTIMPL;
  965. end;
  967. function TVideoRenderer.GetSourcePosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
  968. begin
  969.   if not CheckConnected(FInputPin,Result) then Exit;
  970.   Result := E_NOTIMPL;
  971. end;
  973. function TVideoRenderer.SetDefaultSourcePosition: HResult; stdcall;
  974. begin
  975.   if not CheckConnected(FInputPin,Result) then Exit;
  976.   Result := E_NOTIMPL;
  977. end;
  979. function TVideoRenderer.SetDestinationPosition(Left, Top, Width, Height: Longint): HResult; stdcall;
  980. begin
  981.   if not CheckConnected(FInputPin,Result) then Exit;
  982.   Result := E_NOTIMPL;
  983. end;
  985. function TVideoRenderer.GetDestinationPosition(out pLeft, pTop, pWidth, pHeight: Longint): HResult; stdcall;
  986. begin
  987.   if not CheckConnected(FInputPin,Result) then Exit;
  988.   Result := E_NOTIMPL;
  989. end;
  991. function TVideoRenderer.SetDefaultDestinationPosition: HResult; stdcall;
  992. begin
  993.   if not CheckConnected(FInputPin,Result) then Exit;
  994.   Result := E_NOTIMPL;
  995. end;
  997. function TVideoRenderer.GetVideoSize(out pWidth, Height: Longint): HResult; stdcall;
  998. begin
  999.   if not CheckConnected(FInputPin,Result) then Exit;
  1000.   pWidth := fFormat.bmiHeader.biWidth;
  1001.   Height := fFormat.bmiHeader.biHeight;
  1002.   Result := NOERROR;
  1003. end;
  1005. function TVideoRenderer.GetVideoPaletteEntries(StartIndex, Entries: Longint; out pRetrieved: Longint; out pPalette): HResult; stdcall;
  1006. begin
  1007.   if not CheckConnected(FInputPin,Result) then Exit;
  1008.   Result := E_NOTIMPL;
  1009. end;
  1011. function TVideoRenderer.GetCurrentImage(var BufferSize: Longint; var pDIBImage): HResult; stdcall;
  1012. begin
  1013.   if not CheckConnected(FInputPin,Result) then Exit;
  1014.   Result := E_NOTIMPL;
  1015. end;
  1017. function TVideoRenderer.IsUsingDefaultSource: HResult; stdcall;
  1018. begin
  1019.   if not CheckConnected(FInputPin,Result) then Exit;
  1020.   Result := E_NOTIMPL;
  1021. end;
  1023. function TVideoRenderer.IsUsingDefaultDestination: HResult; stdcall;
  1024. begin
  1025.   if not CheckConnected(FInputPin,Result) then Exit;
  1026.   Result := E_NOTIMPL;
  1027. end;
  1028. (*** IBasicVideo2 methods *****************************************************)
  1029. function TVideoRenderer.GetPreferredAspectRatio(out plAspectX, plAspectY: Longint): HResult; stdcall;
  1030. begin
  1031.   if not CheckConnected(FInputPin,Result) then Exit;
  1032.   Result := E_NOTIMPL;
  1033. end;
  1034. (*** IAMFilterMiscFlags methods ***********************************************)
  1035. function TVideoRenderer.GetMiscFlags: ULONG; stdcall;
  1036. begin
  1037.   Result := AM_FILTER_MISC_FLAGS_IS_RENDERER;
  1038. end;
  1039. (******************************************************************************)
  1040. initialization
  1042.   TBCClassFactory.CreateFilter(TVideoRenderer, '_Delphi Video Renderer',
  1043.     CLSID_VideoRenderer, CLSID_LegacyAmFilterCategory, MERIT_DO_NOT_USE,
  1044.     0, nil
  1045.   );
  1047. end.