unit MainFrm;


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActiveX, ECustomProperty, ComObj, StdCtrls, ExtCtrls, ComCtrls, Menus, DirectShow9;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    TrackBar2: TTrackBar;
    CheckBox1: TCheckBox;
    Label3: TLabel;
    Button1: TButton;
    TrackBar1: TTrackBar;
    Label4: TLabel;
    Panel1: TPanel;
    Button2: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function CaptureVideo: HRESULT;
    function GetInterfaces: HRESULT;
    function FindCaptureDevice(var PSrcFilter: IBaseFilter): HRESULT;
    function SetupVideoWindow: HRESULT;
    function AddGraphToRot( pUnkGraph: IUnknown; pdwRegister: LongInt): HRESULT;
    procedure CloseInterfaces;
    procedure RemoveGraphFromRot(pdwRegister: LongInt);
  end;

var
  Form1: TForm1;

Type PLAYSTATE = (Stopped, Paused, Running, Init);

var
  MyVideoWindow           : IVideoWindow = nil;
	MyGraphBuilder          : IGraphBuilder = nil;
  MyCaptureGraphBuilder2  : ICaptureGraphBuilder2 = nil;
	MyMediaControl          : IMediaControl = nil;
  MyMediaEventEx          : IMediaEventEx = nil;
  MyBaseFilter            : IBaseFilter = nil;
  MyKsVideoProcAmpProperty: IAMVideoProcAmp = nil;
  MyKsCameraControlProperty: IAMCameraControl = nil;
  MyObject                : IKsObject = nil;
  MyObjectHandle          : THandle;
  g_dwGraphRegister       : LongInt = 0;
  g_psCurrent             : PLAYSTATE = Stopped;

implementation

{$R *.dfm}


function TForm1.CaptureVideo: HRESULT;
var
  NameStr : WideString;
begin
	result := CoInitialize(nil);
  if (FAILED(result)) then
    begin
        ShowMessage('Failed to get video interfaces!  hr='+IntToHex(result,8));
        abort;
    end;

  result := GetInterfaces;
  if (FAILED(result)) then
    begin
        ShowMessage('Failed to get video interfaces!  hr='+IntToHex(result,8));
        abort;
    end;

  result := MyCaptureGraphBuilder2.SetFiltergraph(MyGraphBuilder);
  if (FAILED(result)) then
    begin
        ShowMessage('Failed to set capture filter graph!  hr='+IntToHex(result,8));
        abort;
    end;

  result := FindCaptureDevice(MyBaseFilter);
  if (FAILED(result)) then abort;

  NameStr := 'Video Capture';
  result := MyGraphBuilder.AddFilter(MyBaseFilter, @NameStr);
  if (FAILED(result)) then
    begin
      ShowMessage('Couldn''t add the capture filter to the graph!  hr='+IntToHex(result,8)+#13#10+
                  'If you have a working video capture device, please make sure'+#13#10+
                  'that it is connected and is not being used by another application.'+#13#10+
                  'The sample will now close.');
      abort;
    end;

  result := MyCaptureGraphBuilder2.RenderStream(@PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, MyBaseFilter, nil, nil);
  if (FAILED(result)) then
    begin
      ShowMessage('Couldn''t render the video capture stream.  hr='+IntToHex(result,8)+#13#10+
                  'The capture device may already be in use by another application.'+#13#10+
                  'The sample will now close.');
      abort;
    end;

  MyBaseFilter.QueryInterface(IKsObject, MyObject);
  if (FAILED(result)) then abort;
  MyObjectHandle := MyObject.KsGetObjectHandle;

  result := MyBaseFilter.QueryInterface(IID_IAMVideoProcAmp, MyKsVideoProcAmpProperty);
  if (FAILED(result)) then abort;

  result := MyBaseFilter.QueryInterface(IID_IAMCameraControl, MyKsCameraControlProperty);
  if (FAILED(result)) then abort;

  // Now that the filter has been added to the graph and we have
  // rendered its stream, we can release this reference to the filter.
  //  MyBaseFilter._Release;

  // Set video window style and position
  result := SetupVideoWindow;
  if (FAILED(result)) then
    begin
        ShowMessage('Couldn''t initialize video window!  hr='+IntToHex(result,8));
        abort;
    end;

  // Start previewing video data
  result := MyMediaControl.Run;
  if (FAILED(result)) then
    begin
       ShowMessage('Couldn''t run the graph!  hr='+IntToHex(result,8));
       abort;
    end;

  // Remember current state
  g_psCurrent := Running;

  result := S_OK;
end;

function TForm1.GetInterfaces: HRESULT;
begin
	{получаем интерфейсы}
	result := CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC, IID_IGraphBuilder, MyGraphBuilder);
  if (FAILED(result)) then abort;
  result := CoCreateInstance(CLSID_CaptureGraphBuilder2 , nil, CLSCTX_INPROC, IID_ICaptureGraphBuilder2, MyCaptureGraphBuilder2);
  if (FAILED(result)) then abort;
  result := MyGraphBuilder.QueryInterface(IID_IMediaControl, MyMediaControl);
  if (FAILED(result)) then abort;
  result := MyGraphBuilder.QueryInterface(IID_IVideoWindow, MyVideoWindow);
  if (FAILED(result)) then abort;
  result := MyGraphBuilder.QueryInterface(IID_IMediaEvent, MyMediaEventEx);
  if (FAILED(result)) then abort;
  result := MyMediaEventEx.SetNotifyWindow(Application.Handle, WM_APP+1, 0);
end;

procedure TForm1.CloseInterfaces;
begin
  // Stop previewing data
  if (MyMediaControl<>nil) then MyMediaControl.StopWhenReady;
  g_psCurrent := Stopped;
  // Stop receiving events
  if (MyMediaEventEx<>nil) then MyMediaEventEx.SetNotifyWindow(0, WM_APP+1, 0);
  // Relinquish ownership (IMPORTANT!) of the video window.
  // Failing to call put_Owner can lead to assert failures within
  // the video renderer, as it still assumes that it has a valid
  // parent window.
  if (MyVideoWindow<>nil) then
    begin
      MyVideoWindow.put_Visible(False);
      MyVideoWindow.put_Owner(0);
    end;

    if (g_dwGraphRegister=0) then RemoveGraphFromRot(g_dwGraphRegister);
end;

function TForm1.FindCaptureDevice(var PSrcFilter: IBaseFilter): HRESULT;
var
  pSrc      : IBaseFilter;
  pMoniker  : IMoniker;
  pDevEnum  : ICreateDevEnum;
  pClassEnum: IEnumMoniker;
  cFetched  : Longint;
begin
  pSrc      := nil;
  pMoniker  := nil;
  pDevEnum  := nil;
  pClassEnum:= nil;

  if (PSrcFilter<>nil) then begin result:=E_POINTER; abort end;

  // Create the system device enumerator
  result := CoCreateInstance (CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, pDevEnum);
  if (FAILED(result)) then
    begin
      ShowMessage('Couldn''t create system enumerator!  result='+IntToHex(result,8));
      abort
    end;

  // Create an enumerator for the video capture devices
  result := pDevEnum.CreateClassEnumerator (CLSID_VideoInputDeviceCategory, pClassEnum, 0);
  if (FAILED(result)) then
    begin
      ShowMessage('Couldn''t create class enumerator!  result='+IntToHex(result,8));
      abort
    end;

  // If there are no enumerators for the requested type, then
  // CreateClassEnumerator will succeed, but pClassEnum will be NULL.
  if (pClassEnum = nil) then
    begin
      ShowMessage('No video capture device was detected.'+#13#10+
                  'This sample requires a video capture device, such as a USB WebCam,'+#13#10+
                  'to be installed and working properly.  The sample will now close.'+#13#10+
                  'No Video Capture Hardware');
      result := E_FAIL;
      abort;
    end;

  // Use the first video capture device on the device list.
  // Note that if the Next() call succeeds but there are no monikers,
  // it will return S_FALSE (which is not a failure).  Therefore, we
  // check that the return code is S_OK instead of using SUCCEEDED() macro.
  if (S_OK = (pClassEnum.Next(1, pMoniker, @cFetched)))
    then
      begin
        // Bind Moniker to a filter object
        result := pMoniker.BindToObject(nil,nil,IID_IBaseFilter, pSrc);
        if (FAILED(result)) then
          begin
            ShowMessage('Couldn''t bind moniker to filter object!  result='+IntToStr(result));
            abort
          end;
      end
    else
      begin
        ShowMessage('Unable to access video capture device!');
        abort
      end;
  // Copy the found filter pointer to the output parameter.
  // Do NOT Release() the reference, since it will still be used
  // by the calling function.
  pSrcFilter := pSrc;
end;

function TForm1.SetupVideoWindow: HRESULT;
begin
  // Set the video window to be a child of the main window
  result := MyVideoWindow.put_Owner(Self.Panel1.Handle);
  if (FAILED(result)) then abort;
  // Set video window style
  result := MyVideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPCHILDREN);
  if (FAILED(result)) then abort;

	result := MyVideoWindow.SetWindowPosition(0,0,Panel1.ClientRect.Right,Panel1.ClientRect.Bottom);
  if (FAILED(result)) then abort;
end;


function TForm1.AddGraphToRot( pUnkGraph: IUnknown; pdwRegister: Longint): HRESULT;
var
  pMoniker: IMoniker;
  pROT    : IRunningObjectTable;
  wsz     : WideString;
begin
  if ((pUnkGraph=nil) or (pdwRegister<>0)) then begin result := E_POINTER; abort end;

  if FAILED(GetRunningObjectTable(0, pROT)) then begin result := E_FAIL; abort end;

  wsz := WideFormat('FilterGraph %x pid %x', [LongInt(pUnkGraph),GetCurrentProcessId]);

  result := CreateItemMoniker('!', @wsz, pMoniker);
  if (SUCCEEDED(result)) then
    begin
      // Use the ROTFLAGS_REGISTRATIONKEEPSALIVE to ensure a strong reference
      // to the object.  Using this flag will cause the object to remain
      // registered until it is explicitly revoked with the Revoke() method.

      // Not using this flag means that if GraphEdit remotely connects
      // to this graph and then GraphEdit exits, this object registration
      // will be deleted, causing future attempts by GraphEdit to fail until
      // this application is restarted or until the graph is registered again.

      result := pROT.Register(ROTFLAGS_REGISTRATIONKEEPSALIVE, pUnkGraph, pMoniker, pdwRegister);
      pMoniker._Release;
    end;
  pROT._Release;
end;

procedure TForm1.RemoveGraphFromRot(pdwRegister: LongInt);
var
  pROT: IRunningObjectTable;
begin
  if (SUCCEEDED(GetRunningObjectTable(0, pROT))) then
    begin
        pROT.Revoke(pdwRegister);
        pROT._Release;
    end
end;

procedure TForm1.FormShow(Sender: TObject);
var Value: Integer;
    VideoProcAmpFlag   : TVideoProcAmpFlags;
    CameraControlFlag  : TCameraControlFlags;
begin
  if Succeeded(CaptureVideo)
    then
      begin
        MyKsVideoProcAmpProperty.Get(VideoProcAmp_Brightness,Value,VideoProcAmpFlag);
        TrackBar1.Position:=Value;
        MyKsCameraControlProperty.Get(TCameraControlProperty(EVSCameraControl_Exposure),Value,CameraControlFlag);
        if CameraControlFlag<>CameraControl_Flags_Auto then CheckBox1.Checked:=True else CheckBox1.Checked:=False;
        TrackBar2.Position:=Value;
      end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CloseInterfaces;
  CoUninitialize;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  if MyVideoWindow<>nil
    then
      begin
        MyVideoWindow.put_Height(Height);
        MyVideoWindow.put_Width(Width)
      end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (MyMediaControl<>nil) then
    if Button1.Caption='Stop Capture' then
      begin
        // Stop previewing data
        MyMediaControl.StopWhenReady;
        Button1.Caption:='Start Capture'
      end
     else
      begin
        // Start previewing data
        if (MyMediaControl<>nil) then MyMediaControl.Run;
        Button1.Caption:='Stop Capture'
      end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var Value : Integer;
begin
  GetCustomProperty(MyObjectHandle, REQ_GET_DEVICE_ID, Value);
  case Value of
      C_Unknown:     Edit1.Text:='Camera ID - Unknown';
      C_Contrast:    Edit1.Text:='Camera ID - Contrast';
      C_7620:        Edit1.Text:='Camera ID - OV7620';
      C_9630:        Edit1.Text:='Camera ID - OV9630';
      C_2610:        Edit1.Text:='Camera ID - OV2610';
      C_3610:        Edit1.Text:='Camera ID - OV3610';
      C_3620:        Edit1.Text:='Camera ID - OV3620';
      C_AnalogCamera:Edit1.Text:='Camera ID - Analog';
    else             Edit1.Text:='Camera ID - Error!'
  end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  MyKsVideoProcAmpProperty.Set_(TVideoProcAmpProperty(EVSVideoProcAmp_Brightness),TrackBar1.Position,VideoProcAmp_Flags_Manual)
end;

procedure TForm1.TrackBar2Change(Sender: TObject);
var  Flag : TCameraControlFlags;

begin
  if CheckBox1.Checked then Flag:=CameraControl_Flags_Manual else Flag:=CameraControl_Flags_Auto;
  MyKsCameraControlProperty.Set_(TCameraControlProperty(EVSCameraControl_Exposure),TrackBar2.Position,Flag);
end;

end.







