Re: [Delphi] Directx Filter

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

Try GraphEdit and see what's wrong with the graph. I didn't find any
problems in your code. Maybe Delphi's try/except is expensive? I don't know
much about Delphi.

Did you try letting your DV capture filter to output a lower resolution
bitmap? Maybe it outputs 800x600x32 bitmap at 25fps, if it does, CopyMemory
at 384MBPS (800x600x32x25) could be expensive and the DMA has been
exhausted.

"Andrea" <Andrea@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:52D8466B-88B4-4497-BF50-83633E8C6E7E@xxxxxxxxxxxxxxxx
"Netex" wrote:

Forgot to say: use TransformFilter, implement DecideBufferSize and a
Transform(pIn,pOut) to have separated read and write buffers.

Thanks Netex. I Think I did it, this is the code:

unit TransformMain;

{$IFDEF VER150}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CAST OFF}
{$ENDIF}

interface

uses
Windows, SysUtils, Classes, Graphics, SyncObjs, BaseClass, ActiveX,
DirectShow9,
DSUTil, GR32, GR32_Image, GR32_Layers, GR32_Blend, dateUtils, Controls;

const
CLSID_JongovBrightnessControlFilter: TGUID =
'{F0759A68-0BE9-4F06-BD51-9C8AA2765A22}';

var
// If there are multiple instances of this filter active, it's
// useful for debug messages etc. to know which one this is.
InstanceCount : Integer = 0;

type
IBrightnessControl = interface
['{EA6589CF-961F-4701-AA53-F045649C7C19}']
end;

TBrightnessControlFilter = class(TBCTransformFilter, IPersist,
ISpecifyPropertyPages, IBrightnessControl)
FThisInstance : Integer;

FWidth : Integer;
FHeight : Integer;
nFrame: integer;


private
fFormat : TVideoInfoHeader;
Image : TImage32;
B: TBitmapLayer;
Frame: TBitmap32;
L,T,W,H, i : Integer;
OSD1, OSD2, OSD3 : string;

function CreaMotoreGrafico: HRESULT;

public
constructor Create(ObjName: string; unk: IUnKnown; out hr: HRESULT);
constructor CreateFromFactory(Factory: TBCClassFactory; const
Controller: IUnknown); override;
destructor Destroy; override;

function Transform(pIn, pOut: IMediaSample): HRESULT; overload;
override;

function DecideBufferSize(Alloc: IMemAllocator;
Properties: PAllocatorProperties): HRESULT; override;

function CheckTransform(mtIn, mtOut: PAMMediaType): HRESULT;
override;{Buffer Size in seconds}

function CheckInputType(mtIn: PAMMediaType): HRESULT; override;

function GetMediaType(Position: Integer;
out MediaType: pAMMediaType): HRESULT; override;

function CompleteConnect(direction: TPinDirection; ReceivePin: IPin):
HRESULT; override;

{ISpecifyPropertyPages}
function GetPages(out Pages: TCAGUID): HRESULT; stdcall;

procedure DoInitializeDirectDraw(Info : PVideoInfoHeader);
function SetMediaType(MediaType: PAMMediaType): HResult;

end;

implementation





{---------------------------- TBrightnessControlFilter
-------------------------}

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

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

CopyMemory(@fFormat,VIH,SizeOf(TVideoInfoHeader));
DoInitializeDirectDraw(@fFormat);
Result := S_OK;
end;


procedure TBrightnessControlFilter.DoInitializeDirectDraw(Info :
PVideoInfoHeader);
begin
fFormat := Info^;
fWidth := Info.bmiHeader.biWidth;
fHeight := Info.bmiHeader.biHeight;
end;


function TBrightnessControlFilter.CheckInputType(mtIn: PAMMediaType):
HRESULT;
begin
Result := E_FAIL;
if IsEqualGUID(mtIn.majortype, MEDIATYPE_Video) and
IsEqualGUID(mtIn.subtype, MEDIASUBTYPE_RGB32) and
IsEqualGUID(mtIn.formattype, FORMAT_VideoInfo) and
(mtIn.pbFormat <> nil)
then
Result := S_OK;

end;

function TBrightnessControlFilter.CheckTransform(mtIn, mtOut:
PAMMediaType):
HRESULT;
var
hr : HRESULT;
pInput : PVideoInfoHeader;
pOutput : PVideoInfoHeader;
begin
Result := E_FAIL;
try
hr := CheckInputType(mtIn);
if FAILED(hr) then
begin
Result := hr;
Exit;
end;

if not IsEqualGUID(mtOut.formattype, FORMAT_VideoInfo) then
begin
Result := E_INVALIDARG;
Exit;
end;

pInput := PVideoInfoHeader(mtIn.pbFormat);
pOutput := PVideoInfoHeader(mtOut.pbFormat);

if CompareMem(@pInput.bmiHeader, @pOutput.bmiHeader,
SizeOf(BITMAPINFOHEADER)) then
Result := S_OK
else
Result := E_INVALIDARG;
except
OutputDebugString('tsv: Error in
TBrightnessControlFilter.CheckTransform
call...');
end;
end;

constructor TBrightnessControlFilter.Create(ObjName: string; unk:
IInterface; out Hr: HRESULT);
begin
try
FWidth := 720;
FHeight := 576;
FThisInstance := InterlockedIncrement(InstanceCount);

inherited Create(ObjName + IntToStr(FThisInstance), unk,
CLSID_JongovBrightnessControlFilter);

except
OutputDebugString('tsv: Error in TBrightnessControlFilter.Create
call...');
end;
end;

constructor TBrightnessControlFilter.CreateFromFactory(Factory:
TBCClassFactory;
const Controller: IInterface);
var
hr: HRESULT;
begin
try
Create(Factory.Name, Controller, hr);
except
OutputDebugString('tsv: Error in
TBrightnessControlFilter.CreateFromFactory call...');
end;
end;

destructor TBrightnessControlFilter.Destroy;
begin
try
inherited;
except
OutputDebugString('tsv: Error in TBrightnessControlFilter.Destroy
call...');
end;
end;

function TBrightnessControlFilter.Transform(pIn, pOut: IMediaSample):
HRESULT;
var
SourceBuffer, DestBuffer, Bits : PByte;
Color: PColor32Array;
SourceSize : LongInt;
MediaStart, MediaEnd : Int64;
i: integer;

begin
Result := E_FAIL;
try
// Copy the sample data
pIn.GetPointer(SourceBuffer);
SourceSize := pIn.GetActualDataLength;
pOut.GetPointer(DestBuffer);

SetDiBitsToDevice(Image.Bitmap.Handle,
0, 0, FWidth, FHeight,
0, 0, 0, FWidth * FHeight,
SourceBuffer, PBitmapInfo(@fFormat.bmiHeader)^,
DIB_RGB_COLORS);

Image.PaintTo(Frame,Rect(0,0,FWidth,FHeight));

Frame.FlipVert();

Bits := Pointer(Frame.Bits);

CopyMemory(DestBuffer, Bits, SourceSize);

Result := S_OK;
except
OutputDebugString('tsv: Error in
TBrightnessControlFilter.CopyMediaSample call...');
end;
end;


function TBrightnessControlFilter.CompleteConnect(direction:
TPinDirection;
ReceivePin: IPin): HRESULT;
var
ppMediaType : PAMMediaType;
pVidInfo : PVideoInfoHeader;
begin
Result := E_FAIL;
try
Result := inherited CompleteConnect(direction, ReceivePin);

if Result = S_OK then
begin
ppMediaType := FInput.CurrentMediaType.MediaType;




if ppMediaType.pbFormat <> nil then
begin
pVidInfo := ppMediaType.pbFormat;

FWidth := pVidInfo^.bmiHeader.biWidth;
FHeight := pVidInfo^.bmiHeader.biHeight;
SetMediaType(ppMediaType);
CreaMotoreGrafico;
end;
Integer(ppMediaType) := 0;
end;
except
OutputDebugString('tsv: Error in
TBrightnessControlFilter.CompleteConnect call...');
end;
end;

function TBrightnessControlFilter.DecideBufferSize(Alloc: IMemAllocator;
Properties: PAllocatorProperties): HRESULT;
var
InProps, Actual : TALLOCATORPROPERTIES;
InAlloc : IMemAllocator;
begin
Result := E_FAIL;
try
// Is the input pin connected
if not FInput.IsConnected then
begin
Result := E_UNEXPECTED;
Exit;
end;

ASSERT(Alloc <> nil);
ASSERT(Properties <> nil);

Properties.cBuffers := 1;
Properties.cbAlign := 1;

// Get input pin's allocator size and use that
Result := FInput.GetAllocator(InAlloc);
if SUCCEEDED(Result) then
begin
Result := InAlloc.GetProperties(InProps);
if SUCCEEDED(Result) then
Properties.cbBuffer := InProps.cbBuffer;

InAlloc := nil;
end;

if FAILED(result) then Exit;

ASSERT(Properties.cbBuffer <> 0);

// Ask the allocator to reserve us some sample memory, NOTE the
function
// can succeed (that is return NOERROR) but still not have allocated
the
// memory that we requested, so we must check we got whatever we wanted

Result := Alloc.SetProperties(Properties^, Actual);
if FAILED(Result) then
Exit;

ASSERT(Actual.cBuffers = 1);

if (Properties.cBuffers > Actual.cBuffers) or
(Properties.cbBuffer > Actual.cbBuffer) then
Result := E_FAIL
else
Result := S_OK;
except
OutputDebugString('tsv: Error in
TBrightnessControlFilter.DecideBufferSize call...');
end;
end;

function TBrightnessControlFilter.GetMediaType(Position: integer;
out MediaType: pAMMediaType): HRESULT;
begin
Result := E_FAIL;
try
// Is the input pin connected
if not FInput.IsConnected then
begin
Result := E_UNEXPECTED;
Exit;
end;

// This should never happen
if (Position < 0) then
begin
Result := E_INVALIDARG;
Exit;
end;

// Do we have more items to offer
if (Position > 0) then
begin
Result := VFW_S_NO_MORE_ITEMS;
Exit;
end;

CopyMediaType(MediaType, FInput.CurrentMediaType.MediaType);
Result := S_OK;
except
OutputDebugString('tsv: Error in TBrightnessControlFilter.GetMediaType
call...');
end;
end;

function TBrightnessControlFilter.GetPages(out Pages: TCAGUID): HRESULT;
begin
Result := E_FAIL;
try
Pages.cElems := 1;
Pages.pElems := CoTaskMemAlloc(SizeOf(TGUID));
if (Pages.pElems = nil) then
begin
Result := E_OUTOFMEMORY;
Exit;
end;
Result := S_OK;
except
OutputDebugString('tsv: Error in TBrightnessControlFilter.GetPages
call...');
end;
end;

function TBrightnessControlFilter.CreaMotoreGrafico: HRESULT;
var i : integer;
begin
Result := E_FAIL;
try
Image := TImage32.Create(nil);
Image.Bitmap.SetSize(FWidth, FHeight);
Image.RepaintMode := rmDirect;
Image.DoubleBuffered := false;
Frame := TBitmap32.Create;
Frame.SetSize(FWidth, FHeight);

for i := 0 to 10 do
begin
B := TBitmapLayer.Create(Image.Layers);
B.Bitmap.LoadFromFile('Logo.bmp');
L := FWidth - b.Bitmap.Width - Random(600);
T := FHeight - B.Bitmap.Height - Random(400);
W := L + B.Bitmap.Width;
H := T + B.Bitmap.Height;
B.Bitmap.MasterAlpha := 200;
B.Location := FloatRect(L,T,W,H);
B.Bitmap.DrawMode := dmBlend;
end;
Result := S_OK;
except
OutputDebugString('tsv: Error in TBrightnessControlFilter.MotoreGrafico
Call...');
end;




end;


initialization
TBCClassFactory.CreateFilter(TBrightnessControlFilter, 'Jongov Brightness
Control Filter', CLSID_JongovBrightnessControlFilter,
CLSID_LegacyAmFilterCategory,
MERIT_DO_NOT_USE, 0, nil);
end.



.

Relevant Pages