Delphi控件源码

开发平台：

Delphi

BaseClass.pas：源码内容

ASSERT(Fetched = 0);
result := VFW_E_ENUM_OUT_OF_SYNC;
exit;
end;
// We only want to return this pin, if it is not in our cache
if FPinCache.IndexOf(Pin) = -1 then
begin
// From the object get an IPin interface
TPointerDynArray(@ppPins)[Fetched] := nil;
TIPinDynArray(@ppPins)[Fetched] := Pin;
inc(Fetched);
FPinCache.Add(Pin);
dec(RealPins);
end;
end;
if (pcFetched <> nil) then pcFetched^ := Fetched;
if (cPins = Fetched) then result := NOERROR else result := S_FALSE;
end;
function TBCEnumPins.Skip(cPins: ULONG): HRESULT;
var PinsLeft: Cardinal;
begin
// Check we are still in sync with the filter
if AreWeOutOfSync then
begin
result := VFW_E_ENUM_OUT_OF_SYNC;
exit;
end;
// Work out how many pins are left to skip over
// We could position at the end if we are asked to skip too many...
// ..which would match the base implementation for CEnumMediaTypes::Skip
PinsLeft := FPinCount - FPosition;
if (cPins > PinsLeft) then
begin
result := S_FALSE;
exit;
end;
inc(FPosition, cPins);
result := NOERROR;
end;
function TBCEnumPins.Reset: HRESULT;
begin
FVersion := FFilter.GetPinVersion;
FPinCount := FFilter.GetPinCount;
FPosition := 0;
FPinCache.Clear;
result := S_OK;
end;
function TBCEnumPins.Refresh: HRESULT;
begin
FVersion := FFilter.GetPinVersion;
FPinCount := FFilter.GetPinCount;
Fposition := 0;
result := S_OK;
end;
function TBCEnumPins.AreWeOutOfSync: boolean;
begin
if FFilter.GetPinVersion = FVersion then result:= FALSE else result := True;
end;
{ TBCBasePin }
{ Called by IMediaFilter implementation when the state changes from Stopped
to either paused or running and in derived classes could do things like
commit memory and grab hardware resource (the default is to do nothing) }
function TBCBasePin.Active: HRESULT;
begin
result := NOERROR;
end;
{ This is called to make the connection, including the task of finding
a media type for the pin connection. pmt is the proposed media type
from the Connect call: if this is fully specified, we will try that.
Otherwise we enumerate and try all the input pin's types first and
if that fails we then enumerate and try all our preferred media types.
For each media type we check it against pmt (if non-null and partially
specified) as well as checking that both pins will accept it. }
function TBCBasePin.AgreeMediaType(ReceivePin: IPin; pmt: PAMMediaType): HRESULT;
var
EnumMT: IEnumMediaTypes;
hrFailure: HResult;
i: integer;
begin
ASSERT(ReceivePin <> nil);
// if the media type is fully specified then use that
if ((pmt <> nil) and (not TBCMediaType(pmt).IsPartiallySpecified)) then
begin
// if this media type fails, then we must fail the connection
// since if pmt is nonnull we are only allowed to connect
// using a type that matches it.
result := AttemptConnection(ReceivePin, pmt);
exit;
end;
// Try the other pin's enumerator
hrFailure := VFW_E_NO_ACCEPTABLE_TYPES;
for i := 0 to 1 do
begin
if (i = byte(FTryMyTypesFirst)) then
result := ReceivePin.EnumMediaTypes(EnumMT)
else result := EnumMediaTypes(EnumMT);
if Succeeded(Result) then
begin
Assert(EnumMT <> nil);
result := TryMediaTypes(ReceivePin,pmt,EnumMT);
EnumMT := nil;
if Succeeded(result) then
begin
result := NOERROR;
exit;
end
else
begin
// try to remember specific error codes if there are any
if ((result <> E_FAIL) and
(result <> E_INVALIDARG) and
(result <> VFW_E_TYPE_NOT_ACCEPTED)) then hrFailure := result;
end;
end;
end;
result := hrFailure;
end;
function TBCBasePin.AttemptConnection(ReceivePin: IPin; pmt: PAMMediaType): HRESULT;
begin
// The caller should hold the filter lock becasue this function
// uses m_Connected. The caller should also hold the filter lock
// because this function calls SetMediaType(), IsStopped() and
// CompleteConnect().
ASSERT(FLock.CritCheckIn);
// Check that the connection is valid -- need to do this for every
// connect attempt since BreakConnect will undo it.
result := CheckConnect(ReceivePin);
if FAILED(result) then
begin
{$IFDEF DEBUG}
DbgLog(self, 'CheckConnect failed');
{$ENDIF}
// Since the procedure is already returning an error code, there
// is nothing else this function can do to report the error.
Assert(SUCCEEDED(BreakConnect));
exit;
end;
DisplayTypeInfo(ReceivePin, pmt);
// Check we will accept this media type
result := CheckMediaType(pmt);
if (result = NOERROR) then
begin
// Make ourselves look connected otherwise ReceiveConnection
// may not be able to complete the connection
FConnected := ReceivePin;
result := SetMediaType(pmt);
if Succeeded(result) then
begin
// See if the other pin will accept this type */
result := ReceivePin.ReceiveConnection(self, pmt^);
if Succeeded(result) then
begin
// Complete the connection
result := CompleteConnect(ReceivePin);
if Succeeded(result) then exit
else
begin
{$IFDEF DEBUG}
DbgLog(self, 'Failed to complete connection');
{$ENDIF}
ReceivePin.Disconnect;
end;
end;
end;
end
else
begin
// we cannot use this media type
// return a specific media type error if there is one
// or map a general failure code to something more helpful
// (in particular S_FALSE gets changed to an error code)
if (SUCCEEDED(result) or (result = E_FAIL) or (result = E_INVALIDARG)) then
result := VFW_E_TYPE_NOT_ACCEPTED;
end;
// BreakConnect and release any connection here in case CheckMediaType
// failed, or if we set anything up during a call back during
// ReceiveConnection.
// Since the procedure is already returning an error code, there
// is nothing else this function can do to report the error.
Assert(Succeeded(BreakConnect));
// If failed then undo our state
FConnected := nil;
end;
{ This is called when we realise we can't make a connection to the pin and
must undo anything we did in CheckConnect - override to release QIs done }
function TBCBasePin.BreakConnect: HRESULT;
begin
result := NOERROR;
end;
{ This is called during Connect() to provide a virtual method that can do
any specific check needed for connection such as QueryInterface. This
base class method just checks that the pin directions don't match }
function TBCBasePin.CheckConnect(Pin: IPin): HRESULT;
var pd: TPinDirection;
begin
// Check that pin directions DONT match
Pin.QueryDirection(pd);
ASSERT((pd = PINDIR_OUTPUT) or (pd = PINDIR_INPUT));
ASSERT((Fdir = PINDIR_OUTPUT) or (Fdir = PINDIR_INPUT));
// we should allow for non-input and non-output connections?
if (pd = Fdir) then result := VFW_E_INVALID_DIRECTION
else result := NOERROR;
end;
{ Called when we want to complete a connection to another filter. Failing
this will also fail the connection and disconnect the other pin as well }
function TBCBasePin.CompleteConnect(ReceivePin: IPin): HRESULT;
begin
result := NOERROR;
end;
{ Asked to connect to a pin. A pin is always attached to an owning filter
object so we always delegate our locking to that object. We first of all
retrieve a media type enumerator for the input pin and see if we accept
any of the formats that it would ideally like, failing that we retrieve
our enumerator and see if it will accept any of our preferred types }
function TBCBasePin.Connect(pReceivePin: IPin; const pmt: PAMMediaType): HRESULT;
var HR: HResult;
begin
FLock.Lock;
try
DisplayPinInfo(pReceivePin);
// See if we are already connected
if FConnected <> nil then
begin
{$IFDEF DEBUG}
DbgLog(self, 'Already connected');
{$ENDIF}
result := VFW_E_ALREADY_CONNECTED;
// milenko start
Exit;
// milenko end
end;
// See if the filter is active
if (not IsStopped) and (not FCanReconnectWhenActive) then
begin
result := VFW_E_NOT_STOPPED;
exit;
end;
// Find a mutually agreeable media type -
// Pass in the template media type. If this is partially specified,
// each of the enumerated media types will need to be checked against
// it. If it is non-null and fully specified, we will just try to connect
// with this.
Hr := AgreeMediaType(pReceivePin, pmt);
if Failed(hr) then
begin
{$IFDEF DEBUG}
DbgLog(self, 'Failed to agree type');
{$ENDIF}
// Since the procedure is already returning an error code, there
// is nothing else this function can do to report the error.
ASSERT(SUCCEEDED(BreakConnect));
result := HR;
exit;
end;
{$IFDEF DEBUG}
DbgLog(self, 'Connection succeeded');
{$ENDIF}
result := NOERROR;
finally
FLock.UnLock;
end;
end;
// Return an AddRef()'d pointer to the connected pin if there is one
function TBCBasePin.ConnectedTo(out pPin: IPin): HRESULT;
begin
// It's pointless to lock here.
// The caller should ensure integrity.
pPin := FConnected;
if (pPin <> nil) then
result := S_OK
else result := VFW_E_NOT_CONNECTED;
end;
function TBCBasePin.ConnectionMediaType(out pmt: TAMMediaType): HRESULT;
begin
FLock.Lock;
try
// Copy constructor of m_mt allocates the memory
if IsConnected then
begin
CopyMediaType(@pmt,@Fmt);
result := S_OK;
end
else
begin
zeromemory(@pmt, SizeOf(TAMMediaType));
pmt.lSampleSize := 1;
pmt.bFixedSizeSamples := True;
result := VFW_E_NOT_CONNECTED;
end;
finally
FLock.UnLock;
end;
end;
constructor TBCBasePin.Create(ObjectName: string; Filter: TBCBaseFilter;
Lock: TBCCritSec; out hr: HRESULT; Name: WideString;
dir: TPinDirection);
begin
inherited Create(ObjectName, nil);
FFilter := Filter;
FLock := Lock;
FPinName := Name;
FConnected := nil;
Fdir := dir;
FRunTimeError := FALSE;
FQSink := nil;
FTypeVersion := 1;
FStart := 0;
FStop := MAX_TIME;
FCanReconnectWhenActive := false;
FTryMyTypesFirst := false;
FRate := 1.0;
{ WARNING - Filter is often not a properly constituted object at
this state (in particular QueryInterface may not work) - this
is because its owner is often its containing object and we
have been called from the containing object's constructor so
the filter's owner has not yet had its CUnknown constructor
called.}
FRef := 0; // debug
ZeroMemory(@fmt, SizeOf(TAMMediaType));
ASSERT(Filter <> nil);
ASSERT(Lock <> nil);
end;
destructor TBCBasePin.destroy;
begin
// We don't call disconnect because if the filter is going away
// all the pins must have a reference count of zero so they must
// have been disconnected anyway - (but check the assumption)
ASSERT(FConnected = nil);
FPinName := '';
Assert(FRef = 0);
FreeMediaType(@fmt);
inherited Destroy;
end;
// Called when we want to terminate a pin connection
function TBCBasePin.Disconnect: HRESULT;
begin
FLock.Lock;
try
// See if the filter is active
if not IsStopped then
result := VFW_E_NOT_STOPPED
else result := DisconnectInternal;
finally
FLock.UnLock;
end;
end;
function TBCBasePin.DisconnectInternal: HRESULT;
begin
ASSERT(FLock.CritCheckIn);
if (FConnected <> nil) then
begin
result := BreakConnect;
if FAILED(result) then
begin
// There is usually a bug in the program if BreakConnect() fails.
{$IFDEF DEBUG}
DbgLog(self, 'WARNING: BreakConnect() failed in CBasePin::Disconnect().');
{$ENDIF}
exit;
end;
FConnected := nil;
result := S_OK;
exit;
end
else
// no connection - not an error
result := S_FALSE;
end;
procedure TBCBasePin.DisplayPinInfo(ReceivePin: IPin);
{$IFDEF DEBUG}
const
BadPin : WideString = 'Bad Pin';
var
ConnectPinInfo, ReceivePinInfo: TPinInfo;
begin
if FAILED(QueryPinInfo(ConnectPinInfo)) then
move(Pointer(BadPin)^, ConnectPinInfo.achName, length(BadPin) * 2 +2)
else ConnectPinInfo.pFilter := nil;
if FAILED(ReceivePin.QueryPinInfo(ReceivePinInfo)) then
move(Pointer(BadPin)^, ReceivePinInfo.achName, length(BadPin) * 2 +2)
else ReceivePinInfo.pFilter := nil;
DbgLog(self, 'Trying to connect Pins :');
DbgLog(self, format(' <%s>', [ConnectPinInfo.achName]));
DbgLog(self, format(' <%s>', [ReceivePinInfo.achName]));
{$ELSE}
begin
{$ENDIF}
end;
procedure TBCBasePin.DisplayTypeInfo(Pin: IPin; pmt: PAMMediaType);
begin
{$IFDEF DEBUG}
DbgLog(self, 'Trying media type:');
DbgLog(self, ' major type: '+ GuidToString(pmt.majortype));
DbgLog(self, ' sub type : '+ GuidToString(pmt.subtype));
DbgLog(self, GetMediaTypeDescription(pmt));
{$ENDIF}
end;
// Called when no more data will arrive
function TBCBasePin.EndOfStream: HRESULT;
begin
result := S_OK;
end;
{ This can be called to return an enumerator for the pin's list of preferred
media types. An input pin is not obliged to have any preferred formats
although it can do. For example, the window renderer has a preferred type
which describes a video image that matches the current window size. All
output pins should expose at least one preferred format otherwise it is
possible that neither pin has any types and so no connection is possible }
function TBCBasePin.EnumMediaTypes(out ppEnum: IEnumMediaTypes): HRESULT;
begin
// Create a new ref counted enumerator
ppEnum := TBCEnumMediaTypes.Create(self, nil);
if (ppEnum = nil) then result := E_OUTOFMEMORY
else result := NOERROR;
end;
{ This is a virtual function that returns a media type corresponding with
place iPosition in the list. This base class simply returns an error as
we support no media types by default but derived classes should override }
function TBCBasePin.GetMediaType(Position: integer;
out MediaType: PAMMediaType): HRESULT;
begin
result := E_UNEXPECTED;;
end;
{ This is a virtual function that returns the current media type version.
The base class initialises the media type enumerators with the value 1
By default we always returns that same value. A Derived class may change
the list of media types available and after doing so it should increment
the version either in a method derived from this, or more simply by just
incrementing the m_TypeVersion base pin variable. The type enumerators
call this when they want to see if their enumerations are out of date }
function TBCBasePin.GetMediaTypeVersion: longint;
begin
result := FTypeVersion;
end;
{ Also called by the IMediaFilter implementation when the state changes to
Stopped at which point you should decommit allocators and free hardware
resources you grabbed in the Active call (default is also to do nothing) }
function TBCBasePin.Inactive: HRESULT;
begin
FRunTimeError := FALSE;
result := NOERROR;
end;
// Increment the cookie representing the current media type version
procedure TBCBasePin.IncrementTypeVersion;
begin
InterlockedIncrement(FTypeVersion);
end;
function TBCBasePin.IsConnected: boolean;
begin
result := FConnected <> nil;
end;
function TBCBasePin.IsStopped: boolean;
begin
result := FFilter.FState = State_Stopped;
end;
// NewSegment notifies of the start/stop/rate applying to the data
// about to be received. Default implementation records data and
// returns S_OK.
// Override this to pass downstream.
function TBCBasePin.NewSegment(tStart, tStop: TReferenceTime;
dRate: double): HRESULT;
begin
FStart := tStart;
FStop := tStop;
FRate := dRate;
result := S_OK;
end;
function TBCBasePin.NonDelegatingAddRef: Integer;
begin
ASSERT(InterlockedIncrement(FRef) > 0);
result := FFilter._AddRef;
end;
function TBCBasePin.NonDelegatingRelease: Integer;
begin
ASSERT(InterlockedDecrement(FRef) >= 0);
result := FFilter._Release
end;
function TBCBasePin.Notify(pSelf: IBaseFilter; q: TQuality): HRESULT;
begin
{$IFDEF DEBUG}
DbgLog(self, 'IQualityControl::Notify not over-ridden from CBasePin. (IGNORE is OK)');
{$ENDIF}
result := E_NOTIMPL;
end;
{ Does this pin support this media type WARNING this interface function does
not lock the main object as it is meant to be asynchronous by nature - if
the media types you support depend on some internal state that is updated
dynamically then you will need to implement locking in a derived class }
function TBCBasePin.QueryAccept(const pmt: TAMMediaType): HRESULT;
begin
{ The CheckMediaType method is valid to return error codes if the media
type is horrible, an example might be E_INVALIDARG. What we do here
is map all the error codes into either S_OK or S_FALSE regardless }
result := CheckMediaType(@pmt);
if FAILED(result) then result := S_FALSE;
end;
function TBCBasePin.QueryDirection(out pPinDir: TPinDirection): HRESULT;
begin
pPinDir := Fdir;
result := NOERROR;
end;
function TBCBasePin.QueryId(out Id: PWideChar): HRESULT;
begin
result := AMGetWideString(FPinName, id);
end;
function TBCBasePin.QueryInternalConnections(out apPin: IPin;
var nPin: ULONG): HRESULT;
begin
result := E_NOTIMPL;
end;
// Return information about the filter we are connect to
function TBCBasePin.QueryPinInfo(out pInfo: TPinInfo): HRESULT;
begin
pInfo.pFilter := FFilter;
if (FPinName <> '') then
begin
move(Pointer(FPinName)^, pInfo.achName, length(FPinName)*2);
pInfo.achName[length(FPinName)] := #0;
end
else pInfo.achName[0] := #0;
pInfo.dir := Fdir;
result := NOERROR;
end;
{ Called normally by an output pin on an input pin to try and establish a
connection. }
function TBCBasePin.ReceiveConnection(pConnector: IPin;
const pmt: TAMMediaType): HRESULT;
begin
FLock.Lock;
try
// Are we already connected
if (FConnected <> nil) then
begin
result := VFW_E_ALREADY_CONNECTED;
exit;
end;
// See if the filter is active
if (not IsStopped) and (not FCanReconnectWhenActive) then
begin
result := VFW_E_NOT_STOPPED;
exit;
end;
result := CheckConnect(pConnector);
if FAILED(result) then
begin
// Since the procedure is already returning an error code, there
// is nothing else this function can do to report the error.
ASSERT(SUCCEEDED(BreakConnect));
exit;
end;
// Ask derived class if this media type is ok
//CMediaType * pcmt = (CMediaType*) pmt;
result := CheckMediaType(@pmt);
if (result <> NOERROR) then
begin
// no -we don't support this media type
// Since the procedure is already returning an error code, there
// is nothing else this function can do to report the error.
ASSERT(SUCCEEDED(BreakConnect));
// return a specific media type error if there is one
// or map a general failure code to something more helpful
// (in particular S_FALSE gets changed to an error code)
if (SUCCEEDED(result) or
(result = E_FAIL) or
(result = E_INVALIDARG)) then
result := VFW_E_TYPE_NOT_ACCEPTED;
exit;
end;
// Complete the connection
FConnected := pConnector;
result := SetMediaType(@pmt);
if SUCCEEDED(result) then
begin
result := CompleteConnect(pConnector);
if SUCCEEDED(result) then
begin
result := S_OK;
exit;
end;
end;
{$IFDEF DEBUG}
DbgLog(self, 'Failed to set the media type or failed to complete the connection.');
{$ENDIF}
FConnected := nil;
// Since the procedure is already returning an error code, there
// is nothing else this function can do to report the error.
ASSERT(SUCCEEDED(BreakConnect));
finally
FLock.UnLock;
end;
end;
{ Called by IMediaFilter implementation when the state changes from
to either paused to running and in derived classes could do things like
commit memory and grab hardware resource (the default is to do nothing) }
function TBCBasePin.Run(Start: TReferenceTime): HRESULT;
begin
result := NOERROR;
end;
function TBCBasePin.GetCurrentMediaType: TBCMediaType;
begin
result := TBCMediaType(@FMT);
end;
function TBCBasePin.GetAMMediaType: PAMMediaType;
begin
result := @FMT;
end;
{ This is called to set the format for a pin connection - CheckMediaType
will have been called to check the connection format and if it didn't
return an error code then this (virtual) function will be invoked }
function TBCBasePin.SetMediaType(mt: PAMMediaType): HRESULT;
begin
FreeMediaType(@Fmt);
CopyMediaType(@Fmt, mt);
result := NOERROR;
end;
function TBCBasePin.SetSink(piqc: IQualityControl): HRESULT;
begin
FLock.Lock;
try
FQSink := piqc;
result := NOERROR;
finally
FLock.UnLock;
end;
end;
{ Given an enumerator we cycle through all the media types it proposes and
firstly suggest them to our derived pin class and if that succeeds try
them with the pin in a ReceiveConnection call. This means that if our pin
proposes a media type we still check in here that we can support it. This
is deliberate so that in simple cases the enumerator can hold all of the
media types even if some of them are not really currently available }
function TBCBasePin.TryMediaTypes(ReceivePin: IPin; pmt: PAMMediaType;
Enum: IEnumMediaTypes): HRESULT;
var
MediaCount: Cardinal;
hrFailure : HResult;
MediaType : PAMMediaType;
begin
// Reset the current enumerator position
result := Enum.Reset;
if Failed(result) then exit;
MediaCount := 0;
// attempt to remember a specific error code if there is one
hrFailure := S_OK;
while True do
begin
{ Retrieve the next media type NOTE each time round the loop the
enumerator interface will allocate another AM_MEDIA_TYPE structure
If we are successful then we copy it into our output object, if
not then we must delete the memory allocated before returning }
result := Enum.Next(1, MediaType, @MediaCount);
if (result <> S_OK) then
begin
if (S_OK = hrFailure) then
hrFailure := VFW_E_NO_ACCEPTABLE_TYPES;
result := hrFailure;
exit;
end;
ASSERT(MediaCount = 1);
ASSERT(MediaType <> nil);
// check that this matches the partial type (if any)
if (pmt = nil) or TBCMediaType(MediaType).MatchesPartial(pmt) then
begin
result := AttemptConnection(ReceivePin, MediaType);
// attempt to remember a specific error code
if FAILED(result) and
SUCCEEDED(hrFailure) and
(result <> E_FAIL) and
(result <> E_INVALIDARG) and
(result <> VFW_E_TYPE_NOT_ACCEPTED) then hrFailure := result;
end
else result := VFW_E_NO_ACCEPTABLE_TYPES;
DeleteMediaType(MediaType);
if result = S_OK then exit;
end;
end;
{ TBCEnumMediaTypes }
{ The media types a filter supports can be quite dynamic so we add to
the general IEnumXXXX interface the ability to be signaled when they
change via an event handle the connected filter supplies. Until the
Reset method is called after the state changes all further calls to
the enumerator (except Reset) will return E_UNEXPECTED error code. }
function TBCEnumMediaTypes.AreWeOutOfSync: boolean;
begin
if FPin.GetMediaTypeVersion = FVersion then result := FALSE else result := True;
end;
{ One of an enumerator's basic member functions allows us to create a cloned
interface that initially has the same state. Since we are taking a snapshot
of an object (current position and all) we must lock access at the start }
function TBCEnumMediaTypes.Clone(out ppEnum: IEnumMediaTypes): HRESULT;
begin
result := NOERROR;
// Check we are still in sync with the pin
if AreWeOutOfSync then
begin
ppEnum := nil;
result := VFW_E_ENUM_OUT_OF_SYNC;
exit;
end
else
begin
ppEnum := TBCEnumMediaTypes.Create(FPin, self);
if (ppEnum = nil) then result := E_OUTOFMEMORY;
end;
end;
constructor TBCEnumMediaTypes.Create(Pin: TBCBasePin;
EnumMediaTypes: TBCEnumMediaTypes);
begin
FPosition := 0;
FPin := Pin;
{$IFDEF DEBUG}
DbgLog('TBCEnumMediaTypes.Create');
{$ENDIF}
// We must be owned by a pin derived from CBasePin */
ASSERT(Pin <> nil);
// Hold a reference count on our pin
FPin._AddRef;
// Are we creating a new enumerator
if (EnumMediaTypes = nil) then
begin
FVersion := FPin.GetMediaTypeVersion;
exit;
end;
FPosition := EnumMediaTypes.FPosition;
FVersion := EnumMediaTypes.FVersion;
end;
{ Destructor releases the reference count on our base pin. NOTE since we hold
a reference count on the pin who created us we know it is safe to release
it, no access can be made to it afterwards though as we might have just
caused the last reference count to go and the object to be deleted }
destructor TBCEnumMediaTypes.Destroy;
begin
{$IFDEF DEBUG}
DbgLog('TBCEnumMediaTypes.Destroy');
{$ENDIF}
FPin._Release;
inherited;
end;
{ Enumerate the next pin(s) after the current position. The client using this
interface passes in a pointer to an array of pointers each of which will
be filled in with a pointer to a fully initialised media type format
Return NOERROR if it all works,
S_FALSE if fewer than cMediaTypes were enumerated.
VFW_E_ENUM_OUT_OF_SYNC if the enumerator has been broken by
state changes in the filter
The actual count always correctly reflects the number of types in the array.}
function TBCEnumMediaTypes.Next(cMediaTypes: ULONG;
out ppMediaTypes: PAMMediaType; pcFetched: PULONG): HRESULT;
type TMTDynArray = array of PAMMediaType;
var
Fetched: Cardinal;
cmt: PAMMediaType;
begin
// Check we are still in sync with the pin
if AreWeOutOfSync then
begin
result := VFW_E_ENUM_OUT_OF_SYNC;
exit;
end;
if (pcFetched <> nil) then
pcFetched^ := 0 // default unless we succeed
// now check that the parameter is valid
else
if (cMediaTypes > 1) then
begin // pcFetched == NULL
result := E_INVALIDARG;
exit;
end;
Fetched := 0; // increment as we get each one.
{ Return each media type by asking the filter for them in turn - If we
have an error code retured to us while we are retrieving a media type
we assume that our internal state is stale with respect to the filter
(for example the window size changing) so we return
VFW_E_ENUM_OUT_OF_SYNC }
new(cmt);
while (cMediaTypes > 0) do
begin
TBCMediaType(cmt).InitMediaType;
inc(FPosition);
result := FPin.GetMediaType(FPosition-1, cmt);
if (S_OK <> result) then Break;
{ We now have a CMediaType object that contains the next media type
but when we assign it to the array position we CANNOT just assign
the AM_MEDIA_TYPE structure because as soon as the object goes out of
scope it will delete the memory we have just copied. The function
we use is CreateMediaType which allocates a task memory block }
{ Transfer across the format block manually to save an allocate
and free on the format block and generally go faster }
TMTDynArray(@ppMediaTypes)[Fetched] := CoTaskMemAlloc(sizeof(TAMMediaType));
if TMTDynArray(@ppMediaTypes)[Fetched] = nil then Break;
{ Do a regular copy }
//CopyMediaType(TMTDynArray(@ppMediaTypes)[Fetched], cmt);
Move(cmt^,TMTDynArray(@ppMediaTypes)[Fetched]^,SizeOf(TAMMediaType));
// Make sure the destructor doesn't free these
cmt.pbFormat := nil;
cmt.cbFormat := 0;
Pointer(cmt.pUnk) := nil;
inc(Fetched);
dec(cMediaTypes);
end;
dispose(cmt);
if (pcFetched <> nil) then pcFetched^ := Fetched;
if cMediaTypes = 0 then result := NOERROR else result := S_FALSE;
end;
{ Set the current position back to the start
Reset has 3 simple steps:
set position to head of list
sync enumerator with object being enumerated
return S_OK }
function TBCEnumMediaTypes.Reset: HRESULT;
begin
FPosition := 0;
// Bring the enumerator back into step with the current state. This
// may be a noop but ensures that the enumerator will be valid on the
// next call.
FVersion := FPin.GetMediaTypeVersion;
result := NOERROR;
end;
// Skip over one or more entries in the enumerator
function TBCEnumMediaTypes.Skip(cMediaTypes: ULONG): HRESULT;
var cmt: PAMMediaType;
begin
cmt := nil;
// If we're skipping 0 elements we're guaranteed to skip the
// correct number of elements
if (cMediaTypes = 0) then
begin
result := S_OK;
exit;
end;
// Check we are still in sync with the pin
if AreWeOutOfSync then
begin
result := VFW_E_ENUM_OUT_OF_SYNC;
exit;
end;
FPosition := FPosition + cMediaTypes;
// See if we're over the end
if (S_OK = FPin.GetMediaType(FPosition - 1, cmt)) then result := S_OK else result := S_FALSE;
end;
{ TBCBaseOutputPin }
// Commit the allocator's memory, this is called through IMediaFilter
// which is responsible for locking the object before calling us
function TBCBaseOutputPin.Active: HRESULT;
begin
if (FAllocator = nil) then
result := VFW_E_NO_ALLOCATOR
else result := FAllocator.Commit;
end;
function TBCBaseOutputPin.BeginFlush: HRESULT;
begin
result := E_UNEXPECTED;
end;
// Overriden from CBasePin
function TBCBaseOutputPin.BreakConnect: HRESULT;
begin
// Release any allocator we hold
if (FAllocator <> nil) then
begin
// Always decommit the allocator because a downstream filter may or
// may not decommit the connection's allocator. A memory leak could
// occur if the allocator is not decommited when a connection is broken.
result := FAllocator.Decommit;
if FAILED(result) then exit;
FAllocator := nil;
end;
// Release any input pin interface we hold
if (FInputPin <> nil) then FInputPin := nil;
result := NOERROR;
end;
{ This method is called when the output pin is about to try and connect to
an input pin. It is at this point that you should try and grab any extra
interfaces that you need, in this case IMemInputPin. Because this is
only called if we are not currently connected we do NOT need to call
BreakConnect. This also makes it easier to derive classes from us as
BreakConnect is only called when we actually have to break a connection
(or a partly made connection) and not when we are checking a connection }
function TBCBaseOutputPin.CheckConnect(Pin: IPin): HRESULT;
begin
result := inherited CheckConnect(Pin);
if FAILED(result) then exit;
// get an input pin and an allocator interface
result := Pin.QueryInterface(IID_IMemInputPin, FInputPin);
if FAILED(result) then exit;
result := NOERROR;
end;
// This is called after a media type has been proposed
// Try to complete the connection by agreeing the allocator
function TBCBaseOutputPin.CompleteConnect(ReceivePin: IPin): HRESULT;
begin
result := DecideAllocator(FInputPin, FAllocator);
end;
constructor TBCBaseOutputPin.Create(ObjectName: string;
Filter: TBCBaseFilter; Lock: TBCCritSec; out hr: HRESULT;
const Name: WideString);
begin
inherited Create(ObjectName, Filter, Lock, hr, Name, PINDIR_OUTPUT);
FAllocator := nil;
FInputPin := nil;
ASSERT(FFilter <> nil);
end;
{ Decide on an allocator, override this if you want to use your own allocator
Override DecideBufferSize to call SetProperties. If the input pin fails
the GetAllocator call then this will construct a CMemAllocator and call
DecideBufferSize on that, and if that fails then we are completely hosed.
If the you succeed the DecideBufferSize call, we will notify the input
pin of the selected allocator. NOTE this is called during Connect() which
therefore looks after grabbing and locking the object's critical section }
// We query the input pin for its requested properties and pass this to
// DecideBufferSize to allow it to fulfill requests that it is happy
// with (eg most people don't care about alignment and are thus happy to
// use the downstream pin's alignment request).
function TBCBaseOutputPin.DecideAllocator(Pin: IMemInputPin;
out Alloc: IMemAllocator): HRESULT;
var
prop: TAllocatorProperties;
begin
Alloc := nil;
// get downstream prop request
// the derived class may modify this in DecideBufferSize, but
// we assume that he will consistently modify it the same way,
// so we only get it once
ZeroMemory(@prop, sizeof(TAllocatorProperties));
// whatever he returns, we assume prop is either all zeros
// or he has filled it out.
Pin.GetAllocatorRequirements(prop);
// if he doesn't care about alignment, then set it to 1
if (prop.cbAlign = 0) then prop.cbAlign := 1;
// Try the allocator provided by the input pin
result := Pin.GetAllocator(Alloc);
if SUCCEEDED(result) then
begin
result := DecideBufferSize(Alloc, @prop);
if SUCCEEDED(result) then
begin
result := Pin.NotifyAllocator(Alloc, FALSE);
if SUCCEEDED(result) then
begin
result := NOERROR;
exit;
end;
end;
end;
// If the GetAllocator failed we may not have an interface
if (Alloc <> nil) then Alloc := nil;
// Try the output pin's allocator by the same method
result := InitAllocator(Alloc);
if SUCCEEDED(result) then
begin
// note - the properties passed here are in the same
// structure as above and may have been modified by
// the previous call to DecideBufferSize
result := DecideBufferSize(Alloc, @prop);
if SUCCEEDED(result) then
begin
result := Pin.NotifyAllocator(Alloc, FALSE);
if SUCCEEDED(result) then
begin
result := NOERROR;
exit;
end;
end;
end;
// Likewise we may not have an interface to release
if (Alloc <> nil) then Alloc := nil;
end;
function TBCBaseOutputPin.DecideBufferSize(Alloc: IMemAllocator;
propInputRequest: PAllocatorProperties): HRESULT;
begin
result := S_OK; // ???
end;
{ Deliver a filled-in sample to the connected input pin. NOTE the object must
have locked itself before calling us otherwise we may get halfway through
executing this method only to find the filter graph has got in and
disconnected us from the input pin. If the filter has no worker threads
then the lock is best applied on Receive(), otherwise it should be done
when the worker thread is ready to deliver. There is a wee snag to worker
threads that this shows up. The worker thread must lock the object when
it is ready to deliver a sample, but it may have to wait until a state
change has completed, but that may never complete because the state change
is waiting for the worker thread to complete. The way to handle this is for
the state change code to grab the critical section, then set an abort event
for the worker thread, then release the critical section and wait for the
worker thread to see the event we set and then signal that it has finished
(with another event). At which point the state change code can complete }
// note (if you've still got any breath left after reading that) that you
// need to release the sample yourself after this call. if the connected
// input pin needs to hold onto the sample beyond the call, it will addref
// the sample itself.
// of course you must release this one and call GetDeliveryBuffer for the
// next. You cannot reuse it directly.
function TBCBaseOutputPin.Deliver(Sample: IMediaSample): HRESULT;
begin
if (FInputPin = nil) then result := VFW_E_NOT_CONNECTED
else result := FInputPin.Receive(Sample);
end;
// call BeginFlush on the connected input pin
function TBCBaseOutputPin.DeliverBeginFlush: HRESULT;
begin
// remember this is on IPin not IMemInputPin
if (FConnected = nil) then
result := VFW_E_NOT_CONNECTED
else result := FConnected.BeginFlush;
end;
// call EndFlush on the connected input pin
function TBCBaseOutputPin.DeliverEndFlush: HRESULT;
begin
// remember this is on IPin not IMemInputPin
if (FConnected = nil) then
result := VFW_E_NOT_CONNECTED
else result := FConnected.EndFlush;
end;
// called from elsewhere in our filter to pass EOS downstream to
// our connected input pin
function TBCBaseOutputPin.DeliverEndOfStream: HRESULT;
begin
// remember this is on IPin not IMemInputPin
if (FConnected = nil) then
result := VFW_E_NOT_CONNECTED
else result := FConnected.EndOfStream;
end;
// deliver NewSegment to connected pin
function TBCBaseOutputPin.DeliverNewSegment(Start, Stop: TReferenceTime;
Rate: double): HRESULT;
begin
if (FConnected = nil) then
result := VFW_E_NOT_CONNECTED
else result := FConnected.NewSegment(Start, Stop, Rate);
end;
function TBCBaseOutputPin.EndFlush: HRESULT;
begin
result := E_UNEXPECTED;
end;
// we have a default handling of EndOfStream which is to return
// an error, since this should be called on input pins only
function TBCBaseOutputPin.EndOfStream: HRESULT;
begin
result := E_UNEXPECTED;
end;
// This returns an empty sample buffer from the allocator WARNING the same
// dangers and restrictions apply here as described below for Deliver()
function TBCBaseOutputPin.GetDeliveryBuffer(out Sample: IMediaSample;
StartTime, EndTime: PReferenceTime; Flags: Longword): HRESULT;
begin
if (FAllocator <> nil) then
result := FAllocator.GetBuffer(Sample, StartTime, EndTime, Flags)
else result := E_NOINTERFACE;
end;
{ Free up or unprepare allocator's memory, this is called through
IMediaFilter which is responsible for locking the object first }
function TBCBaseOutputPin.Inactive: HRESULT;
begin
FRunTimeError := FALSE;
if (FAllocator = nil) then
result := VFW_E_NO_ALLOCATOR
else result := FAllocator.Decommit;
end;
// This is called when the input pin didn't give us a valid allocator
function TBCBaseOutputPin.InitAllocator(out Alloc: IMemAllocator): HRESULT;
begin
result := CoCreateInstance(CLSID_MemoryAllocator, nil, CLSCTX_INPROC_SERVER,
IID_IMemAllocator, Alloc);
end;
{ TBCBaseInputPin }
// Default handling for BeginFlush - call at the beginning
// of your implementation (makes sure that all Receive calls
// fail). After calling this, you need to free any queued data
// and then call downstream.
function TBCBaseInputPin.BeginFlush: HRESULT;
begin
// BeginFlush is NOT synchronized with streaming but is part of
// a control action - hence we synchronize with the filter
FLock.Lock;
try
// if we are already in mid-flush, this is probably a mistake
// though not harmful - try to pick it up for now so I can think about it
ASSERT(not FFlushing);
// first thing to do is ensure that no further Receive calls succeed
FFlushing := True;
// now discard any data and call downstream - must do that
// in derived classes
result := S_OK;
finally
FLock.UnLock;
end;
end;
function TBCBaseInputPin.BreakConnect: HRESULT;
begin
// We don't need our allocator any more
if (FAllocator <> nil) then
begin
// Always decommit the allocator because a downstream filter may or
// may not decommit the connection's allocator. A memory leak could
// occur if the allocator is not decommited when a pin is disconnected.
result := FAllocator.Decommit;
if FAILED(result) then exit;
FAllocator := nil;
end;
result := S_OK;
end;
// Check if it's OK to process data
function TBCBaseInputPin.CheckStreaming: HRESULT;
begin
// Shouldn't be able to get any data if we're not connected!
ASSERT(IsConnected);
// Don't process stuff in Stopped state
if IsStopped then begin result := VFW_E_WRONG_STATE; exit end;
if FFlushing then begin result := S_FALSE; exit end;
if FRunTimeError then begin result := VFW_E_RUNTIME_ERROR; exit end;
result := S_OK;
end;
// Constructor creates a default allocator object
constructor TBCBaseInputPin.Create(ObjectName: string;
Filter: TBCBaseFilter; Lock: TBCCritSec; out hr: HRESULT;
Name: WideString);
begin
inherited create(ObjectName, Filter, Lock, hr, Name, PINDIR_INPUT);
FAllocator := nil;
FReadOnly := false;
FFlushing := false;
ZeroMemory(@FSampleProps, sizeof(FSampleProps));
end;
destructor TBCBaseInputPin.Destroy;
begin
if FAllocator <> nil then FAllocator := nil;
inherited;
end;
// default handling for EndFlush - call at end of your implementation
// - before calling this, ensure that there is no queued data and no thread
// pushing any more without a further receive, then call downstream,
// then call this method to clear the m_bFlushing flag and re-enable
// receives
function TBCBaseInputPin.EndFlush: HRESULT;
begin
// Endlush is NOT synchronized with streaming but is part of
// a control action - hence we synchronize with the filter
FLock.Lock;
try
// almost certainly a mistake if we are not in mid-flush
ASSERT(FFlushing);
// before calling, sync with pushing thread and ensure
// no more data is going downstream, then call EndFlush on
// downstream pins.
// now re-enable Receives
FFlushing := FALSE;
// No more errors
FRunTimeError := FALSE;
result := S_OK;
finally
FLock.UnLock;
end;
end;
{ Return the allocator interface that this input pin would like the output
pin to use. NOTE subsequent calls to GetAllocator should all return an
interface onto the SAME object so we create one object at the start
Note:
The allocator is Release()'d on disconnect and replaced on
NotifyAllocator().
Override this to provide your own allocator.}
function TBCBaseInputPin.GetAllocator(
out ppAllocator: IMemAllocator): HRESULT;
begin
FLock.Lock;
try
if (FAllocator = nil) then
begin
result := CoCreateInstance(CLSID_MemoryAllocator, nil, CLSCTX_INPROC_SERVER,
IID_IMemAllocator, FAllocator);
if FAILED(result) then exit;
end;
ASSERT(FAllocator <> nil);
ppAllocator := FAllocator;
result := NOERROR;
finally
FLock.UnLock;
end;
end;
// what requirements do we have of the allocator - override if you want
// to support other people's allocators but need a specific alignment
// or prefix.
function TBCBaseInputPin.GetAllocatorRequirements(
out pProps: TAllocatorProperties): HRESULT;
begin
result := E_NOTIMPL;
end;
{ Free up or unprepare allocator's memory, this is called through
IMediaFilter which is responsible for locking the object first. }
function TBCBaseInputPin.Inactive: HRESULT;
begin
FRunTimeError := FALSE;
if (FAllocator = nil) then
begin
result := VFW_E_NO_ALLOCATOR;
exit;
end;
FFlushing := FALSE;
result := FAllocator.Decommit;
end;
function TBCBaseInputPin.Notify(pSelf: IBaseFilter; q: TQuality): HRESULT;
begin
{$IFDEF DEBUG}
DbgLog(self, 'IQuality.Notify called on an input pin');
{$ENDIF}
result := NOERROR;
end;
{ Tell the input pin which allocator the output pin is actually going to use
Override this if you care - NOTE the locking we do both here and also in
GetAllocator is unnecessary but derived classes that do something useful
will undoubtedly have to lock the object so this might help remind people }
function TBCBaseInputPin.NotifyAllocator(pAllocator: IMemAllocator;
bReadOnly: BOOL): HRESULT;
begin
FLock.Lock;
try
FAllocator := pAllocator;
// the readonly flag indicates whether samples from this allocator should
// be regarded as readonly - if True, then inplace transforms will not be
// allowed.
FReadOnly := bReadOnly;
result := NOERROR;
finally
FLock.UnLock;
end;
end;
// Pass on the Quality notification q to
// a. Our QualityControl sink (if we have one) or else
// b. to our upstream filter
// and if that doesn't work, throw it away with a bad return code
function TBCBaseInputPin.PassNotify(const q: TQuality): HRESULT;
var IQC: IQualityControl;
begin
// We pass the message on, which means that we find the quality sink
// for our input pin and send it there
{$IFDEF DEBUG}
DbgLog(self, 'Passing Quality notification through transform');
{$ENDIF}
if (FQSink <> nil) then
begin
result := FQSink.Notify(FFilter, q);
exit;
end
else
begin
// no sink set, so pass it upstream
result := VFW_E_NOT_FOUND; // default
if (FConnected <> nil) then
begin
FConnected.QueryInterface(IID_IQualityControl, IQC);
if (IQC <> nil) then
begin
result := IQC.Notify(FFilter, q);
IQC := nil;
end;
end;
end;
end;
{ Do something with this media sample - this base class checks to see if the
format has changed with this media sample and if so checks that the filter
will accept it, generating a run time error if not. Once we have raised a
run time error we set a flag so that no more samples will be accepted
It is important that any filter should override this method and implement
synchronization so that samples are not processed when the pin is
disconnected etc. }
function TBCBaseInputPin.Receive(pSample: IMediaSample): HRESULT;
var Sample2: IMediaSample2;
begin
ASSERT(pSample <> nil);
result := CheckStreaming;
if (S_OK <> result) then exit;
// Check for IMediaSample2
if SUCCEEDED(pSample.QueryInterface(IID_IMediaSample2, Sample2)) then
begin
result := Sample2.GetProperties(sizeof(FSampleProps), FSampleProps);
Sample2 := nil;
if FAILED(result) then exit;
end
else
begin
// Get the properties the hard way
FSampleProps.cbData := sizeof(FSampleProps);
FSampleProps.dwTypeSpecificFlags := 0;
FSampleProps.dwStreamId := AM_STREAM_MEDIA;
FSampleProps.dwSampleFlags := 0;
if (S_OK = pSample.IsDiscontinuity) then
FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_DATADISCONTINUITY;
if (S_OK = pSample.IsPreroll) then
FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_PREROLL;
if (S_OK = pSample.IsSyncPoint) then
FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_SPLICEPOINT;
if SUCCEEDED(pSample.GetTime(FSampleProps.tStart, FSampleProps.tStop)) then
FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_TIMEVALID or AM_SAMPLE_STOPVALID;
if (S_OK = pSample.GetMediaType(FSampleProps.pMediaType)) then
FSampleProps.dwSampleFlags := FSampleProps.dwSampleFlags or AM_SAMPLE_TYPECHANGED;
pSample.GetPointer(PByte(FSampleProps.pbBuffer));
FSampleProps.lActual := pSample.GetActualDataLength;
FSampleProps.cbBuffer := pSample.GetSize;
end;
// Has the format changed in this sample
if (not BOOL(FSampleProps.dwSampleFlags and AM_SAMPLE_TYPECHANGED)) then
begin
result := NOERROR;
exit;
end;
// Check the derived class accepts this format */
// This shouldn't fail as the source must call QueryAccept first */
result := CheckMediaType(FSampleProps.pMediaType);
if (result = NOERROR) then exit;
// Raise a runtime error if we fail the media type
FRunTimeError := True;
EndOfStream;
FFilter.NotifyEvent(EC_ERRORABORT,VFW_E_TYPE_NOT_ACCEPTED,0);
result := VFW_E_INVALIDMEDIATYPE;
end;
// See if Receive() might block
function TBCBaseInputPin.ReceiveCanBlock: HRESULT;
var
c, Pins, OutputPins: Integer;
Pin: TBCBasePin;
pd: TPinDirection;
Connected: IPin;
InputPin: IMemInputPin;
begin
{ Ask all the output pins if they block
If there are no output pin assume we do block. }
Pins := FFilter.GetPinCount;
OutputPins := 0;
for c := 0 to Pins - 1 do
begin
Pin := FFilter.GetPin(c);
result := Pin.QueryDirection(pd);
if FAILED(result) then exit;
if (pd = PINDIR_OUTPUT) then
begin
result := Pin.ConnectedTo(Connected);
if SUCCEEDED(result) then
begin
assert(Connected <> nil);
inc(OutputPins);
result := Connected.QueryInterface(IID_IMemInputPin, InputPin);
Connected := nil;
if SUCCEEDED(result) then
begin
result := InputPin.ReceiveCanBlock;
InputPin := nil;
if (result <> S_FALSE) then
begin
result := S_OK;
exit;
end;
end
else
begin
// There's a transport we don't understand here
result := S_OK;
exit;
end;
end;
end;
end;
if OutputPins = 0 then result := S_OK else result := S_FALSE;
end;
// Receive multiple samples
function TBCBaseInputPin.ReceiveMultiple(var pSamples: IMediaSample;
nSamples: Integer; out nSamplesProcessed: Integer): HRESULT;
type
TMediaSampleDynArray = array of IMediaSample;
begin
result := S_OK;
nSamplesProcessed := 0;
dec(nSamples);
while (nSamples >= 0) do
begin
result := Receive(TMediaSampleDynArray(@pSamples)[nSamplesProcessed]);
// S_FALSE means don't send any more
if (result <> S_OK) then break;
inc(nSamplesProcessed);
dec(nSamples)
end;
end;
function TBCBaseInputPin.SampleProps: PAMSample2Properties;
begin
ASSERT(FSampleProps.cbData <> 0);
result := @FSampleProps;
end;
// milenko start (added TBCDynamicOutputPin conversion)
{ TBCDynamicOutputPin }
//
// The streaming thread calls IPin::NewSegment(), IPin::EndOfStream(),
// IMemInputPin::Receive() and IMemInputPin::ReceiveMultiple() on the
// connected input pin. The application thread calls Block(). The
// following class members can only be called by the streaming thread.
//
// Deliver()
// DeliverNewSegment()
// StartUsingOutputPin()
// StopUsingOutputPin()
// ChangeOutputFormat()
// ChangeMediaType()
// DynamicReconnect()
//
// The following class members can only be called by the application thread.
//
// Block()
// SynchronousBlockOutputPin()
// AsynchronousBlockOutputPin()
//
constructor TBCDynamicOutputPin.Create(ObjectName: WideString; Filter: TBCBaseFilter;
Lock: TBCCritSec; out hr: HRESULT; Name: WideString);
begin
inherited Create(ObjectName,Filter,Lock,hr,Name);
FStopEvent := 0;
FGraphConfig := nil;
FPinUsesReadOnlyAllocator := False;
FBlockState := NOT_BLOCKED;
FUnblockOutputPinEvent := 0;
FNotifyCallerPinBlockedEvent := 0;
FBlockCallerThreadID := 0;
FNumOutstandingOutputPinUsers := 0;
FBlockStateLock := TBCCritSec.Create;
hr := Initialize;
end;
destructor TBCDynamicOutputPin.Destroy;
begin
if(FUnblockOutputPinEvent <> 0) then
begin
// This call should not fail because we have access to m_hUnblockOutputPinEvent
// and m_hUnblockOutputPinEvent is a valid event.
ASSERT(CloseHandle(FUnblockOutputPinEvent));
end;
if(FNotifyCallerPinBlockedEvent <> 0) then
begin
// This call should not fail because we have access to m_hNotifyCallerPinBlockedEvent
// and m_hNotifyCallerPinBlockedEvent is a valid event.
ASSERT(CloseHandle(FNotifyCallerPinBlockedEvent));
end;
if Assigned(FBlockStateLock) then FreeAndNil(FBlockStateLock);
inherited Destroy;
end;
function TBCDynamicOutputPin.NonDelegatingQueryInterface(const IID: TGUID; out Obj): HResult;
begin
if IsEqualGUID(IID,IID_IPinFlowControl) then
begin
if GetInterface(IID_IPinFlowControl, Obj) then Result := S_OK
else Result := E_NOINTERFACE;
end else
begin
Result := inherited NonDelegatingQueryInterface(IID,Obj);
end;
end;
function TBCDynamicOutputPin.Disconnect: HRESULT;
begin
FLock.Lock;
try
Result := DisconnectInternal;
finally
FLock.Unlock;
end;
end;
function TBCDynamicOutputPin.Block(dwBlockFlags: DWORD; hEvent: THandle): HResult;
begin
// Check for illegal flags.
if BOOL(dwBlockFlags and not AM_PIN_FLOW_CONTROL_BLOCK) then
begin
Result := E_INVALIDARG;
Exit;
end;
// Make sure the event is unsignaled.
if(BOOL(dwBlockFlags and AM_PIN_FLOW_CONTROL_BLOCK) and (hEvent <> 0)) then
begin
if not ResetEvent(hEvent) then
begin
Result := AmGetLastErrorToHResult;
Exit
end;
end;
// No flags are set if we are unblocking the output pin.
if(dwBlockFlags = 0) then
begin
// This parameter should be NULL because unblock operations are always synchronous.
// There is no need to notify the caller when the event is done.
if(hEvent <> 0) then
begin
Result := E_INVALIDARG;
Exit;
end;
end;
{$IFDEF DEBUG}
AssertValid;
{$ENDIF} // DEBUG
if BOOL(dwBlockFlags and AM_PIN_FLOW_CONTROL_BLOCK) then
begin
// IPinFlowControl::Block()'s hEvent parameter is NULL if the block is synchronous.
// If hEvent is not NULL, the block is asynchronous.
if(hEvent = 0) then Result := SynchronousBlockOutputPin
else Result := AsynchronousBlockOutputPin(hEvent);
end else
begin
Result := UnblockOutputPin;
end;
{$IFDEF DEBUG}
AssertValid;
{$ENDIF} // DEBUG
if(FAILED(Result)) then Exit;
Result := S_OK;
end;
procedure TBCDynamicOutputPin.SetConfigInfo(GraphConfig: IGraphConfig; StopEvent: THandle);
begin
// This pointer is not addrefed because filters are not allowed to
// hold references to the filter graph manager. See the documentation for
// IBaseFilter::JoinFilterGraph() in the Direct Show SDK for more information.
Pointer(FGraphConfig) := Pointer(GraphConfig);
FStopEvent := StopEvent;
end;
{$IFDEF DEBUG}
function TBCDynamicOutputPin.Deliver(Sample: IMediaSample): HRESULT;
begin
// The caller should call StartUsingOutputPin() before calling this
// method.
ASSERT(StreamingThreadUsingOutputPin);
Result := inherited Deliver(Sample);
end;
function TBCDynamicOutputPin.DeliverEndOfStream: HRESULT;
begin
// The caller should call StartUsingOutputPin() before calling this
// method.
ASSERT(StreamingThreadUsingOutputPin);
Result := inherited DeliverEndOfStream;
end;
function TBCDynamicOutputPin.DeliverNewSegment(Start, Stop: TReferenceTime; Rate: Double): HRESULT;
begin
// The caller should call StartUsingOutputPin() before calling this
// method.
ASSERT(StreamingThreadUsingOutputPin);
Result := inherited DeliverNewSegment(Start, Stop, Rate);
end;
{$ENDIF}
function TBCDynamicOutputPin.DeliverBeginFlush: HRESULT;
begin
// If this ASSERT fires, the user may have passed an invalid event handle to SetConfigInfo().
// The ASSERT can also fire if the event if destroyed and then DeliverBeginFlush() is called.
// An event handle is invalid if 1) the event does not exist or the user does not have the security
// permissions to use the event.
ASSERT(SetEvent(FStopEvent));
Result := inherited DeliverBeginFlush;
end;
function TBCDynamicOutputPin.DeliverEndFlush: HRESULT;
begin
// If this ASSERT fires, the user may have passed an invalid event handle to SetConfigInfo().
// The ASSERT can also fire if the event if destroyed and then DeliverBeginFlush() is called.
// An event handle is invalid if 1) the event does not exist or the user does not have the security
// permissions to use the event.
ASSERT(ResetEvent(FStopEvent));
Result := inherited DeliverEndFlush;
end;
function TBCDynamicOutputPin.Active: HRESULT;
begin
// Make sure the user initialized the object by calling SetConfigInfo().
if(FStopEvent = 0) or (FGraphConfig = nil) then
begin
{$IFDEF DEBUG}
DbgLog('ERROR: TBCDynamicOutputPin.Active() failed because m_pGraphConfig' +
' and m_hStopEvent were not initialized. Call SetConfigInfo() to initialize them.');
{$ENDIF} // DEBUG
Result := E_FAIL;
Exit;
end;
// If this ASSERT fires, the user may have passed an invalid event handle to SetConfigInfo().
// The ASSERT can also fire if the event if destroyed and then Active() is called. An event
// handle is invalid if 1) the event does not exist or the user does not have the security
// permissions to use the event.
ASSERT(ResetEvent(FStopEvent));
Result := inherited Active;
end;
function TBCDynamicOutputPin.Inactive: HRESULT;
begin
// If this ASSERT fires, the user may have passed an invalid event handle to SetConfigInfo().
// The ASSERT can also fire if the event if destroyed and then Active() is called. An event
// handle is invalid if 1) the event does not exist or the user does not have the security
// permissions to use the event.
ASSERT(SetEvent(FStopEvent));
Result := inherited Inactive;
end;
function TBCDynamicOutputPin.CompleteConnect(ReceivePin: IPin): HRESULT;
begin
Result := inherited CompleteConnect(ReceivePin);
if(SUCCEEDED(Result)) then
begin
if (not IsStopped) and (FAllocator <> nil) then
begin
Result := FAllocator.Commit;
ASSERT(Result <> VFW_E_ALREADY_COMMITTED);
end;
end;
end;
function TBCDynamicOutputPin.StartUsingOutputPin: HRESULT;
var
WaitEvents: array[0..1] of THandle;
NumWaitEvents: DWORD;
ReturnValue: DWORD;
begin
// The caller should not hold m_BlockStateLock. If the caller does,
// a deadlock could occur.
ASSERT(FBlockStateLock.CritCheckIn);
FBlockStateLock.Lock;
try
{$IFDEF DEBUG}
AssertValid;
{$ENDIF} // DEBUG
// Are we in the middle of a block operation?
while(BLOCKED = FBlockState) do
begin
FBlockStateLock.Unlock;
// If this ASSERT fires, a deadlock could occur. The caller should make sure
// that this thread never acquires the Block State lock more than once.
ASSERT(FBlockStateLock.CritCheckIn);
// WaitForMultipleObjects() returns WAIT_OBJECT_0 if the unblock event
// is fired. It returns WAIT_OBJECT_0 + 1 if the stop event if fired.
// See the Windows SDK documentation for more information on
// WaitForMultipleObjects().
WaitEvents[0] := FUnblockOutputPinEvent;
WaitEvents[0] := FStopEvent;
NumWaitEvents := sizeof(WaitEvents) div sizeof(THANDLE);
ReturnValue := WaitForMultipleObjects(NumWaitEvents, @WaitEvents, False, INFINITE);
FBlockStateLock.Lock;
{$IFDEF DEBUG}
AssertValid;
{$ENDIF} // DEBUG
case ReturnValue of
WAIT_OBJECT_0: break;
WAIT_OBJECT_0 + 1:
begin
Result := VFW_E_STATE_CHANGED;
Exit;
end;
WAIT_FAILED:
begin
Result := AmGetLastErrorToHResult;
Exit;
end;
else
begin
{$IFDEF DEBUG}
DbgLog('An Unexpected case occured in TBCDynamicOutputPin.StartUsingOutputPin().');
{$ENDIF} // DEBUG
Result := E_UNEXPECTED;
Exit;
end;
end;
end;
inc(FNumOutstandingOutputPinUsers);
{$IFDEF DEBUG}
AssertValid;
{$ENDIF} // DEBUG
Result := S_OK;
finally
FBlockStateLock.Unlock;
end;
end;
procedure TBCDynamicOutputPin.StopUsingOutputPin;
begin
FBlockStateLock.Lock;
try
{$IFDEF DEBUG}
AssertValid;
{$ENDIF} // DEBUG
dec(FNumOutstandingOutputPinUsers);
if(FNumOutstandingOutputPinUsers = 0) and (NOT_BLOCKED <> FBlockState)
then BlockOutputPin;
{$IFDEF DEBUG}
AssertValid;
{$ENDIF} // DEBUG
finally
FBlockStateLock.Unlock;
end;
end;
function TBCDynamicOutputPin.StreamingThreadUsingOutputPin: Boolean;
begin
FBlockStateLock.Lock;
try
Result := (FNumOutstandingOutputPinUsers > 0);
finally
FBlockStateLock.UnLock;
end;
end;
function TBCDynamicOutputPin.ChangeOutputFormat(const pmt: PAMMEdiaType; tSegmentStart, tSegmentStop:
TreferenceTime; dSegmentRate: Double): HRESULT;
begin
// The caller should call StartUsingOutputPin() before calling this
// method.
ASSERT(StreamingThreadUsingOutputPin);
// Callers should always pass a valid media type to ChangeOutputFormat() .
ASSERT(pmt <> nil);
Result := ChangeMediaType(pmt);
if (FAILED(Result)) then Exit;
Result :=DeliverNewSegment(tSegmentStart, tSegmentStop, dSegmentRate);
if(FAILED(Result)) then Exit;
Result := S_OK;
end;
function TBCDynamicOutputPin.ChangeMediaType(const pmt: PAMMediaType): HRESULT;
var
pConnection: IPinConnection;
begin
// The caller should call StartUsingOutputPin() before calling this
// method.
ASSERT(StreamingThreadUsingOutputPin);
// This function assumes the filter graph is running.
ASSERT(not IsStopped);
if (not IsConnected) then
begin
Result := VFW_E_NOT_CONNECTED;
Exit;
end;
// First check if the downstream pin will accept a dynamic
// format change
FConnected.QueryInterface(IID_IPinConnection, pConnection);
if(pConnection <> nil) then
begin
if(S_OK = pConnection.DynamicQueryAccept(pmt^)) then
begin
Result := ChangeMediaTypeHelper(pmt);
if(FAILED(Result)) then Exit;
Result := S_OK;
Exit;
end;
end;
// Can't do the dynamic connection
Result := DynamicReconnect(pmt);
end;
// this method has to be called from the thread that is pushing data,
// and it's the caller's responsibility to make sure that the thread
// has no outstand samples because they cannot be delivered after a
// reconnect
//
function TBCDynamicOutputPin.DynamicReconnect(const pmt: PAMMediaType): HRESULT;
begin
// The caller should call StartUsingOutputPin() before calling this
// method.
ASSERT(StreamingThreadUsingOutputPin);
if(FGraphConfig = nil) or (FStopEvent = 0) then
begin
Result := E_FAIL;
Exit;
end;
Result := FGraphConfig.Reconnect(Self,nil,pmt,nil,FStopEvent,
AM_GRAPH_CONFIG_RECONNECT_CACHE_REMOVED_FILTERS);
end;
function TBCDynamicOutputPin.SynchronousBlockOutputPin: HRESULT;
var
NotifyCallerPinBlockedEvent: THandle;
begin
NotifyCallerPinBlockedEvent := CreateEvent(nil, // The event will have the default security attributes.
False, // This is an automatic reset event.
False, // The event is initially unsignaled.
nil); // The event is not named.
// CreateEvent() returns NULL if an error occurs.
if(NotifyCallerPinBlockedEvent = 0) then
begin
Result := AmGetLastErrorToHResult;
Exit;
end;
Result := AsynchronousBlockOutputPin(NotifyCallerPinBlockedEvent);
if(FAILED(Result)) then
begin
// This call should not fail because we have access to hNotifyCallerPinBlockedEvent
// and hNotifyCallerPinBlockedEvent is a valid event.
ASSERT(CloseHandle(NotifyCallerPinBlockedEvent));
Exit;
end;
Result := WaitEvent(NotifyCallerPinBlockedEvent);
// This call should not fail because we have access to hNotifyCallerPinBlockedEvent
// and hNotifyCallerPinBlockedEvent is a valid event.
ASSERT(CloseHandle(NotifyCallerPinBlockedEvent));
if(FAILED(Result)) then Exit;
Result := S_OK;
end;
function TBCDynamicOutputPin.AsynchronousBlockOutputPin(NotifyCallerPinBlockedEvent: THandle): HRESULT;
var
Success : Boolean;
begin
// This function holds the m_BlockStateLock because it uses
// m_dwBlockCallerThreadID, m_BlockState and
// m_hNotifyCallerPinBlockedEvent.
FBlockStateLock.Lock;
try
if (NOT_BLOCKED <> FBlockState) then
begin
if(FBlockCallerThreadID = GetCurrentThreadId)
then Result := VFW_E_PIN_ALREADY_BLOCKED_ON_THIS_THREAD
else Result := VFW_E_PIN_ALREADY_BLOCKED;
Exit;
end;
Success := DuplicateHandle(GetCurrentProcess,
NotifyCallerPinBlockedEvent,
GetCurrentProcess,
@FNotifyCallerPinBlockedEvent,
EVENT_MODIFY_STATE,
False,
0);
if not Success then
begin
Result := AmGetLastErrorToHResult;
Exit;
end;
FBlockState := PENDING;
FBlockCallerThreadID := GetCurrentThreadId;
// The output pin cannot be blocked if the streaming thread is
// calling IPin::NewSegment(), IPin::EndOfStream(), IMemInputPin::Receive()
// or IMemInputPin::ReceiveMultiple() on the connected input pin. Also, it
// cannot be blocked if the streaming thread is calling DynamicReconnect(),
// ChangeMediaType() or ChangeOutputFormat().
// The output pin can be immediately blocked.
if not StreamingThreadUsingOutputPin then BlockOutputPin();
Result := S_OK;
finally
FBlockStateLock.Unlock;
end;
end;
function TBCDynamicOutputPin.UnblockOutputPin: HRESULT;
begin
// UnblockOutputPin() holds the m_BlockStateLock because it
// uses m_BlockState, m_dwBlockCallerThreadID and
// m_hNotifyCallerPinBlockedEvent.
FBlockStateLock.Lock;
try
if (NOT_BLOCKED = FBlockState) then
begin
Result := S_FALSE;
Exit;
end;
// This should not fail because we successfully created the event
// and we have the security permissions to change it's state.
ASSERT(SetEvent(FUnblockOutputPinEvent));
// Cancel the block operation if it's still pending.
if (FNotifyCallerPinBlockedEvent <> 0) then
begin
// This event should not fail because AsynchronousBlockOutputPin() successfully
// duplicated this handle and we have the appropriate security permissions.
ASSERT(SetEvent(FNotifyCallerPinBlockedEvent));
ASSERT(CloseHandle(FNotifyCallerPinBlockedEvent));
end;
FBlockState := NOT_BLOCKED;
FBlockCallerThreadID := 0;
FNotifyCallerPinBlockedEvent := 0;
Result := S_OK;
finally
FBlockStateLock.Unlock;
end;
end;
procedure TBCDynamicOutputPin.BlockOutputPin;
begin
// The caller should always hold the m_BlockStateLock because this function
// uses m_BlockState and m_hNotifyCallerPinBlockedEvent.
ASSERT(FBlockStateLock.CritCheckIn);
// This function should not be called if the streaming thread is modifying
// the connection state or it's passing data downstream.
ASSERT(not StreamingThreadUsingOutputPin);
// This should not fail because we successfully created the event
// and we have the security permissions to change it's state.
ASSERT(ResetEvent(FUnblockOutputPinEvent));
// This event should not fail because AsynchronousBlockOutputPin() successfully
// duplicated this handle and we have the appropriate security permissions.
ASSERT(SetEvent(FNotifyCallerPinBlockedEvent));
ASSERT(CloseHandle(FNotifyCallerPinBlockedEvent));
FBlockState := BLOCKED;
FNotifyCallerPinBlockedEvent := 0;
end;
procedure TBCDynamicOutputPin.ResetBlockState;
begin
end;
class function TBCDynamicOutputPin.WaitEvent(Event: THandle): HRESULT;
var
ReturnValue: DWORD;
begin
ReturnValue := WaitForSingleObject(Event, INFINITE);
case ReturnValue of
WAIT_OBJECT_0: Result := S_OK;
WAIT_FAILED : Result := AmGetLastErrorToHResult;
else
begin
{$IFDEF DEBUG}
DbgLog('An Unexpected case occured in TBCDynamicOutputPin::WaitEvent.');
{$ENDIF}
Result := E_UNEXPECTED;
end;
end;
end;
function TBCDynamicOutputPin.Initialize: HRESULT;
begin
FUnblockOutputPinEvent := CreateEvent(nil, // The event will have the default security descriptor.
True, // This is a manual reset event.
True, // The event is initially signaled.
nil); // The event is not named.
// CreateEvent() returns NULL if an error occurs.
if (FUnblockOutputPinEvent = 0) then
begin
Result := AmGetLastErrorToHResult;
Exit;
end;
// Set flag to say we can reconnect while streaming.
CanReconnectWhenActive := True;
Result := S_OK;
end;
function TBCDynamicOutputPin.ChangeMediaTypeHelper(const pmt: PAMMediaType): HRESULT;
var
InputPinRequirements: ALLOCATOR_PROPERTIES;
begin
// The caller should call StartUsingOutputPin() before calling this
// method.
ASSERT(StreamingThreadUsingOutputPin);
Result := FConnected.ReceiveConnection(Self,pmt^);
if(FAILED(Result)) then Exit;
Result := SetMediaType(pmt);
if(FAILED(Result)) then Exit;
// Does this pin use the local memory transport?
if(FInputPin <> nil) then
begin
// This function assumes that m_pInputPin and m_Connected are
// two different interfaces to the same object.
ASSERT(IsEqualObject(FConnected, FInputPin));
InputPinRequirements.cbAlign := 0;
InputPinRequirements.cbBuffer := 0;
InputPinRequirements.cbPrefix := 0;
InputPinRequirements.cBuffers := 0;
FInputPin.GetAllocatorRequirements(InputPinRequirements);
// A zero allignment does not make any sense.
if(0 = InputPinRequirements.cbAlign)
then InputPinRequirements.cbAlign := 1;
Result := FAllocator.Decommit;
if(FAILED(Result)) then Exit;
Result := DecideBufferSize(FAllocator, @InputPinRequirements);
if(FAILED(Result)) then Exit;
Result := FAllocator.Commit;
if(FAILED(Result)) then Exit;
Result := FInputPin.NotifyAllocator(FAllocator, FPinUsesReadOnlyAllocator);
if(FAILED(Result)) then Exit;
end;
Result := S_OK;
end;
{$IFDEF DEBUG}
procedure TBCDynamicOutputPin.AssertValid;
begin
// Make sure the object was correctly initialized.
// This ASSERT only fires if the object failed to initialize
// and the user ignored the constructor's return code (phr).
ASSERT(FUnblockOutputPinEvent <> 0);
// If either of these ASSERTs fire, the user did not correctly call
// SetConfigInfo().
ASSERT(FStopEvent <> 0);
ASSERT(FGraphConfig <> nil);
// Make sure the block state is consistent.
FBlockStateLock.Lock;
try
// BLOCK_STATE variables only have three legal values: PENDING, BLOCKED and NOT_BLOCKED.
ASSERT((NOT_BLOCKED = FBlockState) or (PENDING = FBlockState) or (BLOCKED = FBlockState));
// m_hNotifyCallerPinBlockedEvent is only needed when a block operation cannot complete
// immediately.
ASSERT(((FNotifyCallerPinBlockedEvent = 0) and (PENDING <> FBlockState)) or
((FNotifyCallerPinBlockedEvent <> 0) and (PENDING = FBlockState)) );
// m_dwBlockCallerThreadID should always be 0 if the pin is not blocked and
// the user is not trying to block the pin.
ASSERT((0 = FBlockCallerThreadID) or (NOT_BLOCKED <> FBlockState));
// If this ASSERT fires, the streaming thread is using the output pin and the
// output pin is blocked.
ASSERT(((0 <> FNumOutstandingOutputPinUsers) and (BLOCKED <> FBlockState)) or
((0 = FNumOutstandingOutputPinUsers) and (NOT_BLOCKED <> FBlockState)) or
((0 = FNumOutstandingOutputPinUsers) and (NOT_BLOCKED = FBlockState)) );
finally
FBlockStateLock.UnLock;
end;
end;
{$ENDIF}
// milenko end
{ TBCTransformInputPin }
// enter flushing state. Call default handler to block Receives, then
// pass to overridable method in filter
function TBCTransformInputPin.BeginFlush: HRESULT;
begin
FTransformFilter.FcsFilter.Lock;
try
// Are we actually doing anything?
ASSERT(FTransformFilter.FOutput <> nil);
if ((not IsConnected) or (not FTransformFilter.FOutput.IsConnected)) then
begin
result := VFW_E_NOT_CONNECTED;
exit;
end;
result := inherited BeginFlush;
if FAILED(result) then exit;
result := FTransformFilter.BeginFlush;
finally
FTransformFilter.FcsFilter.UnLock;
end;
end;
// provides derived filter a chance to release it's extra interfaces
function TBCTransformInputPin.BreakConnect: HRESULT;
begin
ASSERT(IsStopped);
FTransformFilter.BreakConnect(PINDIR_INPUT);
result := inherited BreakConnect;
end;
function TBCTransformInputPin.CheckConnect(Pin: IPin): HRESULT;
begin
result := FTransformFilter.CheckConnect(PINDIR_INPUT, Pin);
if FAILED(result) then exit;
result := inherited CheckConnect(Pin);
end;
// check that we can support a given media type
function TBCTransformInputPin.CheckMediaType(
mtIn: PAMMediaType): HRESULT;
begin
// Check the input type
result := FTransformFilter.CheckInputType(mtIn);
if (S_OK <> result) then exit;
// if the output pin is still connected, then we have
// to check the transform not just the input format
if ((FTransformFilter.FOutput <> nil) and
(FTransformFilter.FOutput.IsConnected)) then
begin
result := FTransformFilter.CheckTransform(mtIn,
FTransformFilter.FOutput.AMMediaType);
end;
end;
function TBCTransformInputPin.CheckStreaming: HRESULT;
begin
ASSERT(FTransformFilter.FOutput <> nil);
if(not FTransformFilter.FOutput.IsConnected) then
begin
result := VFW_E_NOT_CONNECTED;
exit;
end
else
begin
// Shouldn't be able to get any data if we're not connected!
ASSERT(IsConnected);
// we're flushing
if FFlushing then
begin
result := S_FALSE;
exit;
end;
// Don't process stuff in Stopped state
if IsStopped then
begin
result := VFW_E_WRONG_STATE;
exit;
end;
if FRunTimeError then
begin
result := VFW_E_RUNTIME_ERROR;
exit;
end;
result := S_OK;
end;
end;
function TBCTransformInputPin.CompleteConnect(ReceivePin: IPin): HRESULT;
begin
result := FTransformFilter.CompleteConnect(PINDIR_INPUT, ReceivePin);
if FAILED(result) then exit;
result := inherited CompleteConnect(ReceivePin);
end;
constructor TBCTransformInputPin.Create(ObjectName: string;
TransformFilter: TBCTransformFilter; out hr: HRESULT; Name: WideString);
begin
inherited Create(ObjectName, TransformFilter, TransformFilter.FcsFilter, hr, Name);
{$IFDEF DEBUG}
DbgLog(self, 'TBCTransformInputPin.Create');
{$ENDIF}
FTransformFilter := TransformFilter;
end;
// leave flushing state.
// Pass to overridable method in filter, then call base class
// to unblock receives (finally)
destructor TBCTransformInputPin.destroy;
begin
{$IFDEF DEBUG}
DbgLog(self, 'TBCTransformInputPin.destroy');
{$ENDIF}
inherited;
end;
function TBCTransformInputPin.EndFlush: HRESULT;
begin
FTransformFilter.FcsFilter.Lock;
try
// Are we actually doing anything?
ASSERT(FTransformFilter.FOutput <> nil);
if((not IsConnected) or (not FTransformFilter.FOutput.IsConnected)) then
begin
result := VFW_E_NOT_CONNECTED;
exit;
end;
result := FTransformFilter.EndFlush;
if FAILED(result) then exit;
result := inherited EndFlush;
finally
FTransformFilter.FcsFilter.UnLock;
end;
end;
// provide EndOfStream that passes straight downstream
// (there is no queued data)
function TBCTransformInputPin.EndOfStream: HRESULT;
begin
FTransformFilter.FcsReceive.Lock;
try
result := CheckStreaming;
if (S_OK = result) then
result := FTransformFilter.EndOfStream;
finally
FTransformFilter.FcsReceive.UnLock;
end;
end;
function TBCTransformInputPin.NewSegment(Start, Stop: TReferenceTime;
Rate: double): HRESULT;
begin
// Save the values in the pin
inherited NewSegment(Start, Stop, Rate);
result := FTransformFilter.NewSegment(Start, Stop, Rate);
end;
function TBCTransformInputPin.QueryId(out id: PWideChar): HRESULT;
begin
// milenko start (AMGetWideString was bugged, now the second line is not needed)
Result := AMGetWideString('In', Id);
// if id <> nil then result := S_OK else result := S_FALSE;
// milenko end
end;
// here's the next block of data from the stream.
// AddRef it yourself if you need to hold it beyond the end
// of this call.
function TBCTransformInputPin.Receive(pSample: IMediaSample): HRESULT;
begin
FTransformFilter.FcsReceive.Lock;
try
ASSERT(pSample <> nil);
// check all is well with the base class
result := inherited Receive(pSample);
if (result = S_OK) then
result := FTransformFilter.Receive(pSample);
finally
FTransformFilter.FcsReceive.Unlock;
end;
end;
// set the media type for this connection
function TBCTransformInputPin.SetMediaType(mt: PAMMediaType): HRESULT;
begin
// Set the base class media type (should always succeed)
result := inherited SetMediaType(mt);
if FAILED(result) then exit;
// check the transform can be done (should always succeed)
ASSERT(SUCCEEDED(FTransformFilter.CheckInputType(mt)));
result := FTransformFilter.SetMediaType(PINDIR_INPUT,mt);
end;
{ TBCCritSec }
constructor TBCCritSec.Create;
begin
InitializeCriticalSection(FCritSec);
{$IFDEF DEBUG}
FcurrentOwner := 0;
FlockCount := 0;
// {$IFDEF TRACE}
// FTrace := True;
// {$ELSE}
// FTrace := FALSE;
// {$ENDIF}
{$ENDIF}
end;
function TBCCritSec.CritCheckIn: boolean;
begin
{$IFDEF DEBUG}
result := (GetCurrentThreadId = Self.FcurrentOwner);
{$ELSE}
result := True;
{$ENDIF}
end;
function TBCCritSec.CritCheckOut: boolean;
begin
{$IFDEF DEBUG}
result := (GetCurrentThreadId <> Self.FcurrentOwner);
{$ELSE}
result := false;
{$ENDIF}
end;
destructor TBCCritSec.Destroy;
begin
DeleteCriticalSection(FCritSec)
end;
procedure TBCCritSec.Lock;
begin
{$IFDEF DEBUG}
if ((FCurrentOwner <> 0) and (FCurrentOwner <> GetCurrentThreadId)) then
begin
// already owned, but not by us
{$IFDEF TRACE}
DbgLog(format('Thread %d about to wait for lock %x owned by %d',
[GetCurrentThreadId, longint(self), FCurrentOwner]));
{$ENDIF}
end;
{$ENDIF}
EnterCriticalSection(FCritSec);
{$IFDEF DEBUG}
inc(FLockCount);
if (FLockCount > 0) then
begin
// we now own it for the first time. Set owner information
FcurrentOwner := GetCurrentThreadId;
{$IFDEF TRACE}
DbgLog(format('Thread %d now owns lock %x', [FcurrentOwner, LongInt(self)]));
{$ENDIF}
end;
{$ENDIF}
end;
procedure TBCCritSec.UnLock;
begin
{$IFDEF DEBUG}
dec(FlockCount);
if(FlockCount = 0) then
begin
// about to be unowned
{$IFDEF TRACE}
DbgLog(format('Thread %d releasing lock %x', [FcurrentOwner, LongInt(Self)]));
{$ENDIF}
FcurrentOwner := 0;
end;
{$ENDIF}
LeaveCriticalSection(FCritSec)
end;
{ TBCTransformFilter }
// Return S_FALSE to mean "pass the note on upstream"
// Return NOERROR (Same as S_OK)
// to mean "I've done something about it, don't pass it on"
function TBCTransformFilter.AlterQuality(const q: TQuality): HRESULT;
begin
result := S_FALSE;
end;
// enter flush state. Receives already blocked
// must override this if you have queued data or a worker thread
function TBCTransformFilter.BeginFlush: HRESULT;
begin
result := NOERROR;
if (FOutput <> nil) then
// block receives -- done by caller (CBaseInputPin::BeginFlush)
// discard queued data -- we have no queued data
// free anyone blocked on receive - not possible in this filter
// call downstream
result := FOutput.DeliverBeginFlush;
end;
function TBCTransformFilter.BreakConnect(dir: TPinDirection): HRESULT;
begin
result := NOERROR;
end;
function TBCTransformFilter.CheckConnect(dir: TPinDirection;
Pin: IPin): HRESULT;
begin
result := NOERROR;
end;
function TBCTransformFilter.CompleteConnect(direction: TPinDirection;
ReceivePin: IPin): HRESULT;
begin
result := NOERROR;
end;
constructor TBCTransformFilter.Create(ObjectName: string; unk: IUnKnown;
const clsid: TGUID);
begin
FcsFilter := TBCCritSec.Create;
FcsReceive := TBCCritSec.Create;
inherited Create(ObjectName,Unk,FcsFilter, clsid);
FInput := nil;
FOutput := nil;
FEOSDelivered := FALSE;
FQualityChanged:= FALSE;
FSampleSkipped := FALSE;
{$ifdef PERF}
// RegisterPerfId;
{$endif}
end;
constructor TBCTransformFilter.CreateFromFactory(Factory: TBCClassFactory; const Controller: IUnknown);
begin
Create(Factory.FName, Controller, Factory.FClassID);
end;
destructor TBCTransformFilter.destroy;
begin
if FInput <> nil then FInput.Free;
if FOutput <> nil then FOutput.Free;
{$IFDEF DEBUG}
DbgLog(self, 'TBCTransformFilter.destroy');
{$ENDIF}
FcsReceive.Free;
inherited;
end;
// leave flush state. must override this if you have queued data
// or a worker thread
function TBCTransformFilter.EndFlush: HRESULT;
begin
// sync with pushing thread -- we have no worker thread
// ensure no more data to go downstream -- we have no queued data
// call EndFlush on downstream pins
ASSERT(FOutput <> nil);
result := FOutput.DeliverEndFlush;
// caller (the input pin's method) will unblock Receives
end;
// EndOfStream received. Default behaviour is to deliver straight
// downstream, since we have no queued data. If you overrode Receive
// and have queue data, then you need to handle this and deliver EOS after
// all queued data is sent
function TBCTransformFilter.EndOfStream: HRESULT;
begin
result := NOERROR;
if (FOutput <> nil) then
result := FOutput.DeliverEndOfStream;
end;
// If Id is In or Out then return the IPin* for that pin
// creating the pin if need be. Otherwise return NULL with an error.
function TBCTransformFilter.FindPin(Id: PWideChar; out ppPin: IPin): HRESULT;
begin
if(WideString(Id) = 'In') then ppPin := GetPin(0) else
if(WideString(Id) = 'Out') then ppPin := GetPin(1) else
begin
ppPin := nil;
result := VFW_E_NOT_FOUND;
exit;
end;
result := NOERROR;
if(ppPin = nil) then result := E_OUTOFMEMORY;
end;
// return a non-addrefed CBasePin * for the user to addref if he holds onto it
// for longer than his pointer to us. We create the pins dynamically when they
// are asked for rather than in the constructor. This is because we want to
// give the derived class an oppportunity to return different pin objects
// We return the objects as and when they are needed. If either of these fails
// then we return NULL, the assumption being that the caller will realise the
// whole deal is off and destroy us - which in turn will delete everything.
function TBCTransformFilter.GetPin(n: integer): TBCBasePin;
var hr: HRESULT;
begin
hr := S_OK;
// Create an input pin if necessary
if(FInput = nil) then
begin
FInput := TBCTransformInputPin.Create('Transform input pin',
self, // Owner filter
hr, // Result code
'XForm In'); // Pin name
// Can't fail
ASSERT(SUCCEEDED(hr));
if(FInput = nil) then
begin
result := nil;
exit;
end;
FOutput := TBCTransformOutputPin.Create('Transform output pin',
self, // Owner filter
hr, // Result code
'XForm Out'); // Pin name
// Can't fail
ASSERT(SUCCEEDED(hr));
if(FOutput = nil) then FreeAndNil(FInput);
end;
// Return the appropriate pin
case n of
0 : result := FInput;
1 : result := FOutput;
else
result := nil;
end;
end;
function TBCTransformFilter.GetPinCount: integer;
begin
result := 2;
end;
// Set up our output sample
function TBCTransformFilter.InitializeOutputSample(Sample: IMediaSample;
out OutSample: IMediaSample): HRESULT;
var
Props: PAMSample2Properties;
Flags: DWORD;
Start, Stop: PReferenceTime;
OutSample2: IMediaSample2;
OutProps: TAMSample2Properties;
MediaStart, MediaEnd: Int64;
begin
// default - times are the same
Props := FInput.SampleProps;
if FSampleSkipped then Flags := AM_GBF_PREVFRAMESKIPPED else Flags := 0;
// This will prevent the image renderer from switching us to DirectDraw
// when we can't do it without skipping frames because we're not on a
// keyframe. If it really has to switch us, it still will, but then we
// will have to wait for the next keyframe
if(not BOOL(Props.dwSampleFlags and AM_SAMPLE_SPLICEPOINT)) then Flags := Flags or AM_GBF_NOTASYNCPOINT;
ASSERT(FOutput.FAllocator <> nil);
if BOOL(Props.dwSampleFlags and AM_SAMPLE_TIMEVALID) then Start := @Props.tStart else Start := nil;
if BOOL(Props.dwSampleFlags and AM_SAMPLE_STOPVALID) then Stop := @Props.tStop else Stop := nil;
result := FOutput.FAllocator.GetBuffer(OutSample, Start, Stop, Flags);
if FAILED(result) then exit;
ASSERT(OutSample <> nil);
if SUCCEEDED(OutSample.QueryInterface(IID_IMediaSample2, OutSample2)) then
begin
ASSERT(SUCCEEDED(OutSample2.GetProperties(4*4, OutProps)));
OutProps.dwTypeSpecificFlags := Props.dwTypeSpecificFlags;
OutProps.dwSampleFlags := (OutProps.dwSampleFlags and AM_SAMPLE_TYPECHANGED) or
(Props.dwSampleFlags and (not AM_SAMPLE_TYPECHANGED));
OutProps.tStart := Props.tStart;
OutProps.tStop := Props.tStop;
OutProps.cbData := (4*4) + (2*8);
OutSample2.SetProperties((4*4)+(2*8), OutProps);
if BOOL(Props.dwSampleFlags and AM_SAMPLE_DATADISCONTINUITY) then FSampleSkipped := FALSE;
OutSample2 := nil;
end
else
begin
if BOOL(Props.dwSampleFlags and AM_SAMPLE_TIMEVALID) then
OutSample.SetTime(@Props.tStart, @Props.tStop);
if BOOL(Props.dwSampleFlags and AM_SAMPLE_SPLICEPOINT) then
OutSample.SetSyncPoint(True);
if BOOL(Props.dwSampleFlags and AM_SAMPLE_DATADISCONTINUITY) then
begin
OutSample.SetDiscontinuity(True);
FSampleSkipped := FALSE;
end;
// Copy the media times
if (Sample.GetMediaTime(MediaStart,MediaEnd) = NOERROR) then
OutSample.SetMediaTime(@MediaStart, @MediaEnd);
end;
result := S_OK;
end;
function TBCTransformFilter.NewSegment(Start, Stop: TReferenceTime;
Rate: double): HRESULT;
begin
result := S_OK;
if (FOutput <> nil) then
result := FOutput.DeliverNewSegment(Start, Stop, Rate);
end;
function TBCTransformFilter.Pause: HRESULT;
begin
FcsFilter.Lock;
try
result := NOERROR;
if (FState = State_Paused) then
begin
// (This space left deliberately blank)
end
// If we have no input pin or it isn't yet connected then when we are
// asked to pause we deliver an end of stream to the downstream filter.
// This makes sure that it doesn't sit there forever waiting for
// samples which we cannot ever deliver without an input connection.
else
if ((FInput = nil) or (FInput.IsConnected = FALSE)) then
begin
if ((FOutput <> nil) and (FEOSDelivered = FALSE)) then
begin
FOutput.DeliverEndOfStream;
FEOSDelivered := True;
end;
FState := State_Paused;
end
// We may have an input connection but no output connection
// However, if we have an input pin we do have an output pin
else
if (FOutput.IsConnected = FALSE) then
FState := State_Paused
else
begin
if(FState = State_Stopped) then
begin
// allow a class derived from CTransformFilter
// to know about starting and stopping streaming
FcsReceive.Lock;
try
result := StartStreaming;
finally
FcsReceive.UnLock;
end;
end;
if SUCCEEDED(result) then result := inherited Pause;
end;
FSampleSkipped := FALSE;
FQualityChanged := FALSE;
finally
FcsFilter.UnLock;
end;
end;
// override this to customize the transform process
function TBCTransformFilter.Receive(Sample: IMediaSample): HRESULT;
var
Props: PAMSample2Properties;
OutSample: IMediaSample;
begin
// Check for other streams and pass them on
Props := FInput.SampleProps;
if(Props.dwStreamId <> AM_STREAM_MEDIA) then
begin
result := FOutput.FInputPin.Receive(Sample);
exit;
end;
// If no output to deliver to then no point sending us data
ASSERT(FOutput <> nil) ;
// Set up the output sample
result := InitializeOutputSample(Sample, OutSample);
if FAILED(result) then exit;
result := Transform(Sample, OutSample);
if FAILED(result) then
begin
{$IFDEF DEBUG}
DbgLog(self, 'Error from transform');
{$ENDIF}
exit;
end
else
begin
// the Transform() function can return S_FALSE to indicate that the
// sample should not be delivered; we only deliver the sample if it's
// really S_OK (same as NOERROR, of course.)
if (result = NOERROR) then
begin
result := FOutput.FInputPin.Receive(OutSample);
FSampleSkipped := FALSE; // last thing no longer dropped
end
else
begin
// S_FALSE returned from Transform is a PRIVATE agreement
// We should return NOERROR from Receive() in this cause because returning S_FALSE
// from Receive() means that this is the end of the stream and no more data should
// be sent.
if (result = S_FALSE) then
begin
// Release the sample before calling notify to avoid
// deadlocks if the sample holds a lock on the system
// such as DirectDraw buffers do
OutSample := nil;
FSampleSkipped := True;
if not FQualityChanged then
begin
NotifyEvent(EC_QUALITY_CHANGE,0,0);
FQualityChanged := True;
end;
result := NOERROR;
exit;
end;
end;
end;
// release the output buffer. If the connected pin still needs it,
// it will have addrefed it itself.
OutSample := nil;
end;
function TBCTransformFilter.SetMediaType(direction: TPinDirection;
pmt: PAMMediaType): HRESULT;
begin
result := NOERROR;
end;
// override these two functions if you want to inform something
// about entry to or exit from streaming state.
function TBCTransformFilter.StartStreaming: HRESULT;
begin
result := NOERROR;
end;
// override these so that the derived filter can catch them
function TBCTransformFilter.Stop: HRESULT;
begin
FcsFilter.Lock;
try
if(FState = State_Stopped) then
begin
result := NOERROR;
exit;
end;
// Succeed the Stop if we are not completely connected
ASSERT((FInput = nil) or (FOutput <> nil));
if((FInput = nil) or (FInput.IsConnected = FALSE) or (FOutput.IsConnected = FALSE)) then
begin
FState := State_Stopped;
FEOSDelivered := FALSE;
result := NOERROR;
exit;
end;
ASSERT(FInput <> nil);
ASSERT(FOutput <> nil);
// decommit the input pin before locking or we can deadlock
FInput.Inactive;
// synchronize with Receive calls
FcsReceive.Lock;
try
FOutput.Inactive;
// allow a class derived from CTransformFilter
// to know about starting and stopping streaming
result := StopStreaming;
if SUCCEEDED(result) then
begin
// complete the state transition
FState := State_Stopped;
FEOSDelivered := FALSE;
end;
finally
FcsReceive.UnLock;
end;
finally
FcsFilter.UnLock;
end;
end;
function TBCTransformFilter.StopStreaming: HRESULT;
begin
result := NOERROR;
end;
function TBCTransformFilter.Transform(msIn, msout: IMediaSample): HRESULT;
begin
{$IFDEF DEBUG}
DbgLog(self, 'TBCTransformFilter.Transform should never be called');
{$ENDIF}
result := E_UNEXPECTED;
end;
{ TBCTransformOutputPin }
// provides derived filter a chance to release it's extra interfaces
function TBCTransformOutputPin.BreakConnect: HRESULT;
begin
// Can't disconnect unless stopped
ASSERT(IsStopped);
FTransformFilter.BreakConnect(PINDIR_OUTPUT);
result := inherited BreakConnect;
end;
// provides derived filter a chance to grab extra interfaces
function TBCTransformOutputPin.CheckConnect(Pin: IPin): HRESULT;
begin
// we should have an input connection first
ASSERT(FTransformFilter.FInput <> nil);
if(FTransformFilter.FInput.IsConnected = FALSE) then
begin
result := E_UNEXPECTED;
exit;
end;
result := FTransformFilter.CheckConnect(PINDIR_OUTPUT, Pin);
if FAILED(result) then exit;
result := inherited CheckConnect(Pin);
end;
// check a given transform - must have selected input type first
function TBCTransformOutputPin.CheckMediaType(
mtOut: PAMMediaType): HRESULT;
begin
// must have selected input first
ASSERT(FTransformFilter.FInput <> nil);
if(FTransformFilter.FInput.IsConnected = FALSE) then
begin
result := E_INVALIDARG;
exit;
end;
result := FTransformFilter.CheckTransform(FTransformFilter.FInput.AMMediaType, mtOut);
end;
// Let derived class know when the output pin is connected
function TBCTransformOutputPin.CompleteConnect(ReceivePin: IPin): HRESULT;
begin
result := FTransformFilter.CompleteConnect(PINDIR_OUTPUT, ReceivePin);
if FAILED(result) then exit;
result := inherited CompleteConnect(ReceivePin);
end;
constructor TBCTransformOutputPin.Create(ObjectName: string;
TransformFilter: TBCTransformFilter; out hr: HRESULT; Name: WideString);
begin
inherited create(ObjectName, TransformFilter, TransformFilter.FcsFilter, hr, Name);
FPosition := nil;
{$IFDEF DEBUG}
DbgLog(self, 'TBCTransformOutputPin.Create');
{$ENDIF}
FTransformFilter := TransformFilter;
end;
function TBCTransformOutputPin.DecideBufferSize(Alloc: IMemAllocator;
Prop: PAllocatorProperties): HRESULT;
begin
result := FTransformFilter.DecideBufferSize(Alloc, Prop);
end;
destructor TBCTransformOutputPin.destroy;
begin
{$IFDEF DEBUG}
DbgLog(self, 'TBCTransformOutputPin.Destroy');
{$ENDIF}
FPosition := nil;
inherited;
end;
function TBCTransformOutputPin.GetMediaType(Position: integer;
out MediaType: PAMMediaType): HRESULT;
begin
ASSERT(FTransformFilter.FInput <> nil);
// We don't have any media types if our input is not connected
if(FTransformFilter.FInput.IsConnected) then
begin
result := FTransformFilter.GetMediaType(Position, MediaType);
exit;
end
else
result := VFW_S_NO_MORE_ITEMS;
end;
function TBCTransformOutputPin.NonDelegatingQueryInterface(
const IID: TGUID; out Obj): HResult;
begin
if IsEqualGUID(iid, IID_IMediaPosition) or IsEqualGUID(iid, IID_IMediaSeeking) then
begin
// we should have an input pin by now
ASSERT(FTransformFilter.FInput <> nil);
if (FPosition = nil) then
begin
result := CreatePosPassThru(GetOwner, FALSE, FTransformFilter.FInput, FPosition);
if FAILED(result) then exit;
end;
result := FPosition.QueryInterface(iid, obj);
end
else
result := inherited NonDelegatingQueryInterface(iid, obj);
end;
// Override this if you can do something constructive to act on the
// quality message. Consider passing it upstream as well
// Pass the quality mesage on upstream.
function TBCTransformOutputPin.Notify(Sendr: IBaseFilter; q: TQuality): HRESULT;
begin
// First see if we want to handle this ourselves
result := FTransformFilter.AlterQuality(q);
if (result <> S_FALSE) then exit;
// S_FALSE means we pass the message on.
// Find the quality sink for our input pin and send it there
ASSERT(FTransformFilter.FInput <> nil);
result := FTransformFilter.FInput.PassNotify(q);
end;
function TBCTransformOutputPin.QueryId(out Id: PWideChar): HRESULT;
begin
result := AMGetWideString('Out', Id);
end;
// called after we have agreed a media type to actually set it in which case
// we run the CheckTransform function to get the output format type again
function TBCTransformOutputPin.SetMediaType(pmt: PAMMediaType): HRESULT;
begin
ASSERT(FTransformFilter.FInput <> nil);
ASSERT(not IsEqualGUID(FTransformFilter.FInput.AMMediaType.majortype,GUID_NULL));
// Set the base class media type (should always succeed)
result := inherited SetMediaType(pmt);
if FAILED(result) then exit;
{$ifdef DEBUG}
if(FAILED(FTransformFilter.CheckTransform(FTransformFilter.FInput.AMMediaType, pmt))) then
begin
DbgLog(self, '*** This filter is accepting an output media type');
DbgLog(self, ' that it can''t currently transform to. I hope');
DbgLog(self, ' it''s smart enough to reconnect its input.');
end;
{$endif}
result := FTransformFilter.SetMediaType(PINDIR_OUTPUT,pmt);
end;
// milenko start (added TBCVideoTransformFilter conversion)
{ TBCVideoTransformFilter }
// This class is derived from CTransformFilter, but is specialised to handle
// the requirements of video quality control by frame dropping.
// This is a non-in-place transform, (i.e. it copies the data) such as a decoder.
constructor TBCVideoTransformFilter.Create(Name: WideString; Unk: IUnknown; clsid: TGUID);
begin
inherited Create(name, Unk, clsid);
FitrLate := 0;
FKeyFramePeriod := 0; // No QM until we see at least 2 key frames
FFramesSinceKeyFrame := 0;
FSkipping := False;
FtDecodeStart := 0;
FitrAvgDecode := 300000; // 30mSec - probably allows skipping
FQualityChanged := False;
{$IFDEF PERF}
RegisterPerfId();
{$ENDIF} // PERF
end;
destructor TBCVideoTransformFilter.Destroy;
begin
inherited Destroy;
end;
// Overriden to reset quality management information
function TBCVideoTransformFilter.EndFlush: HRESULT;
begin
FcsReceive.Lock;
try
// Reset our stats
//
// Note - we don't want to call derived classes here,
// we only want to reset our internal variables and this
// is a convenient way to do it
StartStreaming;
Result := inherited EndFlush;
finally
FcsReceive.UnLock;
end;
end;
{$IFDEF PERF}
procedure TBCVideoTransformFilter.RegisterPerfId;
begin
FidSkip := MSR_REGISTER('Video Transform Skip frame');
FidFrameType := MSR_REGISTER('Video transform frame type');
FidLate := MSR_REGISTER('Video Transform Lateness');
FidTimeTillKey := MSR_REGISTER('Video Transform Estd. time to next key');
// inherited RegisterPerfId;
end;
{$ENDIF}
function TBCVideoTransformFilter.StartStreaming: HRESULT;
begin
FitrLate := 0;
FKeyFramePeriod := 0; // No QM until we see at least 2 key frames
FFramesSinceKeyFrame := 0;
FSkipping := False;
FtDecodeStart := 0;
FitrAvgDecode := 300000; // 30mSec - probably allows skipping
FQualityChanged := False;
FSampleSkipped := False;
Result := NOERROR;
end;
// Reset our quality management state
function TBCVideoTransformFilter.AbortPlayback(hr: HRESULT): HRESULT;
begin
NotifyEvent(EC_ERRORABORT, hr, 0);
FOutput.DeliverEndOfStream;
Result := hr;
end;
// Receive()
//
// Accept a sample from upstream, decide whether to process it
// or drop it. If we process it then get a buffer from the
// allocator of the downstream connection, transform it into the
// new buffer and deliver it to the downstream filter.
// If we decide not to process it then we do not get a buffer.
// Remember that although this code will notice format changes coming into
// the input pin, it will NOT change its output format if that results
// in the filter needing to make a corresponding output format change. Your
// derived filter will have to take care of that. (eg. a palette change if
// the input and output is an 8 bit format). If the input sample is discarded
// and nothing is sent out for this Receive, please remember to put the format
// change on the first output sample that you actually do send.
// If your filter will produce the same output type even when the input type
// changes, then this base class code will do everything you need.
function TBCVideoTransformFilter.Receive(Sample: IMediaSample): HRESULT;
var
pmtOut, pmt: PAMMediaType;
pOutSample: IMediaSample;
{$IFDEF DEBUG}
fccOut: TGUID;
lCompression: LongInt;
lBitCount: LongInt;
lStride: LongInt;
rcS: TRect;
rcT: TRect;
rcS1: TRect;
rcT1: TRect;
{$ENDIF}
begin
// If the next filter downstream is the video renderer, then it may
// be able to operate in DirectDraw mode which saves copying the data
// and gives higher performance. In that case the buffer which we
// get from GetDeliveryBuffer will be a DirectDraw buffer, and
// drawing into this buffer draws directly onto the display surface.
// This means that any waiting for the correct time to draw occurs
// during GetDeliveryBuffer, and that once the buffer is given to us
// the video renderer will count it in its statistics as a frame drawn.
// This means that any decision to drop the frame must be taken before
// calling GetDeliveryBuffer.
ASSERT(FcsReceive.CritCheckIn);
ASSERT(Sample <> nil);
// If no output pin to deliver to then no point sending us data
ASSERT (FOutput <> nil) ;
// The source filter may dynamically ask us to start transforming from a
// different media type than the one we're using now. If we don't, we'll
// draw garbage. (typically, this is a palette change in the movie,
// but could be something more sinister like the compression type changing,
// or even the video size changing)
Sample.GetMediaType(pmt);
if (pmt <> nil) and (pmt.pbFormat <> nil) then
begin
// spew some debug output
ASSERT(not IsEqualGUID(pmt.majortype, GUID_NULL));
{$IFDEF DEBUG}
fccOut := pmt.subtype;
lCompression := PVideoInfoHeader(pmt.pbFormat).bmiHeader.biCompression;
lBitCount := PVideoInfoHeader(pmt.pbFormat).bmiHeader.biBitCount;
lStride := (PVideoInfoHeader(pmt.pbFormat).bmiHeader.biWidth * lBitCount + 7) div 8;
lStride := (lStride + 3) and not 3;
rcS1 := PVideoInfoHeader(pmt.pbFormat).rcSource;
rcT1 := PVideoInfoHeader(pmt.pbFormat).rcTarget;
DbgLog(Self,'Changing input type on the fly to');
DbgLog(Self,'FourCC: ' + inttohex(fccOut.D1,8) + ' Compression: ' + inttostr(lCompression) +
' BitCount: ' + inttostr(lBitCount));
DbgLog(Self,'biHeight: ' + inttostr(PVideoInfoHeader(pmt.pbFormat).bmiHeader.biHeight) +
' rcDst: (' + inttostr(rcT1.left) + ', ' + inttostr(rcT1.top) + ', ' +
inttostr(rcT1.right) + ', ' + inttostr(rcT1.bottom) + ')');
DbgLog(Self,'rcSrc: (' + inttostr(rcS1.left) + ', ' + inttostr(rcS1.top) + ', ' +
inttostr(rcS1.right) + ', ' + inttostr(rcS1.bottom) + ') Stride' + inttostr(lStride));
{$ENDIF}
// now switch to using the new format. I am assuming that the
// derived filter will do the right thing when its media type is
// switched and streaming is restarted.
StopStreaming();
CopyMediaType(FInput.AMMediaType,pmt);
DeleteMediaType(pmt);
// if this fails, playback will stop, so signal an error
Result := StartStreaming;
if (FAILED(Result)) then
begin
Result := AbortPlayback(Result);
Exit;
end;
end;
// Now that we have noticed any format changes on the input sample, it's
// OK to discard it.
if ShouldSkipFrame(Sample) then
begin
{$IFDEF PERF}
// MSR_NOTE(m_idSkip);
{$ENDIF}
FSampleSkipped := True;
Result := NOERROR;
Exit;
end;
// Set up the output sample
Result := InitializeOutputSample(Sample, pOutSample);
if (FAILED(Result)) then Exit;
FSampleSkipped := False;
// The renderer may ask us to on-the-fly to start transforming to a
// different format. If we don't obey it, we'll draw garbage
pOutSample.GetMediaType(pmtOut);
if (pmtOut <> nil) and (pmtOut.pbFormat <> nil) then
begin
// spew some debug output
ASSERT(not IsEqualGUID(pmtOut.majortype, GUID_NULL));
{$IFDEF DEBUG}
fccOut := pmtOut.subtype;
lCompression := PVideoInfoHeader(pmtOut.pbFormat).bmiHeader.biCompression;
lBitCount := PVideoInfoHeader(pmtOut.pbFormat).bmiHeader.biBitCount;
lStride := (PVideoInfoHeader(pmtOut.pbFormat).bmiHeader.biWidth * lBitCount + 7) div 8;
lStride := (lStride + 3) and not 3;
rcS := PVideoInfoHeader(pmtOut.pbFormat).rcSource;
rcT := PVideoInfoHeader(pmtOut.pbFormat).rcTarget;
DbgLog(Self,'Changing input type on the fly to');
DbgLog(Self,'FourCC: ' + inttohex(fccOut.D1,8) + ' Compression: ' + inttostr(lCompression) +
' BitCount: ' + inttostr(lBitCount));
DbgLog(Self,'biHeight: ' + inttostr(PVideoInfoHeader(pmtOut.pbFormat).bmiHeader.biHeight) +
' rcDst: (' + inttostr(rcT1.left) + ', ' + inttostr(rcT1.top) + ', ' +
inttostr(rcT1.right) + ', ' + inttostr(rcT1.bottom) + ')');
DbgLog(Self,'rcSrc: (' + inttostr(rcS1.left) + ', ' + inttostr(rcS1.top) + ', ' +
inttostr(rcS1.right) + ', ' + inttostr(rcS1.bottom) + ') Stride' + inttostr(lStride));
{$ENDIF}
// now switch to using the new format. I am assuming that the
// derived filter will do the right thing when its media type is
// switched and streaming is restarted.
StopStreaming();
CopyMediaType(FOutput.AMMediaType,pmtOut);
DeleteMediaType(pmtOut);
Result := StartStreaming;
if (SUCCEEDED(Result)) then
begin
// a new format, means a new empty buffer, so wait for a keyframe
// before passing anything on to the renderer.
// !!! a keyframe may never come, so give up after 30 frames
{$IFDEF DEBUG}
DbgLog(Self,'Output format change means we must wait for a keyframe');
{$ENDIF}
FWaitForKey := 30;
// if this fails, playback will stop, so signal an error
end else
begin
// Must release the sample before calling AbortPlayback
// because we might be holding the win16 lock or
// ddraw lock
pOutSample := nil;
AbortPlayback(Result);
Exit;
end;
end;
// After a discontinuity, we need to wait for the next key frame
if (Sample.IsDiscontinuity = S_OK) then
begin
{$IFDEF DEBUG}
DbgLog(Self,'Non-key discontinuity - wait for keyframe');
{$ENDIF}
FWaitForKey := 30;
end;
// Start timing the transform (and log it if PERF is defined)
if (SUCCEEDED(Result)) then
begin
FtDecodeStart := timeGetTime;
{$IFDEF PERF}
// MSR_START(FidTransform); // not added in conversion
{$ENDIF}
// have the derived class transform the data
Result := Transform(Sample, pOutSample);
// Stop the clock (and log it if PERF is defined)
{$IFDEF PERF}
// MSR_STOP(m_idTransform); // not added in conversion
{$ENDIF}
FtDecodeStart := timeGetTime - int64(FtDecodeStart);
FitrAvgDecode := Round(FtDecodeStart * (10000 / 16) + 15 * (FitrAvgDecode / 16));
// Maybe we're waiting for a keyframe still?
if (FWaitForKey > 0) then dec(FWaitForKey);
if (FWaitForKey > 0) and (Sample.IsSyncPoint = S_OK) then BOOL(FWaitForKey) := False;
// if so, then we don't want to pass this on to the renderer
if (FWaitForKey > 0) and (Result = NOERROR) then
begin
{$IFDEF DEBUG}
DbgLog(Self,'still waiting for a keyframe');
Result := S_FALSE;
{$ENDIF}
end;
end;
if (FAILED(Result)) then
begin
{$IFDEF DEBUG}
DbgLog(Self,'Error from video transform');
{$ENDIF}
end else
begin
// the Transform() function can return S_FALSE to indicate that the
// sample should not be delivered; we only deliver the sample if it's
// really S_OK (same as NOERROR, of course.)
// Try not to return S_FALSE to a direct draw buffer (it's wasteful)
// Try to take the decision earlier - before you get it.
if (Result = NOERROR) then
begin
Result := FOutput.Deliver(pOutSample);
end else
begin
// S_FALSE returned from Transform is a PRIVATE agreement
// We should return NOERROR from Receive() in this case because returning S_FALSE
// from Receive() means that this is the end of the stream and no more data should
// be sent.
if (S_FALSE = Result) then
begin
// We must Release() the sample before doing anything
// like calling the filter graph because having the
// sample means we may have the DirectDraw lock
// (== win16 lock on some versions)
pOutSample := nil;
FSampleSkipped := True;
if not FQualityChanged then
begin
FQualityChanged := True;
NotifyEvent(EC_QUALITY_CHANGE,0,0);
end;
Result := NOERROR;
Exit;
end;
end;
end;
// release the output buffer. If the connected pin still needs it,
// it will have addrefed it itself.
pOutSample := nil;
ASSERT(FcsReceive.CritCheckIn);
end;
function TBCVideoTransformFilter.AlterQuality(const q: TQuality): HRESULT;
begin
// to reduce the amount of 64 bit arithmetic, m_itrLate is an int.
// +, -, >, == etc are not too bad, but * and / are painful.
if (FitrLate > 300000000) then
begin
// Avoid overflow and silliness - more than 30 secs late is already silly
FitrLate := 300000000;
end else
begin
FitrLate := integer(q.Late);
end;
// We ignore the other fields
// We're actually not very good at handling this. In non-direct draw mode
// most of the time can be spent in the renderer which can skip any frame.
// In that case we'd rather the renderer handled things.
// Nevertheless we will keep an eye on it and if we really start getting
// a very long way behind then we will actually skip - but we'll still tell
// the renderer (or whoever is downstream) that they should handle quality.
Result := E_FAIL; // Tell the renderer to do his thing.
end;
function TBCVideoTransformFilter.ShouldSkipFrame(pIn: IMediaSample): Boolean;
var
Start, StopAt: TReferenceTime;
itrFrame: integer;
it: integer;
begin
Result := pIn.GetTime(Start, StopAt) = S_OK;
// Don't skip frames with no timestamps
if not Result then Exit;
itrFrame := integer(StopAt - Start); // frame duration
if(S_OK = pIn.IsSyncPoint) then
begin
{$IFDEF PERF}
MSR_INTEGER(FidFrameType, 1);
{$ENDIF}
if (FKeyFramePeriod < FFramesSinceKeyFrame) then
begin
// record the max
FKeyFramePeriod := FFramesSinceKeyFrame;
end;
FFramesSinceKeyFrame := 0;
FSkipping := False;
end else
begin
{$IFDEF PERF}
MSR_INTEGER(FidFrameType, 2);
{$ENDIF}
if (FFramesSinceKeyFrame > FKeyFramePeriod) and (FKeyFramePeriod > 0) then
begin
// We haven't seen the key frame yet, but we were clearly being
// overoptimistic about how frequent they are.
FKeyFramePeriod := FFramesSinceKeyFrame;
end;
end;
// Whatever we might otherwise decide,
// if we are taking only a small fraction of the required frame time to decode
// then any quality problems are actually coming from somewhere else.
// Could be a net problem at the source for instance. In this case there's
// no point in us skipping frames here.
if (FitrAvgDecode * 4 > itrFrame) then
begin
// Don't skip unless we are at least a whole frame late.
// (We would skip B frames if more than 1/2 frame late, but they're safe).
if (FitrLate > itrFrame) then
begin
// Don't skip unless the anticipated key frame would be no more than
// 1 frame early. If the renderer has not been waiting (we *guess*
// it hasn't because we're late) then it will allow frames to be
// played early by up to a frame.
// Let T = Stream time from now to anticipated next key frame
// = (frame duration) * (KeyFramePeriod - FramesSinceKeyFrame)
// So we skip if T - Late < one frame i.e.
// (duration) * (freq - FramesSince) - Late < duration
// or (duration) * (freq - FramesSince - 1) < Late
// We don't dare skip until we have seen some key frames and have
// some idea how often they occur and they are reasonably frequent.
if (FKeyFramePeriod > 0) then
begin
// It would be crazy - but we could have a stream with key frames
// a very long way apart - and if they are further than about
// 3.5 minutes apart then we could get arithmetic overflow in
// reference time units. Therefore we switch to mSec at this point
it := (itrFrame div 10000) * (FKeyFramePeriod - FFramesSinceKeyFrame - 1);
{$IFDEF PERF}
MSR_INTEGER(FidTimeTillKey, it);
{$ENDIF}
// For debug - might want to see the details - dump them as scratch pad
{$IFDEF VTRANSPERF}
MSR_INTEGER(0, itrFrame);
MSR_INTEGER(0, FFramesSinceKeyFrame);
MSR_INTEGER(0, FKeyFramePeriod);
{$ENDIF}
if (FitrLate div 10000 > it) then
begin
FSkipping := True;
// Now we are committed. Once we start skipping, we
// cannot stop until we hit a key frame.
end else
begin
{$IFDEF VTRANSPERF}
MSR_INTEGER(0, 777770); // not near enough to next key
{$ENDIF}
end;
end else
begin
{$IFDEF VTRANSPERF}
MSR_INTEGER(0, 777771); // Next key not predictable
{$ENDIF}
end;
end else
begin
{$IFDEF VTRANSPERF}
MSR_INTEGER(0, 777772); // Less than one frame late
MSR_INTEGER(0, FitrLate);
MSR_INTEGER(0, itrFrame);
{$ENDIF}
end;
end else
begin
{$IFDEF VTRANSPERF}
MSR_INTEGER(0, 777773); // Decode time short - not not worth skipping
MSR_INTEGER(0, FitrAvgDecode);
MSR_INTEGER(0, itrFrame);
{$ENDIF}
end;
inc(FFramesSinceKeyFrame);
if FSkipping then
begin
// We will count down the lateness as we skip each frame.
// We re-assess each frame. The key frame might not arrive when expected.
// We reset m_itrLate if we get a new Quality message, but actually that's
// not likely because we're not sending frames on to the Renderer. In
// fact if we DID get another one it would mean that there's a long
// pipe between us and the renderer and we might need an altogether
// better strategy to avoid hunting!
FitrLate := FitrLate - itrFrame;
end;
{$IFDEF PERF}
MSR_INTEGER(FidLate, integer(FitrLate div 10000)); // Note how late we think we are
{$ENDIF}
if FSkipping then
begin
if not FQualityChanged then
begin
FQualityChanged := True;
NotifyEvent(EC_QUALITY_CHANGE,0,0);
end;
end;
Result := FSkipping;
end;
// milenko end
{ TCTransInPlaceInputPin }
function TBCTransInPlaceInputPin.CheckMediaType(
pmt: PAMMediaType): HRESULT;
begin
result := FTIPFilter.CheckInputType(pmt);
if (result <> S_OK) then exit;
if FTIPFilter.FOutput.IsConnected then
result := FTIPFilter.FOutput.GetConnected.QueryAccept(pmt^)
else
result := S_OK;
end;
function TBCTransInPlaceInputPin.EnumMediaTypes(
out ppEnum: IEnumMediaTypes): HRESULT;
begin
// Can only pass through if connected
if (not FTIPFilter.FOutput.IsConnected) then
begin
result := VFW_E_NOT_CONNECTED;
exit;
end;
result := FTIPFilter.FOutput.GetConnected.EnumMediaTypes(ppEnum);
end;
function TBCTransInPlaceInputPin.GetAllocator(
out Allocator: IMemAllocator): HRESULT;
begin
FLock.Lock;
try
if FTIPFilter.FOutput.IsConnected then
begin
// Store the allocator we got
result := FTIPFilter.OutputPin.ConnectedIMemInputPin.GetAllocator(Allocator);
if SUCCEEDED(result) then
FTIPFilter.OutputPin.SetAllocator(Allocator);
end
else
begin
// Help upstream filter (eg TIP filter which is having to do a copy)
// by providing a temp allocator here - we'll never use
// this allocator because when our output is connected we'll
// reconnect this pin
result := inherited GetAllocator(Allocator);
end;
finally
FLock.UnLock;
end;
end;
function TBCTransInPlaceInputPin.GetAllocatorRequirements(
props: PAllocatorProperties): HRESULT;
begin
if FTIPFilter.FOutput.IsConnected then
result := FTIPFilter.OutputPin.ConnectedIMemInputPin.GetAllocatorRequirements(Props^)
else
result := E_NOTIMPL;
end;
function TBCTransInPlaceInputPin.NotifyAllocator(Allocator: IMemAllocator;
ReadOnly: BOOL): HRESULT;
var
OutputAllocator: IMemAllocator;
Props, Actual: TAllocatorProperties;
begin
result := S_OK;
FLock.Lock;
try
FReadOnly := ReadOnly;
// If we modify data then don't accept the allocator if it's
// the same as the output pin's allocator
// If our output is not connected just accept the allocator
// We're never going to use this allocator because when our
// output pin is connected we'll reconnect this pin
if not FTIPFilter.OutputPin.IsConnected then
begin
result := inherited NotifyAllocator(Allocator, ReadOnly);
exit;
end;
// If the allocator is read-only and we're modifying data
// and the allocator is the same as the output pin's
// then reject
if (FReadOnly and FTIPFilter.FModifiesData) then
begin
OutputAllocator := FTIPFilter.OutputPin.PeekAllocator;
// Make sure we have an output allocator
if (OutputAllocator = nil) then
begin
result := FTIPFilter.OutputPin.ConnectedIMemInputPin.GetAllocator(OutputAllocator);
if FAILED(result) then result := CreateMemoryAllocator(OutputAllocator);
if SUCCEEDED(result) then
begin
FTIPFilter.OutputPin.SetAllocator(OutputAllocator);
OutputAllocator := nil;
end;
end;
if (Allocator = OutputAllocator) then
begin
result := E_FAIL;
exit;
end
else
if SUCCEEDED(result) then
begin
// Must copy so set the allocator properties on the output
result := Allocator.GetProperties(Props);
if SUCCEEDED(result) then
result := OutputAllocator.SetProperties(Props, Actual);
if SUCCEEDED(result) then
begin
if ((Props.cBuffers > Actual.cBuffers)
or (Props.cbBuffer > Actual.cbBuffer)
or (Props.cbAlign > Actual.cbAlign)) then
result := E_FAIL;
end;
// Set the allocator on the output pin
if SUCCEEDED(result) then
result := FTIPFilter.OutputPin.ConnectedIMemInputPin.NotifyAllocator(OutputAllocator, FALSE);
end;
end
else
begin
result := FTIPFilter.OutputPin.ConnectedIMemInputPin.NotifyAllocator(Allocator, ReadOnly);
if SUCCEEDED(result) then FTIPFilter.OutputPin.SetAllocator(Allocator);
end;
if SUCCEEDED(result) then
begin
// It's possible that the old and the new are the same thing.
// AddRef before release ensures that we don't unload it.
Allocator._AddRef;
if (FAllocator <> nil) then FAllocator := nil;
Pointer(FAllocator) := Pointer(Allocator); // We have an allocator for the input pin
end;
finally
FLock.UnLock;
end;
end;
function TBCTransInPlaceInputPin.PeekAllocator: IMemAllocator;
begin
result := FAllocator;
end;
constructor TBCTransInPlaceInputPin.Create(ObjectName: string;
Filter: TBCTransInPlaceFilter; out hr: HRESULT; Name: WideString);
begin
inherited Create(ObjectName, Filter, hr, Name);
FReadOnly := FALSE;
FTIPFilter := Filter;
{$IFDEF DEBUG}
DbgLog(self, 'TBCTransInPlaceInputPin.Create');
{$ENDIF}
end;
{ TBCTransInPlaceOutputPin }
function TBCTransInPlaceOutputPin.CheckMediaType(
pmt: PAMMediaType): HRESULT;
begin
// Don't accept any output pin type changes if we're copying
// between allocators - it's too late to change the input
// allocator size.
if (FTIPFilter.UsingDifferentAllocators and (not FFilter.IsStopped)) then
begin
if TBCMediaType(pmt).Equal(@Fmt) then result := S_OK else result := VFW_E_TYPE_NOT_ACCEPTED;
exit;
end;
// Assumes the type does not change. That's why we're calling
// CheckINPUTType here on the OUTPUT pin.
result := FTIPFilter.CheckInputType(pmt);
if (result <> S_OK) then exit;
if (FTIPFilter.FInput.IsConnected) then
result := FTIPFilter.FInput.GetConnected.QueryAccept(pmt^)
else
result := S_OK;
end;
function TBCTransInPlaceOutputPin.ConnectedIMemInputPin: IMemInputPin;
begin
pointer(result) := pointer(FInputPin);
end;
constructor TBCTransInPlaceOutputPin.Create(ObjectName: string;
Filter: TBCTransInPlaceFilter; out hr: HRESULT; Name: WideString);
begin
inherited Create(ObjectName, Filter, hr, Name);
FTIPFilter := Filter;
{$IFDEF DEBUG}
DbgLog(self, 'TBCTransInPlaceOutputPin.Create');
{$ENDIF}
end;
function TBCTransInPlaceOutputPin.EnumMediaTypes(
out ppEnum: IEnumMediaTypes): HRESULT;
begin
// Can only pass through if connected.
if not FTIPFilter.FInput.IsConnected then
result := VFW_E_NOT_CONNECTED
else
result := FTIPFilter.FInput.GetConnected.EnumMediaTypes(ppEnum);
end;
function TBCTransInPlaceOutputPin.PeekAllocator: IMemAllocator;
begin
result := FAllocator;
end;
procedure TBCTransInPlaceOutputPin.SetAllocator(Allocator: IMemAllocator);
begin
Allocator._AddRef;
if(FAllocator <> nil) then FAllocator._Release;