2011. január 7., péntek

TCapture (Image Capture Class)

Problem/Question/Abstract:

Capture Class

Answer:

Download complete code example:
http://web.vip.hr/inga.vip/tcap.zip

unit vCap;


//TCAPTURE BY VANJA FUCKAR,EMAIL:INGA@VIP.HR,free source code
interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;





type
CAPDRIVERCAPS=record
wDeviceIndex:cardinal;
fHasOverlay,
fHasDlgVideoSource,
fHasDlgVideoFormat,
fHasDlgVideoDisplay,
fCaptureInitialized,
fDriverSuppliesPalettes:longbool;
hVideoIn,
hVideoOut,
hVideoExtIn,
hVideoExtOut:Cardinal;
end;
pCAPDRIVERCAPS=^CAPDRIVERCAPS;

type
CAPSTATUS=record
uiImageWidth,
uiImageHeight:cardinal;
fLiveWindow,
fOverlayWindow,
fScale:longbool;
ptScroll:TPoint;
fUsingDefaultPalette,
fAudioHardware,
fCapFileExists:longbool;
dwCurrentVideoFrame,
dwCurrentVideoFramesDropped,
dwCurrentWaveSamples,
dwCurrentTimeElapsedMS,
hPalCurrent:cardinal;
fCapturingNow:longbool;
dwReturn,
wNumVideoAllocated,
wNumAudioAllocated:cardinal;
end;
pCAPSTATUS=^CAPSTATUS;


type WAVEFORMATEX=record
wFormatTag,
nChannels:word;
nSamplesPerSec,
nAvgBytesPerSec:cardinal;
nBlockAlign,
wBitsPerSample,
cbSize:dword;
end;
pWAVEFORMATEX=^WAVEFORMATEX;

type CAPINFOCHUNK=record
fccInfoID:cardinal;
lpData:pointer;
cbDataLen:cardinal;
end;
pCAPINFOCHUNK=^CAPINFOCHUNK;

type  CAPTUREPARMS=record
dwRequestMicroSecPerFrame:cardinal;
fMakeUserHitOKToCapture:longbool;
wPercentDropForError:cardinal;
fYield:longbool;
dwIndexSize,
wChunkGranularity:cardinal;
fUsingDOSMemory:longbool;
wNumVideoRequested:cardinal;
fCaptureAudio:longbool;
wNumAudioRequested,
vKeyAbort:cardinal;
fAbortLeftMouse,
fAbortRightMouse,
fLimitEnabled:longbool;
wTimeLimit:cardinal;
fMCIControl,
fStepMCIDevice:longbool;
dwMCIStartTime,
dwMCIStopTime:cardinal;
fStepCaptureAt2x:longbool;
wStepCaptureAverageFrames:cardinal;
dwAudioBufferSize:cardinal;
fDisableWriteCache:longbool;
AVStreamMaster:cardinal;
end;
pCAPTUREPARMS=^CAPTUREPARMS;

type  VIDEOHDR=record
lpData:pointer;
dwBufferLength,
dwBytesUsed,
dwTimeCaptured,
dwUser,
dwFlags:cardinal;
dwReserved:array [0..3] of cardinal;
end;
pVIDEOHDR=^VIDEOHDR;

// VIDEOHEADER:dwFlags:
const VHDR_DONE=1 ;  //Done
const VHDR_PREPARED =2 ;//Set if this header has been prepared
const VHDR_INQUEUE =4 ; // Reserved for driver
const VHDR_KEYFRAME = 8 ;//Key Frame

//Control Callback states:
const CONTROLCALLBACK_PREROLL =        1 ; //* Waiting to start capture */
const CONTROLCALLBACK_CAPTURING =      2 ;//* Now capturing */

type WAVEHDR=record
lpData:pointer;
dwBufferLength,
dwBytesRecorded,
dwUser,
dwFlags,
dwLoops:cardinal;
lpNext:pointer;
reserved:cardinal;
end;
pWAVEHDR=^WAVEHDR;

//WAVEHEADER:dwFlags:
const WHDR_DONE =1  ;//* done bit */
const WHDR_PREPARED =2  ;//* set if this header has been prepared */
const WHDR_BEGINLOOP=4  ;//* loop start block */
const WHDR_ENDLOOP =8  ;//* loop end block */
const WHDR_INQUEUE=16   ;//  /* reserved for driver */




function VideoStreamCallback(Hwnd:cardinal;vHeader:pVIDEOHDR):cardinal; stdcall;
function FrameCallback(Hwnd:cardinal;vHeader:pVIDEOHDR):cardinal; stdcall;
function CapControlCallback (Hwnd,nState:cardinal):Cardinal;stdcall;
function ErrorCallback (Hwnd,nId:Cardinal;nDescription:pansichar):cardinal;stdcall;
function StatusCallback (Hwnd,nId:Cardinal;nDescription:pansichar):cardinal;stdcall;
function YieldCallback (Hwnd:Cardinal):cardinal;stdcall;
function AudioStreamCallback(Hwnd:cardinal;aHeader:pWAVEHDR):cardinal; stdcall;

function capCreateCaptureWindowA(windowname:pansichar;dwstyle,
x,y,cx,cy,parentHwnd,nId:cardinal):cardinal;stdcall;external 'avicap32.dll';

function capGetDriverDescriptionA(DrvIndex:cardinal;
Name:pansichar;NameLen:cardinal;Description:pansichar;DescLen:cardinal):cardinal;stdcall;external 'avicap32.dll';

const WM_CAP_START =WM_USER ;
const WM_CAP_GET_CAPSTREAMPTR  =       (WM_CAP_START+  1) ;

const WM_CAP_SET_CALLBACK_ERRORA  =   (WM_CAP_START+  2) ;
const WM_CAP_SET_CALLBACK_STATUSA  =  (WM_CAP_START+  3) ;

const WM_CAP_SET_CALLBACK_YIELD =      (WM_CAP_START+  4) ;
const WM_CAP_SET_CALLBACK_FRAME =      (WM_CAP_START+  5) ;
const WM_CAP_SET_CALLBACK_VIDEOSTREAM  =(WM_CAP_START+  6) ;
const WM_CAP_SET_CALLBACK_WAVESTREAM = (WM_CAP_START+  7) ;
const WM_CAP_GET_USER_DATA = (WM_CAP_START+  8) ;
const WM_CAP_SET_USER_DATA = (WM_CAP_START+  9) ;


const WM_CAP_FILE_ALLOCATE =           (WM_CAP_START+  22);
const WM_CAP_FILE_SET_INFOCHUNK =      (WM_CAP_START+  24);


const WM_CAP_DRIVER_CONNECT =(WM_CAP_START+  10);
const WM_CAP_DRIVER_DISCONNECT=(WM_CAP_START+  11);
const WM_CAP_DRIVER_GET_NAMEA=(WM_CAP_START+  12);
const WM_CAP_DRIVER_GET_VERSIONA =(WM_CAP_START+  13);
const WM_CAP_DRIVER_GET_CAPS=(WM_CAP_START+  14);

const WM_CAP_FILE_SET_CAPTURE_FILEA = (WM_CAP_START+  20);
const WM_CAP_FILE_GET_CAPTURE_FILEA= (WM_CAP_START+  21);
const WM_CAP_FILE_SAVEASA =            (WM_CAP_START+  23) ;
const WM_CAP_FILE_SAVEDIBA =          (WM_CAP_START+  25) ;


const WM_CAP_EDIT_COPY =               (WM_CAP_START+  30) ;
const WM_CAP_SET_AUDIOFORMAT =         (WM_CAP_START+  35) ;
const WM_CAP_GET_AUDIOFORMAT =         (WM_CAP_START+  36) ;


const WM_CAP_GET_VIDEOFORMAT  =        (WM_CAP_START+  44) ;
const WM_CAP_SET_VIDEOFORMAT  =        (WM_CAP_START+  45) ;


const WM_CAP_DLG_VIDEOFORMAT=          (WM_CAP_START+  41);
const WM_CAP_DLG_VIDEOSOURCE=          (WM_CAP_START+  42);
const WM_CAP_DLG_VIDEODISPLAY=         (WM_CAP_START+  43);
const WM_CAP_DLG_VIDEOCOMPRESSION =   (WM_CAP_START+  46) ;

const WM_CAP_SET_PREVIEW=(WM_CAP_START+  50);
const WM_CAP_SET_OVERLAY= (WM_CAP_START+  51);
const WM_CAP_SET_PREVIEWRATE =(WM_CAP_START+  52);
const WM_CAP_SET_SCALE =               (WM_CAP_START+  53);
const WM_CAP_GET_STATUS =              (WM_CAP_START+  54);
const WM_CAP_SET_SCROLL  =             (WM_CAP_START+  55) ;

const WM_CAP_GRAB_FRAME =              (WM_CAP_START+  60);
const WM_CAP_GRAB_FRAME_NOSTOP =       (WM_CAP_START+  61) ;

const WM_CAP_SEQUENCE  =               (WM_CAP_START+  62) ;
const WM_CAP_SEQUENCE_NOFILE =         (WM_CAP_START+  63) ;
const WM_CAP_SET_SEQUENCE_SETUP =      (WM_CAP_START+  64) ;
const WM_CAP_GET_SEQUENCE_SETUP =      (WM_CAP_START+  65) ;

const WM_CAP_STOP =                    (WM_CAP_START+  68)  ;
const WM_CAP_ABORT =                   (WM_CAP_START+  69)  ;

const WM_CAP_SET_MCI_DEVICEA =        (WM_CAP_START+  66);
const WM_CAP_GET_MCI_DEVICEA =        (WM_CAP_START+  67);

const WM_CAP_SINGLE_FRAME_OPEN =       (WM_CAP_START+  70) ;
const WM_CAP_SINGLE_FRAME_CLOSE =      (WM_CAP_START+  71) ;
const WM_CAP_SINGLE_FRAME  =           (WM_CAP_START+  72) ;

const WM_CAP_PAL_OPENA  =             (WM_CAP_START+  80) ;
const WM_CAP_PAL_SAVEA  =             (WM_CAP_START+  81);
const WM_CAP_PAL_PASTE  =              (WM_CAP_START+  82) ;
const WM_CAP_PAL_AUTOCREATE =          (WM_CAP_START+  83) ;
const WM_CAP_PAL_MANUALCREATE  =       (WM_CAP_START+  84) ;
const WM_CAP_SET_CALLBACK_CAPCONTROL = (WM_CAP_START+  85) ;

type
TCapturedStringList=array [0..9] of string;

type TCapture=class;

Callback_Video=procedure (AOwner:TCapture;vHeader:pVIDEOHDR) of object;
Callback_Control=function (AOwner:TCapture;nState:cardinal):longbool of object;
Callback_Error_Status=procedure (AOwner:TCapture;nId:Cardinal;nDescription:pansichar) of object;
Callback_Yield=procedure (AOwner:TCapture) of object;
Callback_Audio=procedure (AOwner:TCapture;aHeader:pWAVEHDR) of object;


TCapture=class
private
wParentW:cardinal;
wX,wY,wCX,wCY:cardinal;
wStyle:cardinal;
wName:string;
wHandle:cardinal;
wRate:cardinal;
wPrev:longbool;
wIdx:cardinal;
wScale:longbool;
wOverlay:longbool;
wAlloc:cardinal;
wSingleFrm:longbool;


cbVideoStream:Callback_Video;
cbFrame:Callback_Video;
cbCapCtrl:Callback_Control;
cbError:Callback_Error_Status;
cbStatus:Callback_Error_Status;
cbYield:Callback_Yield;
cbAudioStream:Callback_Audio;


protected
procedure SetPreview (sPrev:longbool);
procedure SetScale (sScale:longbool);
procedure SetOverlay (sOverlay:longbool);
procedure SetName (const sName:string);
procedure SetCapFile (const sName:string);
function GetCapFile:string;
procedure SetX (X:cardinal);
procedure SetY (Y:cardinal);
procedure SetCX (CX:cardinal);
procedure SetCY (CY:cardinal);
procedure BoundWindow;
procedure SetAllocFile(sLen:cardinal);
procedure SetSingleFrame(sFrame:longbool);
procedure SetMCIDev(const devName:string);
function GetMCIDev:string;
procedure SetUsr(uData:cardinal);
function  GetUsr:cardinal;
function GetInit:longbool;

public
function CreateCaptureWindow(ParentHandle:cardinal):longbool;
procedure Show;
function Connect(index:cardinal):longbool;
function Disconnect:longbool;

function SetCaptureFileInfoChunk (const IC:CAPINFOCHUNK):longbool;
function SetPreviewRate(FrameRate:cardinal):longbool;
procedure Scroll (X,Y:cardinal); stdcall;

property Preview:longbool read wPrev write SetPreview;
property Scale:longbool read wScale write SetScale;
property Overlay:longbool read wOverlay write SetOverlay;
property SingleFrameCapture:longbool read wSingleFrm write SetSingleFrame;
property CaptureFilename:string read GetCapFile write SetCapFile;
property PreallocateCaptureFile:cardinal read wAlloc write SetAllocFile;
property MCIDevice:string read GetMCIDev write  SetMCIDev;
property UserData:cardinal read GetUsr write SetUsr;
property Initialized:longbool read GetInit;
procedure VideoSourceDialog;
procedure VideoDisplayDialog;
procedure VideoFormatDialog;
procedure VideoCompressionDialog;

//Video + Palette
function VideoBufferToClipboard:longbool;

function FrameToBitmapFile (const Filename:string):longbool;
function FrameStill:longbool;
function FrameToFrameBuffer:longbool;

function CaptureStartDisableSave:longbool;
function CaptureStart:longbool;
function CaptureStartSingleFrame:longbool;
function CaptureStop:longbool;
function CaptureAbort:longbool;

function PaletteFromClipboard:longbool;
function PaletteSave(const Filename:string):longbool;
function PaletteLoad (const Filename:string):longbool;
function PaletteAutoCreate(SampleFrames,nColors:cardinal):longbool;
function PaletteManualCreate (fGrab:longbool;nColors:cardinal):longbool;

class function GetIndexedCaptureDrivers (var Names,Descriptions:TCapturedStringList):longbool;

function GetCurrentCaptureDriver (var DriverName,DriverDescription:string) :longbool;
function GetCurrentIndexedDeviceCapabilities(var DevCap:CAPDRIVERCAPS):longbool;
function GetStatus (var Cap:CAPSTATUS):longbool;
function GetVideoFormat (var Bi:BITMAPINFO):longbool;
function SetVideoFormat (const Bi:BITMAPINFO):longbool;
function GetAudioFormat (var Ai:WAVEFORMATEX):longbool;
function SetAudioFormat (const Ai:WAVEFORMATEX):longbool;
function GetCaptureSettings (var Cs:CAPTUREPARMS):longbool;
function SetCaptureSettings (const Cs:CAPTUREPARMS):longbool;

destructor Destroy;

procedure SetWindowBound(X,Y,Width,Height:cardinal);
property X:cardinal read wX write SetX;
property Y:cardinal read wY write SetY;
property Width:cardinal read wCX write SetCx;
property Height:cardinal read wCY write SetCy;
property Handle:cardinal read wHandle;
property WindowName:string read wName write SetName;

property CallBackVideoStream:Callback_Video write cbVideoStream;
property CallBackFrame:Callback_Video write cbFrame;
property CallBackCaptureControl:Callback_Control write cbCapCtrl;
property CallBackError:Callback_Error_Status write cbError;
property CallBackStatus:Callback_Error_Status write cbStatus;
property CallBackYield:Callback_Yield write cbYield;
property CallBackAudioStream:callback_Audio write cbAudioStream;
end;








implementation

{ TCapture By Vanja Fuckar 8.2004,email ingavip.hr }

function TCapture.Connect(index:cardinal): longbool;
begin
result:= longbool(SendMessage (wHandle, WM_CAP_DRIVER_CONNECT, index, 0));
if result then wIdx:=index;
end;

function TCapture.Disconnect: longbool;
begin
result:= longbool(SendMessage (wHandle, WM_CAP_DRIVER_DISCONNECT, wIdx, 0));
end;

function TCapture.SetPreviewRate(FrameRate:cardinal):longbool;
begin
result:=longbool(SendMessage (wHandle, WM_CAP_SET_PREVIEWRATE, frameRate, 0));
if result then  wRate:=frameRate;
end;

function TCapture.CreateCaptureWindow(ParentHandle:cardinal):longbool;
begin
if WHandle=0 then begin
wParentW:=ParentHandle;
if wParentW<>0 then wStyle:=wStyle or WS_CHILD;
WHandle:=capCreateCaptureWindowA(pointer(wName),wStyle,wX,wY,wCx,wCy,wParentW,0);
result:=longbool(WHandle);
if result then begin
SetProp(WHandle,pansichar('OwnerObject'),integer(pointer(self)));
SendMessage (wHandle,WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, integer(addr(VideoStreamCallback)));
SendMessage (wHandle,WM_CAP_SET_CALLBACK_FRAME, 0, integer(addr(FrameCallback)));
SendMessage (wHandle,WM_CAP_SET_CALLBACK_CAPCONTROL, 0, integer(addr(CapControlCallback)));
SendMessage (wHandle,WM_CAP_SET_CALLBACK_ERRORA, 0, integer(addr(ErrorCallback)));
SendMessage (wHandle,WM_CAP_SET_CALLBACK_STATUSA, 0, integer(addr(StatusCallback)));
SendMessage (wHandle,WM_CAP_SET_CALLBACK_YIELD, 0, integer(addr(YieldCallback)));
SendMessage (wHandle,WM_CAP_SET_CALLBACK_WAVESTREAM, 0, integer(addr(AudioStreamCallback)));
end;
end;
end;

destructor TCapture.Destroy;
begin
if WHandle<>0 then begin
Disconnect;
RemoveProp(WHandle,pansichar('OwnerObject'));
DestroyWindow(WHandle);
WHandle:=0;
end;
end;



procedure TCapture.Show;
begin
ShowWindow(WHandle,1);
end;


//0 to 9 index!
class function TCapture. GetIndexedCaptureDrivers(var Names,
Descriptions: TCapturedStringList): longbool;
var
x:cardinal;
llen:cardinal;
begin
for x:=0 to 9 do begin
setlength(Names[x],256);
setlength(Descriptions[x],256);
capGetDriverDescriptionA(x,pointer(Names[x]),256,pointer(Descriptions[x]),256);
llen:=lstrlen(pointer(Names[x]));
setlength(Names[x],llen);
llen:=lstrlen(pointer(Descriptions[x]));
setlength(Descriptions[x],llen);
end;

end;

function TCapture.GetCurrentCaptureDriver (var DriverName,DriverDescription:string) :longbool;
var
lLen:cardinal;
begin
result:=false;
SetLength(DriverName,256);
SetLength(DriverDescription,256);
if 0= SendMessage (wHandle,WM_CAP_DRIVER_GET_NAMEA, 256, integer(pointer(result))) then exit;
llen:=lstrlen(pointer(DriverName));
setlength(DriverName,llen);
SendMessage (wHandle,WM_CAP_DRIVER_GET_VERSIONA , 256, integer(pointer(DriverDescription)));
llen:=lstrlen(pointer(DriverDescription));
setlength(DriverDescription,llen);
result:=true;
end;



procedure TCapture.VideoSourceDialog;
begin
SendMessage (wHandle,  WM_CAP_DLG_VIDEOSOURCE , 0, 0);
end;

procedure TCapture.VideoCompressionDialog;
begin
SendMessage (wHandle, WM_CAP_DLG_VIDEOCOMPRESSION , 0, 0);
end;

procedure TCapture.VideoDisplayDialog;
begin
SendMessage (wHandle,  WM_CAP_DLG_VIDEODISPLAY , 0, 0);
end;

procedure TCapture.VideoFormatDialog;
begin
SendMessage (wHandle,  WM_CAP_DLG_VIDEOFORMAT , 0, 0);
end;

function TCapture.GetCurrentIndexedDeviceCapabilities(var DevCap:CAPDRIVERCAPS): longbool;
begin
result:=longbool(SendMessage (wHandle,  WM_CAP_DRIVER_GET_CAPS , sizeof(CAPDRIVERCAPS), integer(addr(DevCap))));
end;


procedure TCapture.SetPreview(sPrev: longbool);
begin
wPrev:=sPrev;
SendMessage (wHandle, WM_CAP_SET_PREVIEW, integer(sPrev), 0);
end;

procedure TCapture.SetScale(sScale: longbool);
begin
wScale:=sScale;
SendMessage (wHandle,WM_CAP_SET_SCALE , integer(sScale), 0);
end;

procedure TCapture.SetOverlay(sOverlay: longbool);
begin
wOverlay:=sOverlay;
SendMessage (wHandle,WM_CAP_SET_OVERLAY, integer(sOverlay), 0);
end;

procedure TCapture.SetName(const sName: string);
begin
wName:=sName;
if wHandle<>0 then SetWindowText(wHandle,pointer(sName));
end;

procedure TCapture.SetCapFile(const sName: string);
begin
SendMessage (wHandle,WM_CAP_FILE_SET_CAPTURE_FILEA, 0, integer(pointer(sName)));
end;

function  TCapture.GetCapFile:string;
var
lLen:cardinal;
begin
setlength(result,1024);
SendMessage (wHandle,WM_CAP_FILE_GET_CAPTURE_FILEA, 1024, integer(pointer(result)));
llen:=lstrlen(pointer(result));
setlength(result,llen);
end;

procedure TCapture.SetCX(CX: cardinal);
begin
wCX:=CX;
BoundWindow;
end;

procedure TCapture.SetCY(CY: cardinal);
begin
wCY:=CY;
BoundWindow;
end;

procedure TCapture.SetX(X: cardinal);
begin
wX:=X;
BoundWindow;
end;

procedure TCapture.SetY(Y: cardinal);
begin
wY:=Y;
BoundWindow;
end;

procedure TCapture.BoundWindow;
begin
SetWindowPos(wHandle,0,wX,wY,wCx,wCy,SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOZORDER);
end;

procedure TCapture.SetWindowBound(X, Y, Width, Height: cardinal);
begin
wX:=x;wY:=y;wCx:=Width;wCy:=Height;
BoundWindow;
end;

procedure TCapture.SetAllocFile(sLen: cardinal);
begin
if 0<>SendMessage (wHandle,WM_CAP_FILE_ALLOCATE,0, sLen) then  wAlloc:=sLen;
end;


function TCapture.GetStatus(var Cap: CAPSTATUS): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_GET_STATUS, sizeof(CAPSTATUS), integer(addr(Cap))));
end;

function TCapture.GetVideoFormat(var Bi: BITMAPINFO): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_GET_VIDEOFORMAT, sizeof(BITMAPINFO), integer(addr(Bi))));
end;

function TCapture.SetVideoFormat(const Bi: BITMAPINFO): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_SET_VIDEOFORMAT, sizeof(BITMAPINFO), integer(addr(Bi))));
end;

function TCapture.GetAudioFormat(var Ai: WAVEFORMATEX): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_GET_AUDIOFORMAT, sizeof(WAVEFORMATEX), integer(addr(Ai))));
end;

function TCapture.SetAudioFormat(const Ai: WAVEFORMATEX): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_SET_AUDIOFORMAT, sizeof(WAVEFORMATEX), integer(addr(Ai))));
end;

procedure TCapture.Scroll(X,Y:cardinal);
begin
SendMessage (wHandle,WM_CAP_SET_SCROLL, 0, integer(addr(X)));
end;

function TCapture.SetCaptureFileInfoChunk(const IC: CAPINFOCHUNK):longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_FILE_SET_INFOCHUNK, 0,integer(addr(IC))));
end;

function TCapture.GetCaptureSettings(var Cs: CAPTUREPARMS): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_GET_SEQUENCE_SETUP, sizeof(CAPTUREPARMS), integer(addr(Cs))));
end;

function TCapture.SetCaptureSettings(const Cs: CAPTUREPARMS): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_SET_SEQUENCE_SETUP, sizeof(CAPTUREPARMS), integer(addr(Cs))));
end;



function TCapture.CaptureStart: longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_SEQUENCE,0,0));
end;

function TCapture.CaptureAbort: longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_STOP,0,0));
end;

function TCapture.CaptureStop: longbool;
begin
result:=longbool(SendMessage (wHandle, WM_CAP_ABORT,0,0));
end;

function TCapture.CaptureStartDisableSave: longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_SEQUENCE_NOFILE,0,0));
end;


function VideoStreamCallback(Hwnd:cardinal;vHeader:pVIDEOHDR):cardinal; stdcall;
var
owner:TCapture;
begin
owner:=TCapture(GetProp(hwnd,pansichar('OwnerObject')));
if assigned(owner.cbVideoStream) then owner.cbVideoStream(owner,vHeader);
end;

function FrameCallback(Hwnd:cardinal;vHeader:pVIDEOHDR):cardinal; stdcall;
var
owner:TCapture;
begin
owner:=TCapture(GetProp(hwnd,pansichar('OwnerObject')));
if assigned(owner.cbFrame) then owner.cbFrame(owner,vHeader);
end;

function CapControlCallback (Hwnd,nState:cardinal):Cardinal;stdcall;
var
owner:TCapture;
begin
owner:=TCapture(GetProp(hwnd,pansichar('OwnerObject')));
if assigned(owner.cbCapCtrl) then result:=cardinal(owner.cbCapCtrl (owner,nState)) else   result:=$FFFFFFFF;
end;

function ErrorCallback (Hwnd,nId:Cardinal;nDescription:pansichar):cardinal;stdcall;
var
owner:TCapture;
begin
owner:=TCapture(GetProp(hwnd,pansichar('OwnerObject')));
if assigned(owner.cbError ) then owner.cbError (owner,nId,nDescription) ;

end;

function StatusCallback (Hwnd,nId:Cardinal;nDescription:pansichar):cardinal;stdcall;
var
owner:TCapture;
begin
owner:=TCapture(GetProp(hwnd,pansichar('OwnerObject')));
if assigned(owner.cbStatus ) then owner.cbStatus (owner,nId,nDescription);
end;

function YieldCallback (Hwnd:Cardinal):cardinal;stdcall;
var
owner:TCapture;
begin
owner:=TCapture(GetProp(hwnd,pansichar('OwnerObject')));
if assigned(owner.cbYield ) then owner.cbYield (owner);
result:=$FFFFFFFF;
end;

function AudioStreamCallback(Hwnd:cardinal;aHeader:pWAVEHDR):cardinal; stdcall;
var
owner:TCapture;
begin
owner:=TCapture(GetProp(hwnd,pansichar('OwnerObject')));
if assigned(owner.cbAudioStream ) then owner.cbAudioStream (owner,aHeader);
end;

procedure TCapture.SetSingleFrame(sFrame: longbool);
begin

if sFrame then begin
if 0=SendMessage (wHandle,WM_CAP_SINGLE_FRAME_OPEN,0,0) then exit;
end
else begin
if 0=SendMessage (wHandle,WM_CAP_SINGLE_FRAME_CLOSE,0,0) then exit;
end;

wSingleFrm:=sFrame;
end;

function TCapture.CaptureStartSingleFrame: longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_SINGLE_FRAME,0,0));
end;

function TCapture.VideoBufferToClipboard: longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_EDIT_COPY,0,0));
end;

function TCapture.FrameToBitmapFile(const Filename: string): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_FILE_SAVEDIBA,0,integer(pointer(Filename))));
end;

function TCapture.FrameStill: longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_GRAB_FRAME,0,0));
if result then wPrev:=false;
end;

function TCapture.FrameToFrameBuffer: longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_GRAB_FRAME_NOSTOP,0,0));
end;

function TCapture.PaletteFromClipboard: longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_PAL_PASTE,0,0));
end;

function TCapture.PaletteLoad(const Filename: string): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_PAL_OPENA,0,integer(pointer(Filename))));
end;

function TCapture.PaletteSave(const Filename: string): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_PAL_SAVEA,0,integer(pointer(Filename))));
end;

//nColors max=256
function TCapture.PaletteAutoCreate(SampleFrames,
nColors: cardinal): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_PAL_AUTOCREATE,SampleFrames,nColors));
end;

function TCapture.PaletteManualCreate(fGrab: longbool;
nColors: cardinal): longbool;
begin
result:=longbool(SendMessage (wHandle,WM_CAP_PAL_MANUALCREATE,integer(fGrab),nColors));
end;


function TCapture.GetMCIDev: string;
var
lLen:cardinal;
begin
setlength(result,1024);
SendMessage (wHandle,WM_CAP_GET_MCI_DEVICEA, 1024, integer(pointer(result)));
llen:=lstrlen(pointer(result));
setlength(result,llen);
end;

procedure TCapture.SetMCIDev(const devName: string);
begin
SendMessage (wHandle,WM_CAP_SET_MCI_DEVICEA, 0, integer(pointer(devName)));
end;

function TCapture.GetUsr: cardinal;
begin
result:= SendMessage (wHandle,WM_CAP_GET_USER_DATA, 0,0);
end;

procedure TCapture.SetUsr(uData: cardinal);
begin
SendMessage (wHandle,WM_CAP_SET_USER_DATA, 0,uData);
end;

function TCapture.GetInit: longbool;
begin
result:=longbool(wHandle);
end;

end.

Nincsenek megjegyzések:

Megjegyzés küldése