vidrenderer.pas

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

end;

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

function TVideoRenderer.put_WindowState(WindowState: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Result := fRenderer.DoShowWindow(WindowState);
end;

function TVideoRenderer.get_WindowState(out WindowState: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  WindowState := 0;

  // Is the window visible, a window is termed visible if it is somewhere on
  // the current desktop even if it is completely obscured by other windows
  // so the flag is a style for each window set with the WS_VISIBLE bit

  if fRenderer.Visible then
  begin
    // Is the base window iconic
    if IsIconic(fRenderer.Handle) then
    begin
      WindowState := WindowState or SW_MINIMIZE;
    end
    // Has the window been maximised
    else if IsZoomed(fRenderer.Handle) then
    begin
      WindowState := WindowState or SW_MAXIMIZE;
    end
    // Window is normal
    else
    begin
      WindowState := WindowState or SW_SHOW;
    end

  end else
  begin
    WindowState := WindowState or SW_HIDE;
  end;
  Result := NOERROR;
end;

function TVideoRenderer.put_BackgroundPalette(BackgroundPalette: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Result := E_NOTIMPL;
end;

function TVideoRenderer.get_BackgroundPalette(out pBackgroundPalette: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Result := E_NOTIMPL;
end;

function TVideoRenderer.put_Visible(Visible: LongBool): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  fRenderer.Visible := Visible;
end;

function TVideoRenderer.get_Visible(out pVisible: LongBool): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  pVisible := fRenderer.Visible;
end;

function TVideoRenderer.put_Left(Left: Longint): HResult; stdcall;
var
  bSuccess : Boolean;
  WindowRect : TRect;
  WindowFlags : Cardinal;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  // Get the current window position in a RECT
  GetWindowRect(fRenderer.Handle,WindowRect);

  if (fRenderer.ParentWindow > 0) then
    MapWindowPoints(HWND_DESKTOP, fRenderer.ParentWindow, WindowRect, 2);

  // Adjust the coordinates ready for SetWindowPos, the window rectangle we
  // get back from GetWindowRect is in left,top,right and bottom while the
  // coordinates SetWindowPos wants are left,top,width and height values

  WindowRect.bottom := WindowRect.bottom - WindowRect.top;
  WindowRect.right := WindowRect.right - WindowRect.left;
  WindowFlags := SWP_NOZORDER or SWP_FRAMECHANGED or SWP_NOACTIVATE;

  bSuccess := SetWindowPos(fRenderer.Handle,                // Window handle
                           HWND_TOP,              // Put it at the top
                           Left,                  // New left position
                           WindowRect.top,        // Leave top alone
                           WindowRect.right,      // The WIDTH (not right)
                           WindowRect.bottom,     // The HEIGHT (not bottom)
                           WindowFlags);          // Show window options

  if not bSuccess then Result := E_INVALIDARG
                  else Result := NOERROR;
end;

function TVideoRenderer.get_Left(out pLeft: Longint): HResult; stdcall;
var
  WindowRect : TRect;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  GetWindowRect(fRenderer.Handle,WindowRect);
  pLeft := WindowRect.left;
  Result := S_OK;
end;

function TVideoRenderer.put_Width(Width: Longint): HResult; stdcall;
var
  bSuccess : Boolean;
  WindowRect : TRect;
  WindowFlags : Cardinal;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  // Adjust the coordinates ready for SetWindowPos, the window rectangle we
  // get back from GetWindowRect is in left,top,right and bottom while the
  // coordinates SetWindowPos wants are left,top,width and height values

  GetWindowRect(fRenderer.Handle,WindowRect);

  if (fRenderer.ParentWindow > 0)
    then MapWindowPoints(HWND_DESKTOP, fRenderer.ParentWindow, WindowRect, 2);


  WindowRect.bottom := WindowRect.bottom - WindowRect.top;
  WindowFlags := SWP_NOZORDER or SWP_FRAMECHANGED or SWP_NOACTIVATE;

    // This seems to have a bug in that calling SetWindowPos on a window with
    // just the width changing causes it to ignore the width that you pass in
    // and sets it to a mimimum value of 110 pixels wide (Windows NT 3.51)

  bSuccess := SetWindowPos(fRenderer.Handle,                // Window handle
                           HWND_TOP,              // Put it at the top
                           WindowRect.left,       // Leave left alone
                           WindowRect.top,        // Leave top alone
                           Width,                 // New WIDTH dimension
                           WindowRect.bottom,     // The HEIGHT (not bottom)
                           WindowFlags);          // Show window options

  if not bSuccess then Result := E_INVALIDARG
                  else Result := NOERROR;
end;

function TVideoRenderer.get_Width(out pWidth: Longint): HResult; stdcall;
var
  WindowRect : TRect;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  GetWindowRect(fRenderer.Handle,WindowRect);
  pWidth := WindowRect.right - WindowRect.left;
  Result := NOERROR;
end;

function TVideoRenderer.put_Top(Top: Longint): HResult; stdcall;
var
  bSuccess : Boolean;
  WindowRect : TRect;
  WindowFlags : Cardinal;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  // Get the current window position in a RECT
  GetWindowRect(fRenderer.Handle,WindowRect);

  if (fRenderer.ParentWindow > 0) then
     MapWindowPoints(HWND_DESKTOP, fRenderer.ParentWindow, WindowRect, 2);


  // Adjust the coordinates ready for SetWindowPos, the window rectangle we
  // get back from GetWindowRect is in left,top,right and bottom while the
  // coordinates SetWindowPos wants are left,top,width and height values

  WindowRect.bottom := WindowRect.bottom - WindowRect.top;
  WindowRect.right := WindowRect.right - WindowRect.left;
  WindowFlags := SWP_NOZORDER or SWP_FRAMECHANGED or SWP_NOACTIVATE;

  bSuccess := SetWindowPos(fRenderer.Handle,                // Window handle
                           HWND_TOP,              // Put it at the top
                           WindowRect.left,       // Leave left alone
                           Top,                   // New top position
                           WindowRect.right,      // The WIDTH (not right)
                           WindowRect.bottom,     // The HEIGHT (not bottom)
                           WindowFlags);          // Show window flags

  if not bSuccess then Result := E_INVALIDARG
                  else Result := NOERROR;
end;

function TVideoRenderer.get_Top(out pTop: Longint): HResult; stdcall;
var
  WindowRect : TRect;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  GetWindowRect(fRenderer.Handle,WindowRect);
  pTop := WindowRect.Top;
  Result := NOERROR;
end;

function TVideoRenderer.put_Height(Height: Longint): HResult; stdcall;
var
  bSuccess : Boolean;
  WindowRect : TRect;
  WindowFlags : Cardinal;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  // Adjust the coordinates ready for SetWindowPos, the window rectangle we
  // get back from GetWindowRect is in left,top,right and bottom while the
  // coordinates SetWindowPos wants are left,top,width and height values

  GetWindowRect(fRenderer.Handle,WindowRect);

  if (fRenderer.ParentWindow > 0) then
     MapWindowPoints(HWND_DESKTOP, fRenderer.ParentWindow, WindowRect, 2);

  WindowRect.right := WindowRect.right - WindowRect.left;
  WindowFlags := SWP_NOZORDER or SWP_FRAMECHANGED or SWP_NOACTIVATE;

  bSuccess := SetWindowPos(fRenderer.Handle,                // Window handle
                           HWND_TOP,              // Put it at the top
                           WindowRect.left,       // Leave left alone
                           WindowRect.top,        // Leave top alone
                           WindowRect.right,      // The WIDTH (not right)
                           Height,                // New height dimension
                           WindowFlags);          // Show window flags

  if not bSuccess then Result := E_INVALIDARG
                  else Result := NOERROR;
end;

function TVideoRenderer.get_Height(out pHeight: Longint): HResult; stdcall;
var
  WindowRect : TRect;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  GetWindowRect(fRenderer.Handle,WindowRect);
  pHeight := WindowRect.bottom - WindowRect.top;
  Result := NOERROR;
end;

function TVideoRenderer.put_Owner(Owner: OAHWND): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  fRenderer.ParentWindow := Owner;

  // Don't call this with the filter locked
  fRenderer.DoPaintWindow(True);
  {$IFDEF DEBUG}
  DbgLog(Self,'Changed parent to $' + inttohex(hwndParent,8));
  {$ENDIF}
  Result := NOERROR;
end;

function TVideoRenderer.get_Owner(out Owner: OAHWND): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Owner := fRenderer.ParentWindow;
end;

function TVideoRenderer.put_MessageDrain(Drain: OAHWND): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  fRenderer.MessageDrain := Drain;
end;

function TVideoRenderer.get_MessageDrain(out Drain: OAHWND): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Drain := fRenderer.MessageDrain;
end;

function TVideoRenderer.get_BorderColor(out Color: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Result := E_NOTIMPL;
end;

function TVideoRenderer.put_BorderColor(Color: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Result := E_NOTIMPL;
end;

function TVideoRenderer.get_FullScreenMode(out FullScreenMode: LongBool): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Result := E_NOTIMPL;
end;

function TVideoRenderer.put_FullScreenMode(FullScreenMode: LongBool): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  Result := E_NOTIMPL;
end;

function TVideoRenderer.SetWindowForeground(Focus: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;
  SendMessage(fRenderer.Handle,WM_SHOWWINDOW,Focus,0);
end;

function TVideoRenderer.NotifyOwnerMessage(hwnd: Longint; uMsg, wParam, lParam: Longint): HResult; stdcall;
begin
  if not CheckConnected(FInputPin,Result) then Exit;

  // Only interested in these Windows messages
  case uMsg of
    WM_SYSCOLORCHANGE,
    WM_PALETTECHANGED,
    WM_PALETTEISCHANGING,
    WM_QUERYNEWPALETTE,
    WM_DEVMODECHANGE,
    WM_DISPLAYCHANGE,
    WM_ACTIVATEAPP:
    begin
      // If we do not have an owner then ignore
      if (fRenderer.ParentWindow = 0) then
      begin
        Result := NOERROR;
        Exit;
      end;
      SendMessage(fRenderer.Handle,uMsg,wParam,lParam);
    end;
    // do NOT fwd WM_MOVE. the parameters are the location of the parent
    // window, NOT what the renderer should be looking at.  But we need
    // to make sure the overlay is moved with the parent window, so we
    // do this.
    WM_MOVE: PostMessage(fRenderer.Handle,WM_PAINT,0,0);
  end;
end;

function TVideoRenderer.SetWindowPosition(Left, Top, Width, Height: Longint): HResult; stdcall;
var
  bSuccess : Boolean;
  WindowFlags : Cardinal;
begin
  if not CheckConnected(FInputPin,Result) then Exit;