Mega Code Archive
TCapture (Image Capture Class)
<![CDATA[
Title: TCapture (Image Capture Class)
Question: Features:capture movies/pictures from any Video Device via instaled Capture Drivers,
Preview & Free Class By Vanja Fuckar 2004,email:inga@vip.hr
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 wParentW0 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 WHandle0 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 wHandle0 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 0SendMessage (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.
]]>