(*
Copyright (c) 1998-2001 by Hyrix Technologies Srl. All rights reserved.

This software comes without any warranty either implied or expressed.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

Hyrix Technologies Srl grants you the right to include the compiled component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE,
BUT YOU MAY NOT DISTRIBUTE THIS SOURCE CODE OR ITS COMPILED .DCU IN ANY FORM.

ImageEn may not be included in any commercial, shareware or freeware DELPHI
libraries or components.

email: hycomp@hyrix.com

homepage: http://www.hyrix.com/dev

*)

unit hvideocap;

{$I IE.INC}

interface

uses
  Windows, Messages, SysUtils, StdCtrls, Classes, Graphics, Controls, Forms, Dialogs, ImageEnView, ImageEnProc, iedefs, videocap;

type

  //TcapVideoStreamCallback = function(hWnd:HWND; lpVHdr:PVIDEOHDR):LRESULT; stdcall;

  TImageEnVideoCap = class(TComponent)
  private
    fCapture:boolean;	// se true inizia cattura
    fWndC:HWND;	// Handle finestra Video Capture (0=da creare)
 	 fDrivers:TStringList;	// driver disponibili
    fVideoSource:integer;	// indice video source corrente
    fPreviewRate:integer;
  	 fCallBackFrame:boolean;	// Se True chiama attiva la callback CallBackFrameFunc
    fOnVideoFrame:TVideoFrameEvent;
    fOnVideoFrameRaw:TVideoFrameRawEvent;
    fhBitmapInfo:THandle;	// Handle della Bitmapinfo riempita da FillBitmapInfo
    fBitmapInfoUp:boolean;	// true se fhBitmapInfo è aggiornata (serve a FillBitmapInfo)
    fConnected:boolean;	// true se connesso al driver
    fOnJob:TIEJobEvent;
    fHDrawDib:HDRAWDIB;
    // per registrazione
    fRecFileName:string;	// nome file destinazione
    fRecFrameRate:integer; // frames per secondo (dwRequestMicroSecPerFrame)
	 fRecAudio:boolean;		// true cattura audio (fCaptureAudio)
    fRecMultitask:boolean; // false disabilita multitasking (fYeld) [ESC=abort]
    fRecording:boolean;	// true se in registrazione
  protected
    procedure SetCapture(v:boolean);
    procedure DriverConnect;
    function DriverConnectNE:boolean;
    procedure DriverDisconnect;
    procedure FillDrivers;
    procedure SetVideoSource(v:integer);
    function GetHasDlgVideoSource:boolean;
    function GetHasDlgVideoFormat:boolean;
    function GetHasDlgVideoDisplay:boolean;
    function GetHasOverlay:boolean;
    procedure GetCaps(var fDriverCaps:TCAPDRIVERCAPS);
    procedure SetPreviewRate(v:integer);
    procedure SetCallBackFrame(v:boolean);
    procedure SetOnVideoFrame(v:TVideoFrameEvent);
    procedure SetOnVideoFrameRaw(v:TVideoFrameRawEvent);
    function FillBitmapInfo:boolean;
    procedure CreateCaptureWindow;
    procedure DestroyCaptureWindow;
    procedure DoJob(job:TIEJob; per:integer);
	 procedure DecompRawFrame(OutBitmap:TBitmap; pix:pointer);
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    property Capture:boolean read fCapture write SetCapture default false;
    function DoConfigureSource:boolean;
    function DoConfigureFormat:boolean;
    function DoConfigureDisplay:boolean;
    function DoConfigureCompression:boolean;
    property VideoSourceList:TStringList read fDrivers;
    property HasOverlay:boolean read GetHasOverlay;
    property HasDlgVideoSource:boolean read GetHasDlgVideoSource;
    property HasDlgVideoFormat:boolean read GetHasDlgVideoFormat;
    property HasDlgVideoDisplay:boolean read GetHasDlgVideoDisplay;
    procedure StartRecord;
    procedure StopRecord;
    property RecFileName:string read fRecFileName write fRecFileName;
    property RecFrameRate:integer read fRecFrameRate write fRecFrameRate;
	 property RecAudio:boolean read fRecAudio write fRecAudio;
    property RecMultitask:boolean read fRecMultitask write fRecMultitask;
    property WndCaptureHandle:HWND read fWndC;
    // Formato video
    function GetVideoSize:TRect;
  published
    property VideoSource:integer read fVideoSource write SetVideoSource default 0;
    property PreviewRate:integer read fPreviewRate write SetPreviewRate default 60;
    property OnVideoFrame:TVideoFrameEvent read fOnVideoFrame write SetOnVideoFrame;
    property OnVideoFrameRaw:TVideoFrameRawEvent read fOnVideoFrameRaw write SetOnVideoFrameRaw;
    property OnJob:TIEJobEvent read fOnJob write fOnJob;
  end;

implementation

uses IEUtils;


const

	DLL = 'AVICAP32.DLL';

   // VIDEOCAP CONSTS
   WM_CAP_START = WM_USER;
   WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
   WM_CAP_SEQUENCE = WM_CAP_START + 62;
   WM_CAP_STOP = WM_CAP_START + 68;
   WM_CAP_FILE_SET_CAPTURE_FILE = WM_CAP_START + 20;
   WM_CAP_SETPREVIEW = WM_CAP_START + 50;
   WM_CAP_SETPREVIEWRATE = WM_CAP_START + 52;
   WM_CAP_SETOVERLAY = WM_CAP_START + 51;
   WM_CAP_SET_SCALE = WM_CAP_START + 53;
   WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
   WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
   WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;
   WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41;
   WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42;
   WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43;
   WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14;
   WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44;
   WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45;
	WM_CAP_DRIVER_GET_NAME = WM_CAP_START + 12;
   WM_CAP_SET_SEQUENCE_SETUP = WM_CAP_START + 64;
   WM_CAP_GET_SEQUENCE_SETUP = WM_CAP_START + 65;
   WM_CAP_DLG_VIDEOCOMPRESSION = WM_CAP_START + 46;
   WM_CAP_FILE_SAVEDIB = WM_CAP_START+  25;
   WM_CAP_EDIT_COPY = WM_CAP_START+  30;
   WM_CAP_SET_USER_DATA = WM_CAP_START+  9;
   WM_CAP_GET_USER_DATA = WM_CAP_START+  8;
   WM_CAP_SEQUENCE_NOFILE = WM_CAP_START+ 63;
   WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START+ 6;
   WM_CAP_SET_CALLBACK_YIELD = WM_CAP_START+ 4;


// AVICAP
function capCreateCaptureWindowA(lpszWindowName:pchar; dwStyle:dword; x,y,nWidth,nHeight:integer; hwndParent:HWND; nID:integer):HWND; stdcall; external DLL;
function capGetDriverDescriptionA(wDriverIndex:WORD; lpszName:pchar; cnName:integer; lpszVer:pchar; cbVer:integer):longbool; stdcall; external DLL;

function CallBackFrameFunc(hWnd:HWND; lpVHdr:PVIDEOHDR):LRESULT; stdcall; forward;
//function CallBackYeldFunc(hWnd:HWND):LRESULT; stdcall; forward;

/////////////////////////////////////////////////////////////////////////////////////
constructor TImageEnVideoCap.Create(Owner: TComponent);
begin
	inherited Create(Owner);
   //
   fCallBackFrame:=false;
   fDrivers:=TStringList.Create;
   fPreviewRate:=60;
   fVideoSource:=0;
   FillDrivers;
   fWndC:=0;
   fCapture:=false;
   fOnVideoFrame:=nil;
   fhBitmapInfo:=GlobalAlloc(GHND,sizeof(TBITMAPINFO)+sizeof(TRGBQUAD)*256);
   fConnected:=false;
   fBitmapInfoUp:=false;
   fRecFileName:='Capture.avi';
   fRecFrameRate:=15;	// 15 frames per second (dwRequestMicroSecPerFrame=66667)
   fRecAudio:=false;
   fRecMultitask:=true;
   fRecording:=false;
   fOnJob:=nil;
  	fHDrawDib:=DrawDibOpen;
end;

/////////////////////////////////////////////////////////////////////////////////////
destructor TImageEnVideoCap.Destroy;
begin
	fDrivers.free;
   DestroyCaptureWindow;
 	GlobalFree(fhBitmapInfo);
   DrawDibClose(fHDrawDib);
   //
   inherited;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.FillDrivers;
var
	DeviceName:array [0..79] of char;
   DeviceVersion:array [0..79] of char;
   q:integer;
begin
	fDrivers.Clear;
	for q:=0 to 9 do
   	if capGetDriverDescriptionA(q,DeviceName,80,DeviceVersion,80) then
			fDrivers.Add(string(DeviceName)+' '+string(DeviceVersion));
end;

/////////////////////////////////////////////////////////////////////////////////////
// - Se il driver è occupato genera l'eccezione TVideoCapException.
procedure TImageEnVideoCap.SetCapture(v:boolean);
var
	cp:TCAPTUREPARMS;
begin
	if fWndC=0 then
   	CreateCaptureWindow;
	if v then begin
   	// VISUALIZZA VIDEO INPUT
      fCapture:=true;
   	if fWndC<>0 then begin
      	if not fConnected then
	      	DriverConnect;
		   SendMessage(fWndC,WM_CAP_SET_SCALE,1,0);
         SendMessage(fWndC,WM_CAP_SET_USER_DATA,0,integer(pointer(self)));
			//
         //SendMessage(fWndC,WM_CAP_SETPREVIEWRATE,fPreviewRate,0);
         //SendMessage(fWndC,WM_CAP_SETPREVIEW,1,0);
         //
			SendMessage(fWndC,WM_CAP_GET_SEQUENCE_SETUP,sizeof(cp),integer(@cp));
		   cp.fYield:=true;
		   cp.fCaptureAudio:=false;
		   cp.dwRequestMicroSecPerFrame:=round( (1/fRecFrameRate)*1000000 );
         cp.wPercentDropForError:=100;
         cp.fAbortLeftMouse:=false;
         cp.fAbortRightMouse:=false;
         cp.fLimitEnabled:=false;
		   SendMessage(fWndC,WM_CAP_SET_SEQUENCE_SETUP,sizeof(cp),integer(@cp));
         SetCallBackFrame(fCallBackFrame);
			SendMessage(fWndC,WM_CAP_SEQUENCE_NOFILE,0,0);
      end;
   end else begin
   	// NASCONDE VIDEO INPUT
      SendMessage(fWndC,WM_CAP_STOP,0,0);
      SendMessage(fWndC,WM_CAP_SET_USER_DATA,0,0);
      DriverDisconnect;
      fCapture:=false;
	end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// Assegna fWndC
// nota: prima di chiamare questa funzione assicurarsi che fWndC sia ZERO
procedure TImageEnVideoCap.CreateCaptureWindow;
begin
   fWndC:=capCreateCaptureWindowA(pchar(name),WS_CHILD,0,0,50,50,IEFindHandle(self),0);
   if fCapture then
      SetCapture(true);	// qui richiama anche SetDisplayMode
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.DestroyCaptureWindow;
begin
   if fWndC<>0 then begin
      SendMessage(fWndC,WM_CAP_SET_USER_DATA,0,0);
		Capture:=false;
	   DestroyWindow(fWndC);
      fWndC:=0;
   end;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.DriverDisconnect;
begin
	SendMessage(fWndC,WM_CAP_DRIVER_DISCONNECT,0,0);
   fConnected:=false;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.SetVideoSource(v:integer);
begin
	fVideoSource:=v;
   if fCapture then begin
    	SetCapture(false);
      SetCapture(true);
   end;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.DriverConnect;
begin
	if fWndC=0 then
   	CreateCaptureWindow;
	DoJob(iejVIDEOCAP_CONNECTING,0);
	if SendMessage(fWndC,WM_CAP_DRIVER_CONNECT,fVideoSource,0)=0 then
		raise TVideoCapException.Create('Unable to open video capture driver');
   fConnected:=true;
   fBitmapInfoUp:=false;
   FillBitmapInfo;
   DoJob(iejNOTHING,0);
end;

/////////////////////////////////////////////////////////////////////////////////////
// Come DriverConnect, ma rest. false se la connessione fallisce
function TImageEnVideoCap.DriverConnectNE:boolean;
begin
	result:=SendMessage(fWndC,WM_CAP_DRIVER_CONNECT,fVideoSource,0)<>0;
   fConnected:=result;
end;

/////////////////////////////////////////////////////////////////////////////////////
function TImageEnVideoCap.GetHasDlgVideoSource:boolean;
var
    fDriverCaps:TCAPDRIVERCAPS;
begin
	GetCaps(fDriverCaps);
	result:=fDriverCaps.fHasDlgVideoSource;
end;

/////////////////////////////////////////////////////////////////////////////////////
function TImageEnVideoCap.GetHasDlgVideoFormat:boolean;
var
    fDriverCaps:TCAPDRIVERCAPS;
begin
	GetCaps(fDriverCaps);
	result:=fDriverCaps.fHasDlgVideoFormat;
end;

/////////////////////////////////////////////////////////////////////////////////////
function TImageEnVideoCap.GetHasDlgVideoDisplay:boolean;
var
    fDriverCaps:TCAPDRIVERCAPS;
begin
	GetCaps(fDriverCaps);
	result:=fDriverCaps.fHasDlgVideoDisplay;
end;

/////////////////////////////////////////////////////////////////////////////////////
function TImageEnVideoCap.GetHasOverlay:boolean;
var
    fDriverCaps:TCAPDRIVERCAPS;
begin
	GetCaps(fDriverCaps);
	result:=fDriverCaps.fHasOverlay;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.GetCaps(var fDriverCaps:TCAPDRIVERCAPS);
var
	lcon:boolean;
begin
	lcon:=fConnected;
	if not fConnected then DriverConnect;
	SendMessage(fWndC,WM_CAP_DRIVER_GET_CAPS,sizeof(TCAPDRIVERCAPS),integer(@fDriverCaps));
   if not lcon then DriverDisconnect;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.SetPreviewRate(v:integer);
begin
	fPreviewRate:=v;
   if fConnected then
	   SendMessage(fWndC,WM_CAP_SETPREVIEWRATE,fPreviewRate,0);
end;

/////////////////////////////////////////////////////////////////////////////////////
// Se ci sono errori genera l'eccezione TVideoCapException
procedure TImageEnVideoCap.StartRecord;
var
	cp:TCAPTUREPARMS;
begin
	if fRecording then exit;
	SendMessage(fWndC,WM_CAP_GET_SEQUENCE_SETUP,sizeof(cp),integer(@cp));
   cp.fYield:=fRecMultitask;
   cp.fCaptureAudio:=fRecAudio;
   cp.dwRequestMicroSecPerFrame:=round( (1/fRecFrameRate)*1000000 );
   SendMessage(fWndC,WM_CAP_SET_SEQUENCE_SETUP,sizeof(cp),integer(@cp));
	if SendMessage(fWndC,WM_CAP_FILE_SET_CAPTURE_FILE,0,integer(pchar(fRecFileName)))=0 then
   	raise TVideoCapException.Create('Unable to create AVI file');
   if SendMessage(fWndC,WM_CAP_SEQUENCE,0,0)=0 then
		raise TVideoCapException.Create('Unable to start video recording');
   fRecording:=true;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.StopRecord;
begin
	if not fRecording then exit;
	SendMessage(fWndC,WM_CAP_STOP,0,0);
   fRecording:=false;
end;

/////////////////////////////////////////////////////////////////////////////////////
function TImageEnVideoCap.DoConfigureSource:boolean;
var
	lcon:boolean;
begin
	lcon:=fConnected;
   result:=fConnected;
	if not fConnected then
   	result:=DriverConnectNE;
   if result then begin
		result:=SendMessage(fWndC,WM_CAP_DLG_VIDEOSOURCE,0,0)<>0;
      fBitmapInfoUp:=false;
      FillBitmapInfo;
	   if not lcon then
      	DriverDisconnect
   end;
end;

/////////////////////////////////////////////////////////////////////////////////////
function TImageEnVideoCap.DoConfigureFormat:boolean;
var
	lcon:boolean;
begin
	lcon:=fConnected;
   result:=fConnected;
	if not fConnected then
   	result:=DriverConnectNE;
   if result then begin
		result:=SendMessage(fWndC,WM_CAP_DLG_VIDEOFORMAT,0,0)<>0;
		fBitmapInfoUp:=false;
      FillBitmapInfo;
	   if not lcon then
      	DriverDisconnect
   end;
end;

/////////////////////////////////////////////////////////////////////////////////////
function TImageEnVideoCap.DoConfigureDisplay:boolean;
var
	lcon:boolean;
begin
	lcon:=fConnected;
   result:=fConnected;
	if not fConnected then
   	result:=DriverConnectNE;
   if result then begin
		result:=SendMessage(fWndC,WM_CAP_DLG_VIDEODISPLAY,0,0)<>0;
      fBitmapInfoUp:=false;
      FillBitmapInfo;
	   if not lcon then
      	DriverDisconnect
   end;
end;

/////////////////////////////////////////////////////////////////////////////////////
function TImageEnVideoCap.FillBitmapInfo:boolean;
var
	sz:integer;
   pt:PBITMAPINFO;
	lcon:boolean;
begin
	if not fBitmapInfoUp then begin
      lcon:=fConnected;
      result:=fConnected;
      if not fConnected then
         result:=DriverConnectNE;
      if result then begin
         GlobalFree(fhBitmapInfo);
         sz:=SendMessage(fWndC,WM_CAP_GET_VIDEOFORMAT,0,0);	// get size
         fhBitmapInfo:=GlobalAlloc(GHND,IMAX(sizeof(TBITMAPINFO)+sizeof(TRGBQUAD)*256,sz));
         pt:=GlobalLock(fhBitmapInfo);
         SendMessage(fWndC,WM_CAP_GET_VIDEOFORMAT,sz,integer(pt));
         GlobalUnLock(fhBitmapInfo);
         if not lcon then
            DriverDisconnect;
      end;
      fBitmapInfoUp:=true;
   end else
   	result:=true;
end;

/////////////////////////////////////////////////////////////////////////////////////
// Rest. dimensioni dell'input video
function TImageEnVideoCap.GetVideoSize:TRect;
var
   pt:PBITMAPINFO;
begin
	if fWndC=0 then
   	CreateCaptureWindow;
	FillBitmapInfo;
	with result do begin
   	Left:=0;
      Top:=0;
		pt:=GlobalLock(fhBitmapInfo);
      Right:=pt^.bmiHeader.biWidth-1;
      Bottom:=pt^.bmiHeader.biHeight-1;
  	   GlobalUnLock(fhBitmapInfo);
   end;
end;

/////////////////////////////////////////////////////////////////////////////////////
// Attiva/disattiva chiamata funzione CallBackFrameFunc()
procedure TImageEnVideoCap.SetCallBackFrame(v:boolean);
begin
	fCallBackFrame:=v;
   if fConnected then begin
   	// attiva/disattiva "al volo"
		if v then begin
	   	SendMessage(fWndC,WM_CAP_SET_CALLBACK_VIDEOSTREAM,0,integer(@CallBackFrameFunc));
      end else begin
			SendMessage(fWndC,WM_CAP_SET_CALLBACK_VIDEOSTREAM,0,0);
      end;
	end;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.SetOnVideoFrame(v:TVideoFrameEvent);
begin
	fOnVideoFrame:=v;
   SetCallBackFrame( assigned(fOnVideoFrame) or assigned(fOnVideoFrameRaw) );
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.SetOnVideoFrameRaw(v:TVideoFrameRawEvent);
begin
	fOnVideoFrameRaw:=v;
   SetCallBackFrame( assigned(fOnVideoFrame) or assigned(fOnVideoFrameRaw) );
end;

/////////////////////////////////////////////////////////////////////////////////////
// Decompress raw frame
// OutBitmap has to be created
procedure TImageEnVideoCap.DecompRawFrame(OutBitmap:TBitmap; pix:pointer);
var
   pbi:PBITMAPINFOHEADER;
begin
   pbi:=GlobalLock(fhBitmapInfo);
   OutBitmap.Width:=1; OutBitmap.Height:=1;
   if pbi^.biBitCount=1 then
      OutBitmap.PixelFormat:=pf1bit
   else
      OutBitmap.PixelFormat:=pf24bit;
   OutBitmap.Width:=pbi^.biWidth;
   OutBitmap.Height:=pbi^.biHeight;
   DrawDibDraw(fHDrawDib,OutBitmap.Canvas.Handle,0,0,OutBitmap.Width,OutBitmap.Height,
               pbi^,pix,0,0,OutBitmap.Width,OutBitmap.Height,0);
   GlobalUnLock(fhBitmapInfo);
end;

/////////////////////////////////////////////////////////////////////////////////////
// Funzione callback frame
(*
/* dwFlags field of VIDEOHDR */
#define VHDR_DONE      0x00000001  /* Done bit */
#define VHDR_PREPARED  0x00000002  /* Set if this header has been prepared */
#define VHDR_INQUEUE    0x00000004  /* Reserved for driver */
#define VHDR_KEYFRAME  0x00000008  /* Key Frame */
*)
function CallBackFrameFunc(hWnd:HWND; lpVHdr:PVIDEOHDR):LRESULT;
var
	xBitmap:TBitmap;
   pobj:pointer;
   obj:TImageEnVideoCap;
begin
	result:=0;
	if (lpVHdr^.dwFlags and 1=0) or (lpVHdr^.dwFlags and 2=0) then
   	exit;  
   pobj:=pointer(SendMessage(hWnd,WM_CAP_GET_USER_DATA,0,0));
   if assigned(pobj) then begin
      obj:=pobj;
      with obj do begin
         if assigned(fOnVideoFrame) then begin
            xBitmap:=TBitmap.Create;
            DecompRawFrame(xBitmap,lpVHdr^.lpData);
            fOnVideoFrame(obj,xBitmap);
            xBitmap.free;
         end;
         if assigned(fOnVideoFrameRaw) then
            fOnVideoFrameRaw(obj,fhBitmapInfo,lpVHdr^.lpData);
      end;
   end;
end;

/////////////////////////////////////////////////////////////////////////////////////
function TImageEnVideoCap.DoConfigureCompression:boolean;
var
	lcon:boolean;
begin
	lcon:=fConnected;
   result:=fConnected;
	if not fConnected then
   	result:=DriverConnectNE;
   if result then begin
		result:=SendMessage(fWndC,WM_CAP_DLG_VIDEOCOMPRESSION,0,0)<>0;
      fBitmapInfoUp:=false;
      FillBitmapInfo;
	   if not lcon then
      	DriverDisconnect
   end;
end;

/////////////////////////////////////////////////////////////////////////////////////
procedure TImageEnVideoCap.DoJob(job:TIEJob; per:integer);
begin
	if assigned(fOnJob) then
   	fOnJob(self,job,per);
end;

end.
