webcam kontrol
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!
webcam kontrol
bilgisayara bağlı olan ufak bir webcam den görüntüleri almak istiyorum. bu konuda yardımcı olursanız sevinirim.
Umarim isine yarar, Cod'u denemedim, ufak tefek hatalar varmis.
http://www.delphi-forum.de/viewtopic.ph ... ght=webcam sayfasindan aldim.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, VideoCap, StdCtrls;
type
TForm1 = class(TForm)
TBild: TTimer;
PanelVideo2: TPanel;
VideoLabel: TLabel;
Panel2: TPanel;
procedure FormShow(Sender: TObject);
procedure Video2;
procedure TBildTimer(Sender: TObject);
procedure BildMachen(Nr: integer);
procedure CapStatus(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
i: integer;
implementation
{$R *.DFM}
procedure TForm1.FormShow(Sender: TObject);
begin
CapCloseDriver;
Video2;
i:= 1;
TBild.Enabled:= True;
end;
procedure TForm1.Video2;
var
MyCapStatusProc : TCapStatusProc;
begin
// Start CAP - Video
CapSetVideoArea( PanelVideo2 );
CapSetInfoLabel( VideoLabel );
MyCapStatusProc := CAPStatus;
CapSetStatusProcedure( MyCapStatusProc );
if CapOpenDriver then
begin
CapSetCapSec(15 * 3);
CapShow;
end;
end;
procedure TForm1.CapStatus(Sender: TObject);
begin
Panel2.Color := clBtnFace;
Panel2.Refresh;
end;
procedure TForm1.TBildTimer(Sender: TObject);
begin
// BildMachen(i);
{ i:= i + 1;
if i = 6 then
begin
TBild.Enabled:= False;
FlirtBildWahl.Show;
end
else
begin
GBUserBild.Caption:= 'Bitte warten, Bilder werden gemacht: noch ' + IntToStr(5 - i) + '...';
end; }
end;
procedure TForm1.BildMachen(Nr: integer);
var
SingleImageFileName : string;
begin
// Save Video as Bitmap to file in TEMP-Path
// SingleImageFileName:= ExtractFilePath(ParamStr(0)) + UserLog + '\' + IntToStr(Nr) + '.bmp';
// CapSetSingleImageFileName( SingleImageFileName );
CapGrabSingleFrame;
CapSetVideoLive;
end;
end.
unit VideoCap;
interface
uses Windows, Dialogs, Controls, SysUtils, StdCtrls, MMSystem, AviCap;
const
MAXVIDDRIVERS = 10;
MS_FOR_15FPS = 66;
MS_FOR_20FPS = 50;
MS_FOR_30FPS = 33;
MS_FOR_25FPS = 40; // rate in msec
type
TCapStatusProc = procedure(Sender: TObject) of object;
var
ghCapWnd : THandle;
gCapVideoArea : TWinControl;
gCapVideoDriverName : string;
gdwCapNofMaxVideoFrame : DWord;
gCapVideoFileName : string;
gCapSingleImageFileName : string;
gCapVideoInfoLabel : TLabel;
gCapStatusProcedure : TCapStatusProc;
procedure CapSetVideoArea( Container: TWinControl );
procedure CapSetVideoFileName( FileName : string );
procedure CapSetSingleImageFileName( FileName : string );
procedure CapSetInfoLabel( InfoLabel : TLabel );
procedure CapSetStatusProcedure( StatusProc : TCapStatusProc );
function CapOpenDriver : Boolean;
function CapInitDriver( Index : Integer ): Boolean;
procedure CapCloseDriver;
procedure CapShow;
procedure CapSetCapSec( NofMaxVideoFrame : Integer );
procedure CapStart;
procedure CapStop;
function CapHasDlgVFormat : Boolean;
function CapHasDlgVDisplay : Boolean;
function CapHasDlgVSource : Boolean;
procedure CapDlgVFormat;
procedure CapDlgVDisplay;
procedure CapDlgVSource;
procedure CapSetVideoOverlay;
procedure CapSetVideoLive;
procedure CapGrabSingleFrame;
implementation
(*---------------------------------------------------------------*)
(*--- C A P - V I D E O D R I V E R ---*)
(*---------------------------------------------------------------*)
(*---------------------------------------------------------------*)
procedure CapSetVideoArea( Container: TWinControl );
begin
gCapVideoArea := Container;
end;
(*---------------------------------------------------------------*)
procedure CapSetVideoFileName( FileName : string );
begin
gCapVideoFileName := FileName;
end;
(*---------------------------------------------------------------*)
procedure CapSetSingleImageFileName( FileName : string );
begin
gCapSingleImageFileName := FileName;
end;
(*---------------------------------------------------------------*)
procedure CapSetInfoLabel( InfoLabel : TLabel );
begin
gCapVideoInfoLabel := InfoLabel;
end;
(*---------------------------------------------------------------*)
procedure CapSetStatusProcedure( StatusProc : TCapStatusProc );
begin
gCapStatusProcedure := StatusProc;
end;
(*---------------------------------------------------------------*)
(* -- Video For Windows Status Callback Function --- *)
(*---------------------------------------------------------------*)
function StatusCallbackProc(hWnd : HWND; nID : Integer; lpsz : LongInt): LongInt; stdcall;
var
TmpStr : string;
dwVideoNum : Integer;
begin
// hWnd: Application main window handle
// nID: Status code for the current status
// lpStatusText: Status text string for the current status
TmpStr := StrPas(PChar(lpsz));
gCapVideoInfoLabel.Caption := TmpStr;
gCapVideoInfoLabel.Refresh;
if nID = IDS_CAP_STAT_VIDEOCURRENT then
begin
dwVideoNum := StrToInt( Copy(TmpStr, 0, Pos(' ', TmpStr)-1));
if dwVideoNum >= gdwCapNofMaxVideoFrame then
begin
capCaptureAbort(ghCapWnd);
if @gCapStatusProcedure <> nil then gCapStatusProcedure(nil);
end;
end;
Result := 1;
end;
(*---------------------------------------------------------------*)
function CapOpenDriver : Boolean;
var
Retc : LongInt;
DriverIndex : Integer;
DriverStarted : boolean;
achDeviceName : array [0..80] of Char;
achDeviceVersion : array [0..100] of Char;
achFileName : array [0..255] of Char;
begin
Result := FALSE;
if gCapVideoArea = nil then exit;
Result := TRUE;
// Create the Video Capture Window
ghCapWnd := capCreateCaptureWindow( PChar('KruwoSoft'),
WS_CHILD or WS_VISIBLE, 0, 0,
gCapVideoArea.Width, gCapVideoArea.Height,
gCapVideoArea.Handle, 0);
if ghCapWnd <> 0 then
begin
// Install Status-Callback-Function
retc := capSetCallbackOnStatus(ghCapWnd, LongInt(0));
if retc <> 0 then
begin
retc := capSetCallbackOnStatus(ghCapWnd, LongInt(@StatusCallbackProc));
if retc <> 0 then
begin
// Open Installed Video Driver
DriverIndex := 0;
repeat
DriverStarted := CapInitDriver( DriverIndex );
if NOT DriverStarted then DriverIndex := DriverIndex + 1;
until (DriverStarted = TRUE) OR (DriverIndex >= MAXVIDDRIVERS);
// Keep Name of Video Driver
if capGetDriverDescription( DriverIndex,
achDeviceName, 80,
achDeviceVersion, 100 ) then
begin
gCapVideoDriverName := string(achDeviceName);
end;
// Set Capture FileName
StrPCopy(achFileName, gCapVideoFileName);
retc := capFileSetCaptureFile(ghCapWnd, LongInt(@achFileName));
if retc = 0 then
begin
showmessage(gCapVideoDriverName+': Error in capFileSetCaptureFile');
end;
exit;
end;
end;
end;
Result := FALSE;
CapCloseDriver;
ghCapWnd := 0;
end;
(*---------------------------------------------------------------*)
function CapInitDriver( Index : Integer ): Boolean;
var
Retc : LongInt;
CapParms : TCAPTUREPARMS;
begin
Result := FALSE;
if ghCapWnd = 0 then exit;
// Connect to Video Capture Driver
if capDriverConnect(ghCapWnd, Index) <> 0 then
begin
retc := capCaptureGetSetup(ghCapWnd, LongInt(@CapParms), sizeof(TCAPTUREPARMS));
if retc <> 0 then
begin
// CapParms.dwRequestMicroSecPerFrame := 40000; // 25 FPS Requested capture rate
// CapParms.dwRequestMicroSecPerFrame := 100000; // 10 FPS Requested capture rate
CapParms.dwRequestMicroSecPerFrame := 66667; // 15 FPS Requested capture rate
CapParms.fLimitEnabled := FALSE;
CapParms.fCaptureAudio := FALSE; // NO Audio
CapParms.fMCIControl := FALSE;
CapParms.fYield := TRUE;
CapParms.vKeyAbort := VK_ESCAPE;
CapParms.fAbortLeftMouse := FALSE;
CapParms.fAbortRightMouse := FALSE;
retc := capCaptureSetSetup(ghCapWnd, LongInt(@CapParms), sizeof(TCAPTUREPARMS));
if retc = 0 then exit;
end;
Result := TRUE;
end;
end;
(*---------------------------------------------------------------*)
procedure CapCloseDriver;
begin
if ghCapWnd <> 0 then
begin
capSetCallbackOnStatus(ghCapWnd, LongInt(0));
capDriverDisconnect( ghCapWnd );
DestroyWindow( ghCapWnd ) ;
ghCapWnd := 0;
end;
end;
(*---------------------------------------------------------------*)
procedure CapShow;
begin
if ghCapWnd = 0 then exit;
// Start Video overlay by default
capPreviewScale(ghCapWnd, 1);
capPreviewRate(ghCapWnd, MS_FOR_25FPS);
capOverlay(ghCapWnd, 0);
capPreview(ghCapWnd, 1);
end;
(*---------------------------------------------------------------*)
procedure CapSetCapSec( NofMaxVideoFrame : Integer );
begin
gdwCapNofMaxVideoFrame := DWord( NofMaxVideoFrame );
end;
(*---------------------------------------------------------------*)
procedure CapStart;
begin
if ghCapWnd = 0 then exit;
// Start video capture to file
capCaptureSequence( ghCapWnd );
end;
(*---------------------------------------------------------------*)
procedure CapStop;
begin
if ghCapWnd = 0 then exit;
// Stop video capture to file
capCaptureAbort(ghCapWnd);
end;
(*---------------------------------------------------------------*)
function CapHasDlgVFormat : Boolean;
var
CDrvCaps : TCapDriverCaps;
begin
Result := TRUE;
if ghCapWnd = 0 then exit;
capDriverGetCaps(ghCapWnd, LongInt(@CDrvCaps), sizeof(TCapDriverCaps));
Result := CDrvCaps.fHasDlgVideoFormat;
end;
(*---------------------------------------------------------------*)
function CapHasDlgVDisplay : Boolean;
var
CDrvCaps : TCapDriverCaps;
begin
Result := TRUE;
if ghCapWnd = 0 then exit;
capDriverGetCaps(ghCapWnd, LongInt(@CDrvCaps), sizeof(TCapDriverCaps));
Result := CDrvCaps.fHasDlgVideoDisplay;
end;
(*---------------------------------------------------------------*)
function CapHasDlgVSource : Boolean;
var
CDrvCaps : TCapDriverCaps;
begin
Result := TRUE;
if ghCapWnd = 0 then exit;
capDriverGetCaps(ghCapWnd, LongInt(@CDrvCaps), sizeof(TCapDriverCaps));
Result := CDrvCaps.fHasDlgVideoSource;
end;
(*---------------------------------------------------------------*)
procedure CapDlgVFormat;
begin
if ghCapWnd = 0 then exit;
capDlgVideoFormat(ghCapWnd);
end;
(*---------------------------------------------------------------*)
procedure CapDlgVDisplay;
begin
if ghCapWnd = 0 then exit;
capDlgVideoDisplay(ghCapWnd);
end;
(*---------------------------------------------------------------*)
procedure CapDlgVSource;
begin
if ghCapWnd = 0 then exit;
capDlgVideoSource(ghCapWnd);
end;
(*---------------------------------------------------------------*)
procedure CapSetVideoOverlay;
begin
if ghCapWnd = 0 then exit;
capPreview(ghCapWnd, 0);
capOverlay(ghCapWnd, 1);
end;
(*---------------------------------------------------------------*)
procedure CapSetVideoLive;
begin
if ghCapWnd = 0 then exit;
capOverlay(ghCapWnd, 0);
capPreviewScale(ghCapWnd, 1);
capPreviewRate(ghCapWnd, MS_FOR_25FPS);
capPreview(ghCapWnd, 1);
end;
(*---------------------------------------------------------------*)
procedure CapGrabSingleFrame;
var
achSingleFileName : array [0..255] of Char;
begin
if ghCapWnd = 0 then exit;
capGrabFrame(ghCapWnd);
StrPCopy(achSingleFileName, gCapSingleImageFileName);
capFileSaveDIB(ghCapWnd, LongInt(@achSingleFileName));
end;
initialization
ghCapWnd := 0;
gCapVideoArea := nil;
gCapVideoDriverName := 'No Driver';
gdwCapNofMaxVideoFrame := 0;
gCapVideoFileName := 'Video.avi';
gCapSingleImageFileName := 'Image.bmp';
gCapVideoInfoLabel := nil;
gCapStatusProcedure := nil;
end.
unit VideoMci;
interface
uses Windows, SysUtils, Graphics, Controls, MMSystem, VfW;
type
TMciStatusProc = procedure(Sender: TObject) of object;
var
gMciVideoArea : TWinControl;
gMciVideoFileName : string;
gMciActive : boolean;
gMciStatusProcedure : TMciStatusProc;
gMciVideoHandle : THandle;
procedure MciSetVideoArea( Container: TWinControl );
procedure MciSetVideoFileName( FileName : string );
procedure MciSetStatusProcedure( StatusProc : TMciStatusProc );
procedure MciSetVideoHandle( hVideo: THandle );
procedure MciVideoCommand( TheCommand : string );
function MciReturnVideoCommand( TheCommand : string ) : string;
procedure MciOpen;
procedure MciClose;
procedure MciStart;
procedure MciStop;
procedure MciSeek( Position : Integer );
function MciGetPos: Integer;
procedure MciPlay( FromPos : Integer );
function MciGetNoOfFrames : Integer;
function MciFrameToBmp( TmpBmp : TBitmap ) : Boolean;
procedure MciNotify;
implementation
(*---------------------------------------------------------------*)
(*--- M C I - V I D E O D R I V E R ---*)
(*---------------------------------------------------------------*)
uses WVideo;
(*---------------------------------------------------------------*)
procedure MciSetVideoArea( Container: TWinControl );
begin
gMciVideoArea := Container;
end;
(*---------------------------------------------------------------*)
procedure MciSetVideoFileName( FileName : string );
begin
gMciVideoFileName := FileName;
end;
(*---------------------------------------------------------------*)
procedure MciSetStatusProcedure( StatusProc : TMciStatusProc );
begin
gMciStatusProcedure := StatusProc;
end;
(*---------------------------------------------------------------*)
procedure MciSetVideoHandle( hVideo: THandle );
begin
gMciVideoHandle := hVideo;
end;
(*---------------------------------------------------------------*)
procedure MciVideoCommand( TheCommand : string );
var
FError : LongInt;
ReturnStr : array [0..255] of Char;
// ErrorStr : array [0..127] of Char;
begin
FError := mciSendString( PChar(TheCommand), ReturnStr, 255, gMciVideoHandle );
if FError <> 0 then
begin
gMciActive := FALSE;
(*
mciGetErrorString( FError, ErrorStr, 127 );
Showmessage(' Command : '+ TheCommand + #13 +
' Error : '+ string(ErrorStr) );
*)
end;
end;
(*---------------------------------------------------------------*)
function MciReturnVideoCommand( TheCommand : string ) : string;
var
FError : LongInt;
ReturnStr : array [0..255] of Char;
// ErrorStr : array [0..127] of Char;
begin
FError := mciSendString( PChar(TheCommand), ReturnStr, 255, gMciVideoHandle );
if FError <> 0 then
begin
gMciActive := FALSE;
(*
mciGetErrorString( FError, ErrorStr, 127 );
Showmessage(' Command : '+ TheCommand + #13 +
' Error : '+ string(ErrorStr) );
*)
end;
Result := StrPas( ReturnStr );
end;
(*---------------------------------------------------------------*)
procedure MciNotify;
begin
if @gMciStatusProcedure <> nil then gMciStatusProcedure(nil);
// PostMessage( gdwAppHwnd, Mci_REV_MSG_Status, 0, LongInt(50) );
end;
(*---------------------------------------------------------------*)
procedure MciOpen;
begin
gMciActive := TRUE;
if gMciActive then MciVideoCommand( 'open '
+ gMciVideoFileName + ' alias KruwoVideo style child parent '
+ IntToStr(gMciVideoArea.Handle) + ' wait' );
if gMciActive then MciVideoCommand( 'put KruwoVideo window at '
+ IntToStr(gMciVideoArea.Left-5) + ' '
+ IntToStr(gMciVideoArea.Top-5) + ' '
+ IntToStr(gMciVideoArea.Width) + ' '
+ IntToStr(gMciVideoArea.Height) + ' wait' );
if gMciActive then MciVideoCommand( 'set KruwoVideo seek exactly off wait' );
end;
(*---------------------------------------------------------------*)
procedure MciClose;
begin
if gMciActive then MciVideoCommand( 'close KruwoVideo wait' );
end;
(*---------------------------------------------------------------*)
procedure MciStart;
begin
if gMciActive then MciVideoCommand( 'play KruwoVideo from 0 notify' );
end;
(*---------------------------------------------------------------*)
procedure MciStop;
begin
if gMciActive then MciVideoCommand( 'stop KruwoVideo wait' );
end;
(*---------------------------------------------------------------*)
procedure MciSeek( Position : Integer );
begin
if gMciActive then MciVideoCommand( 'seek KruwoVideo to '+IntToStr(Position)+' wait' );
end;
(*---------------------------------------------------------------*)
function MciGetPos: Integer;
var
PosStr : string;
begin
PosStr := MciReturnVideoCommand('status KruwoVideo position wait');
if Length(PosStr) <= 0
then Result := 0
else Result := LongInt(StrToInt(PosStr));
end;
(*---------------------------------------------------------------*)
procedure MciPlay( FromPos : Integer );
begin
if gMciActive then MciVideoCommand( 'play KruwoVideo from '
+ IntToStr(FromPos) + ' notify' );
end;
(*---------------------------------------------------------------*)
function MciGetNoOfFrames : Integer;
var
retc : Integer;
pfile : PAVIFile;
gapavi : PAVIStream; // the current stream
asi : TAVIStreamInfo;
begin
Result := -1;
// Open and Save Video
AVIFileInit;
retc := AVIFileOpen(pfile, PChar(gMciVideoFileName), 0, nil);
if retc <> 0 then
begin
AVIFileExit;
exit;
end;
retc := AVIFileGetStream(pfile, gapavi, 0, 0);
if retc <> AVIERR_OK then
begin
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
// Get some info about this stream
retc := AVIStreamInfo(gapavi, asi, sizeof(asi));
if retc <> AVIERR_OK then
begin
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
if asi.fccType <> streamtypeVIDEO
then Result := -1
else Result := asi.dwLength;
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
end;
(*---------------------------------------------------------------*)
function MciFrameToBmp( TmpBmp : TBitmap ) : Boolean;
var
CurrentPos : Integer;
retc : Integer;
pfile : PAVIFile;
gapavi : PAVIStream; // the current stream
gapgf : PGETFRAME; // data for decompressing video
lpbi : PBITMAPINFOHEADER;
bits : PChar;
hBmp : HBITMAP;
begin
Result := FALSE;
CurrentPos := MciGetPos;
// Open and Save Video
AVIFileInit;
retc := AVIFileOpen(pfile, PChar(gMciVideoFileName), 0, nil);
if retc <> 0 then
begin
AVIFileExit;
exit;
end;
retc := AVIFileGetStream(pfile, gapavi, 0, 0);
if retc <> AVIERR_OK then
begin
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
gapgf := AVIStreamGetFrameOpen(gapavi, nil);
if gapgf = nil then
begin
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
// Read current Frame
lpbi := AVIStreamGetFrame(gapgf, CurrentPos);
if lpbi = nil then
begin
AVIStreamGetFrameClose(gapgf);
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
TmpBmp.Height := lpbi.biHeight;
TmpBmp.Width := lpbi.biWidth;
bits := Pointer(Integer(lpbi) + sizeof(TBITMAPINFOHEADER));
hBmp := CreateDIBitmap(
GetDC(gMciVideoArea.Handle), // handle of device context
lpbi^, // address of bitmap size and format data
CBM_INIT, // initialization flag
bits, // address of initialization data
PBITMAPINFO(lpbi)^, // address of bitmap color-format data
DIB_RGB_COLORS ); // color-data usage
TmpBmp.Handle := hBmp;
Result := TRUE;
AVIStreamGetFrameClose(gapgf);
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
end;
initialization
gMciVideoFileName := 'Video.avi';
gMciActive := FALSE;
gMciStatusProcedure := nil;
end.
unit AviCap;
interface
uses
Windows, MMSystem, Messages;
const
// ------------------------------------------------------------------
// Window Messages WM_CAP... which can be sent to an AVICAP window
// ------------------------------------------------------------------
// Defines start of the message range
WM_CAP_START = WM_USER;
WM_CAP_GET_CAPSTREAMPTR = (WM_CAP_START+ 1);
WM_CAP_SET_CALLBACK_ERROR = (WM_CAP_START+ 2);
WM_CAP_SET_CALLBACK_STATUS = (WM_CAP_START+ 3);
WM_CAP_SET_CALLBACK_YIELD = (WM_CAP_START+ 4);
WM_CAP_SET_CALLBACK_FRAME = (WM_CAP_START+ 5);
WM_CAP_SET_CALLBACK_VIDEOSTREAM = (WM_CAP_START+ 6);
WM_CAP_SET_CALLBACK_WAVESTREAM = (WM_CAP_START+ 7);
WM_CAP_GET_USER_DATA = (WM_CAP_START+
;
WM_CAP_SET_USER_DATA = (WM_CAP_START+ 9);
WM_CAP_DRIVER_CONNECT = (WM_CAP_START+ 10);
WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START+ 11);
WM_CAP_DRIVER_GET_NAME = (WM_CAP_START+ 12);
WM_CAP_DRIVER_GET_VERSION = (WM_CAP_START+ 13);
WM_CAP_DRIVER_GET_CAPS = (WM_CAP_START+ 14);
WM_CAP_FILE_SET_CAPTURE_FILE = (WM_CAP_START+ 20);
WM_CAP_FILE_GET_CAPTURE_FILE = (WM_CAP_START+ 21);
WM_CAP_FILE_ALLOCATE = (WM_CAP_START+ 22);
WM_CAP_FILE_SAVEAS = (WM_CAP_START+ 23);
WM_CAP_FILE_SET_INFOCHUNK = (WM_CAP_START+ 24);
WM_CAP_FILE_SAVEDIB = (WM_CAP_START+ 25);
WM_CAP_EDIT_COPY = (WM_CAP_START+ 30);
WM_CAP_SET_AUDIOFORMAT = (WM_CAP_START+ 35);
WM_CAP_GET_AUDIOFORMAT = (WM_CAP_START+ 36);
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_GET_VIDEOFORMAT = (WM_CAP_START+ 44);
WM_CAP_SET_VIDEOFORMAT = (WM_CAP_START+ 45);
WM_CAP_DLG_VIDEOCOMPRESSION = (WM_CAP_START+ 46);
WM_CAP_SET_PREVIEW = (WM_CAP_START+ 50);
WM_CAP_SET_OVERLAY = (WM_CAP_START+ 51);
WM_CAP_SET_PREVIEWRATE = (WM_CAP_START+ 52);
WM_CAP_SET_SCALE = (WM_CAP_START+ 53);
WM_CAP_GET_STATUS = (WM_CAP_START+ 54);
WM_CAP_SET_SCROLL = (WM_CAP_START+ 55);
WM_CAP_GRAB_FRAME = (WM_CAP_START+ 60);
WM_CAP_GRAB_FRAME_NOSTOP = (WM_CAP_START+ 61);
WM_CAP_SEQUENCE = (WM_CAP_START+ 62);
WM_CAP_SEQUENCE_NOFILE = (WM_CAP_START+ 63);
WM_CAP_SET_SEQUENCE_SETUP = (WM_CAP_START+ 64);
WM_CAP_GET_SEQUENCE_SETUP = (WM_CAP_START+ 65);
WM_CAP_SET_MCI_DEVICE = (WM_CAP_START+ 66);
WM_CAP_GET_MCI_DEVICE = (WM_CAP_START+ 67);
WM_CAP_STOP = (WM_CAP_START+ 68);
WM_CAP_ABORT = (WM_CAP_START+ 69);
WM_CAP_SINGLE_FRAME_OPEN = (WM_CAP_START+ 70);
WM_CAP_SINGLE_FRAME_CLOSE = (WM_CAP_START+ 71);
WM_CAP_SINGLE_FRAME = (WM_CAP_START+ 72);
WM_CAP_PAL_OPEN = (WM_CAP_START+ 80);
WM_CAP_PAL_SAVE = (WM_CAP_START+ 81);
WM_CAP_PAL_PASTE = (WM_CAP_START+ 82);
WM_CAP_PAL_AUTOCREATE = (WM_CAP_START+ 83);
WM_CAP_PAL_MANUALCREATE = (WM_CAP_START+ 84);
// Following added post VFW 1.1
WM_CAP_SET_CALLBACK_CAPCONTROL = (WM_CAP_START+ 85);
// Defines end of the message range
WM_CAP_END = WM_CAP_SET_CALLBACK_CAPCONTROL;
// ------------------------------------------------------------------
// Message crackers for above
// ------------------------------------------------------------------
function capSetCallbackOnError (hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnStatus(hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnYield (hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnFrame (hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnVideoStream(hwnd:THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnWaveStream (hwnd:THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnCapControl (hwnd:THandle; fpProc:LongInt):LongInt;
function capSetUserData(hwnd:THandle; lUser:LongInt):LongInt;
function capGetUserData(hwnd:THandle):LongInt;
function capDriverConnect(hwnd:THandle; I: Word) : LongInt;
function capDriverDisconnect(hwnd:THandle):LongInt;
function capDriverGetName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
function capDriverGetVersion(hwnd:THandle; szVer:LongInt; wSize:Word):LongInt;
function capDriverGetCaps(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capFileSetCaptureFile(hwnd:THandle; szName:LongInt):LongInt;
function capFileGetCaptureFile(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
function capFileAlloc(hwnd:THandle; dwSize:LongInt):LongInt;
function capFileSaveAs(hwnd:THandle; szName:LongInt):LongInt;
function capFileSetInfoChunk(hwnd:THandle; lpInfoChunk:LongInt):LongInt;
function capFileSaveDIB(hwnd:THandle; szName:LongInt):LongInt;
function capEditCopy(hwnd : THandle):LongInt;
function capSetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capGetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capGetAudioFormatSize(hwnd:THandle):LongInt;
function capDlgVideoFormat(hwnd:THandle):LongInt;
function capDlgVideoSource(hwnd:THandle):LongInt;
function capDlgVideoDisplay(hwnd:THandle):LongInt;
function capDlgVideoCompression(hwnd:THandle):LongInt;
function capGetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capGetVideoFormatSize(hwnd:THandle):LongInt;
function capSetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capPreview(hwnd:THandle; f:Word):LongInt;
function capPreviewRate(hwnd:THandle; wMS:Word):LongInt;
function capOverlay(hwnd:THandle; f:Word):LongInt;
function capPreviewScale(hwnd:THandle; f:Word):LongInt;
function capGetStatus(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capSetScrollPos(hwnd:THandle; lpP:LongInt):LongInt;
function capGrabFrame(hwnd:THandle):LongInt;
function capGrabFrameNoStop(hwnd:THandle):LongInt;
function capCaptureSequence(hwnd:THandle):LongInt;
function capCaptureSequenceNoFile(hwnd:THandle):LongInt;
function capCaptureStop(hwnd:THandle):LongInt;
function capCaptureAbort(hwnd:THandle):LongInt;
function capCaptureSingleFrameOpen(hwnd:THandle):LongInt;
function capCaptureSingleFrameClose(hwnd:THandle):LongInt;
function capCaptureSingleFrame(hwnd:THandle):LongInt;
function capCaptureGetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capCaptureSetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capSetMCIDeviceName(hwnd:THandle; szName:LongInt):LongInt;
function capGetMCIDeviceName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
function capPaletteOpen(hwnd:THandle; szName:LongInt):LongInt;
function capPaletteSave(hwnd:THandle; szName:LongInt):LongInt;
function capPalettePaste(hwnd:THandle):LongInt;
function capPaletteAuto(hwnd:THandle; iFrames:Word; iColors:LongInt):LongInt;
function capPaletteManual(hwnd:THandle; fGrab:Word; iColors:LongInt):LongInt;
// ------------------------------------------------------------------
// Structures
// ------------------------------------------------------------------
type
PCapDriverCaps = ^TCapDriverCaps;
TCapDriverCaps = record
wDeviceIndex :WORD; // Driver index in system.ini
fHasOverlay :BOOL; // Can device overlay?
fHasDlgVideoSource :BOOL; // Has Video source dlg?
fHasDlgVideoFormat :BOOL; // Has Format dlg?
fHasDlgVideoDisplay :BOOL; // Has External out dlg?
fCaptureInitialized :BOOL; // Driver ready to capture?
fDriverSuppliesPalettes :BOOL; // Can driver make palettes?
hVideoIn :THANDLE; // Driver In channel
hVideoOut :THANDLE; // Driver Out channel
hVideoExtIn :THANDLE; // Driver Ext In channel
hVideoExtOut :THANDLE; // Driver Ext Out channel
end;
PCapStatus = ^TCapStatus;
TCapStatus = packed record
uiImageWidth :UINT; // Width of the image
uiImageHeight :UINT; // Height of the image
fLiveWindow :BOOL; // Now Previewing video?
fOverlayWindow :BOOL; // Now Overlaying video?
fScale :BOOL; // Scale image to client?
ptScroll :TPOINT; // Scroll position
fUsingDefaultPalette :BOOL; // Using default driver palette?
fAudioHardware :BOOL; // Audio hardware present?
fCapFileExists :BOOL; // Does capture file exist?
dwCurrentVideoFrame
WORD; // # of video frames cap'td
dwCurrentVideoFramesDropped
WORD; // # of video frames dropped
dwCurrentWaveSamples
WORD; // # of wave samples cap'td
dwCurrentTimeElapsedMS
WORD; // Elapsed capture duration
hPalCurrent :HPALETTE; // Current palette in use
fCapturingNow :BOOL; // Capture in progress?
dwReturn
WORD; // Error value after any operation
wNumVideoAllocated :WORD; // Actual number of video buffers
wNumAudioAllocated :WORD; // Actual number of audio buffers
end;
PCaptureParms = ^TCaptureParms;
TCaptureParms = record // Default values in parenthesis
dwRequestMicroSecPerFrame
WORD; // Requested capture rate
fMakeUserHitOKToCapture :BOOL; // Show "Hit OK to cap" dlg?
wPercentDropForError :WORD; // Give error msg if > (10%)
fYield :BOOL; // Capture via background task?
dwIndexSize
WORD; // Max index size in frames (32K)
wChunkGranularity :WORD; // Junk chunk granularity (2K)
fUsingDOSMemory :BOOL; // Use DOS buffers?
wNumVideoRequested :WORD; // # video buffers, If 0, autocalc
fCaptureAudio :BOOL; // Capture audio?
wNumAudioRequested :WORD; // # audio buffers, If 0, autocalc
vKeyAbort :WORD; // Virtual key causing abort
fAbortLeftMouse :BOOL; // Abort on left mouse?
fAbortRightMouse :BOOL; // Abort on right mouse?
fLimitEnabled :BOOL; // Use wTimeLimit?
wTimeLimit :WORD; // Seconds to capture
fMCIControl :BOOL; // Use MCI video source?
fStepMCIDevice :BOOL; // Step MCI device?
dwMCIStartTime
WORD; // Time to start in MS
dwMCIStopTime
WORD; // Time to stop in MS
fStepCaptureAt2x :BOOL; // Perform spatial averaging 2x
wStepCaptureAverageFrames :WORD; // Temporal average n Frames
dwAudioBufferSize
WORD; // Size of audio bufs (0 = default)
fDisableWriteCache :BOOL; // Attempt to disable write cache
AVStreamMaster :WORD; // Indicates whether the audio stream
// controls the clock when writing an AVI file.
end;
PCapInfoChunk = ^TCapInfoChunk;
TCapInfoChunk = record
fccInfoID :FOURCC; // Chunk ID, "ICOP" for copyright
lpData :LongInt; // pointer to data
cbData :LongInt; // size of lpData
end;
// ------------------------------------------------------------------
// Callback Definitions
// ------------------------------------------------------------------
type
TCAPSTATUSCALLBACK = function(hWnd:HWND; nID:Integer; lpsz:LongInt):LongInt; stdcall;
TCAPYIELDCALLBACK = function(hWnd:HWND):LongInt; stdcall;
TCAPERRORCALLBACK = function(hWnd:HWND; nID:Integer; lpsz:LongInt):LongInt; stdcall;
TCAPVIDEOCALLBACK = function(hWnd:HWND; lpVHdr:LongInt):LongInt; stdcall;
TCAPWAVECALLBACK = function(hWnd:HWND; lpWHdr:LongInt):LongInt; stdcall;
TCAPCONTROLCALLBACK = function(hWnd:HWND; nState:Integer):LongInt; stdcall;
// ------------------------------------------------------------------
// CapControlCallback states
// ------------------------------------------------------------------
Const
CONTROLCALLBACK_PREROLL = 1; // Waiting to start capture
CONTROLCALLBACK_CAPTURING = 2; // Now capturing
// ------------------------------------------------------------------
// The only exported functions from AVICAP.DLL
// ------------------------------------------------------------------
function capCreateCaptureWindow (
lpszWindowName : PChar;
dwStyle : DWord;
x, y : Integer;
nWidth, nHeight : Integer;
hwndParent : THandle;
nID : Integer ) : THandle; stdcall;
function capGetDriverDescription (
wDriverIndex : DWord;
lpszName : PChar;
cbName : Integer;
lpszVer : PChar;
cbVer : Integer ) : Boolean; stdcall;
// ------------------------------------------------------------------
// New Information chunk IDs
// ------------------------------------------------------------------
(*
infotypeDIGITIZATION_TIME = mmioStringToFOURCC(PChar('IDIT'), MMIO_TOUPPER);
infotypeSMPTE_TIME = mmioStringToFOURCC(PChar('ISMP'), MMIO_TOUPPER);
*)
// ------------------------------------------------------------------
// String IDs from status and error callbacks
// ------------------------------------------------------------------
Const
IDS_CAP_BEGIN = 300; (* "Capture Start" *)
IDS_CAP_END = 301; (* "Capture End" *)
IDS_CAP_INFO = 401; (* "%s" *)
IDS_CAP_OUTOFMEM = 402; (* "Out of memory" *)
IDS_CAP_FILEEXISTS = 403; (* "File '%s' exists -- overwrite it?" *)
IDS_CAP_ERRORPALOPEN = 404; (* "Error opening palette '%s'" *)
IDS_CAP_ERRORPALSAVE = 405; (* "Error saving palette '%s'" *)
IDS_CAP_ERRORDIBSAVE = 406; (* "Error saving frame '%s'" *)
IDS_CAP_DEFAVIEXT = 407; (* "avi" *)
IDS_CAP_DEFPALEXT = 408; (* "pal" *)
IDS_CAP_CANTOPEN = 409; (* "Cannot open '%s'" *)
IDS_CAP_SEQ_MSGSTART = 410; (* "Select OK to start capture\nof video sequence\nto %s." *)
IDS_CAP_SEQ_MSGSTOP = 411; (* "Hit ESCAPE or click to end capture" *)
IDS_CAP_VIDEDITERR = 412; (* "An error occurred while trying to run VidEdit." *)
IDS_CAP_READONLYFILE = 413; (* "The file '%s' is a read-only file." *)
IDS_CAP_WRITEERROR = 414; (* "Unable to write to file '%s'.\nDisk may be full." *)
IDS_CAP_NODISKSPACE = 415; (* "There is no space to create a capture file on the specified device." *)
IDS_CAP_SETFILESIZE = 416; (* "Set File Size" *)
IDS_CAP_SAVEASPERCENT = 417; (* "SaveAs: %2ld%% Hit Escape to abort." *)
IDS_CAP_DRIVER_ERROR = 418; (* Driver specific error message *)
IDS_CAP_WAVE_OPEN_ERROR = 419; (* "Error: Cannot open the wave input device.\nCheck sample size, frequency, and channels." *)
IDS_CAP_WAVE_ALLOC_ERROR = 420; (* "Error: Out of memory for wave buffers." *)
IDS_CAP_WAVE_PREPARE_ERROR = 421; (* "Error: Cannot prepare wave buffers." *)
IDS_CAP_WAVE_ADD_ERROR = 422; (* "Error: Cannot add wave buffers." *)
IDS_CAP_WAVE_SIZE_ERROR = 423; (* "Error: Bad wave size." *)
IDS_CAP_VIDEO_OPEN_ERROR = 424; (* "Error: Cannot open the video input device." *)
IDS_CAP_VIDEO_ALLOC_ERROR = 425; (* "Error: Out of memory for video buffers." *)
IDS_CAP_VIDEO_PREPARE_ERROR = 426; (* "Error: Cannot prepare video buffers." *)
IDS_CAP_VIDEO_ADD_ERROR = 427; (* "Error: Cannot add video buffers." *)
IDS_CAP_VIDEO_SIZE_ERROR = 428; (* "Error: Bad video size." *)
IDS_CAP_FILE_OPEN_ERROR = 429; (* "Error: Cannot open capture file." *)
IDS_CAP_FILE_WRITE_ERROR = 430; (* "Error: Cannot write to capture file. Disk may be full." *)
IDS_CAP_RECORDING_ERROR = 431; (* "Error: Cannot write to capture file. Data rate too high or disk full." *)
IDS_CAP_RECORDING_ERROR2 = 432; (* "Error while recording" *)
IDS_CAP_AVI_INIT_ERROR = 433; (* "Error: Unable to initialize for capture." *)
IDS_CAP_NO_FRAME_CAP_ERROR = 434; (* "Warning: No frames captured.\nConfirm that vertical sync interrupts\nare configured and enabled." *)
IDS_CAP_NO_PALETTE_WARN = 435; (* "Warning: Using default palette." *)
IDS_CAP_MCI_CONTROL_ERROR = 436; (* "Error: Unable to access MCI device." *)
IDS_CAP_MCI_CANT_STEP_ERROR = 437; (* "Error: Unable to step MCI device." *)
IDS_CAP_NO_AUDIO_CAP_ERROR = 438; (* "Error: No audio data captured.\nCheck audio card settings." *)
IDS_CAP_AVI_DRAWDIB_ERROR = 439; (* "Error: Unable to draw this data format." *)
IDS_CAP_COMPRESSOR_ERROR = 440; (* "Error: Unable to initialize compressor." *)
IDS_CAP_AUDIO_DROP_ERROR = 441; (* "Error: Audio data was lost during capture, reduce capture rate." *)
(* status string IDs *)
IDS_CAP_STAT_LIVE_MODE = 500; (* "Live window" *)
IDS_CAP_STAT_OVERLAY_MODE = 501; (* "Overlay window" *)
IDS_CAP_STAT_CAP_INIT = 502; (* "Setting up for capture - Please wait" *)
IDS_CAP_STAT_CAP_FINI = 503; (* "Finished capture, now writing frame %ld" *)
IDS_CAP_STAT_PALETTE_BUILD = 504; (* "Building palette map" *)
IDS_CAP_STAT_OPTPAL_BUILD = 505; (* "Computing optimal palette" *)
IDS_CAP_STAT_I_FRAMES = 506; (* "%d frames" *)
IDS_CAP_STAT_L_FRAMES = 507; (* "%ld frames" *)
IDS_CAP_STAT_CAP_L_FRAMES = 508; (* "Captured %ld frames" *)
IDS_CAP_STAT_CAP_AUDIO = 509; (* "Capturing audio" *)
IDS_CAP_STAT_VIDEOCURRENT = 510; (* "Captured %ld frames (%ld dropped) %d.%03d sec." *)
IDS_CAP_STAT_VIDEOAUDIO = 511; (* "Captured %d.%03d sec. %ld frames (%ld dropped) (%d.%03d fps). %ld audio bytes (%d,%03d sps)" *)
IDS_CAP_STAT_VIDEOONLY = 512; (* "Captured %d.%03d sec. %ld frames (%ld dropped) (%d.%03d fps)" *)
IDS_CAP_STAT_FRAMESDROPPED = 513; (* "Dropped %ld of %ld frames (%d.%02d%%) during capture." *)
const
AVICAP32 = 'AVICAP32.dll';
implementation
(* Externals from AVICAP.DLL *)
function capGetDriverDescription; external AVICAP32 name 'capGetDriverDescriptionA';
function capCreateCaptureWindow; external AVICAP32 name 'capCreateCaptureWindowA';
(* Message crackers for above *)
function capSetCallbackOnError(hwnd : THandle; fpProc:LongInt) : LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_ERROR, 0, fpProc);
end;
function capSetCallbackOnStatus(hwnd : THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_STATUS, 0, fpProc);
end;
function capSetCallbackOnYield (hwnd : THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_YIELD, 0, fpProc);
end;
function capSetCallbackOnFrame (hwnd : THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_FRAME, 0, fpProc);
end;
function capSetCallbackOnVideoStream(hwnd:THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, fpProc);
end;
function capSetCallbackOnWaveStream (hwnd:THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_WAVESTREAM, 0, fpProc);
end;
function capSetCallbackOnCapControl (hwnd:THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_CAPCONTROL, 0, fpProc);
end;
function capSetUserData(hwnd:THandle; lUser:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_USER_DATA, 0, lUser);
end;
function capGetUserData(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_USER_DATA, 0, 0);
end;
function capDriverConnect(hwnd:THandle; I: Word) : LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_CONNECT, I, 0);
end;
function capDriverDisconnect(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
end;
function capDriverGetName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_GET_NAME, wSize, szName);
end;
function capDriverGetVersion(hwnd:THandle; szVer:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_GET_VERSION, wSize, szVer);
end;
function capDriverGetCaps(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_GET_CAPS, wSize, s);
end;
function capFileSetCaptureFile(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_SET_CAPTURE_FILE, 0, szName);
end;
function capFileGetCaptureFile(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_GET_CAPTURE_FILE, wSize, szName);
end;
function capFileAlloc(hwnd:THandle; dwSize:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_ALLOCATE, 0, dwSize);
end;
function capFileSaveAs(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_SAVEAS, 0, szName);
end;
function capFileSetInfoChunk(hwnd:THandle; lpInfoChunk:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_SET_INFOCHUNK, 0, lpInfoChunk);
end;
function capFileSaveDIB(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_SAVEDIB, 0, szName);
end;
function capEditCopy(hwnd : THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_EDIT_COPY, 0, 0);
end;
function capSetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_AUDIOFORMAT, wSize, s);
end;
function capGetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_AUDIOFORMAT, wSize, s);
end;
function capGetAudioFormatSize(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_AUDIOFORMAT, 0, 0);
end;
function capDlgVideoFormat(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
end;
function capDlgVideoSource(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0);
end;
function capDlgVideoDisplay(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DLG_VIDEODISPLAY, 0, 0);
end;
function capDlgVideoCompression(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0);
end;
function capGetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, wSize, s);
end;
function capGetVideoFormatSize(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0);
end;
function capSetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_VIDEOFORMAT, wSize, s);
end;
function capPreview(hwnd:THandle; f:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_PREVIEW, f, 0);
end;
function capPreviewRate(hwnd:THandle; wMS:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_PREVIEWRATE, wMS, 0);
end;
function capOverlay(hwnd:THandle; f:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_OVERLAY, f, 0);
end;
function capPreviewScale(hwnd:THandle; f:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_SCALE, f, 0);
end;
function capGetStatus(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_STATUS, wSize, s);
end;
function capSetScrollPos(hwnd:THandle; lpP:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_SCROLL, 0, lpP);
end;
function capGrabFrame(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GRAB_FRAME, 0, 0);
end;
function capGrabFrameNoStop(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0);
end;
function capCaptureSequence(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SEQUENCE, 0, 0);
end;
function capCaptureSequenceNoFile(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SEQUENCE_NOFILE, 0, 0);
end;
function capCaptureStop(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_STOP, 0, 0);
end;
function capCaptureAbort(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_ABORT, 0, 0);
end;
function capCaptureSingleFrameOpen(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME_OPEN, 0, 0);
end;
function capCaptureSingleFrameClose(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME_CLOSE, 0, 0);
end;
function capCaptureSingleFrame(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME, 0, 0);
end;
function capCaptureGetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_SEQUENCE_SETUP, wSize, s);
end;
function capCaptureSetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_SEQUENCE_SETUP, wSize, s);
end;
function capSetMCIDeviceName(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_MCI_DEVICE, 0, szName);
end;
function capGetMCIDeviceName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_MCI_DEVICE, wSize, szName);
end;
function capPaletteOpen(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_OPEN, 0, szName);
end;
function capPaletteSave(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_SAVE, 0, szName);
end;
function capPalettePaste(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_PASTE, 0, 0);
end;
function capPaletteAuto(hwnd:THandle; iFrames:Word; iColors:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_AUTOCREATE, iFrames, iColors);
end;
function capPaletteManual(hwnd:THandle; fGrab:Word; iColors:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_MANUALCREATE, fGrab, iColors);
end;
end.
http://www.delphi-forum.de/viewtopic.ph ... ght=webcam sayfasindan aldim.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, VideoCap, StdCtrls;
type
TForm1 = class(TForm)
TBild: TTimer;
PanelVideo2: TPanel;
VideoLabel: TLabel;
Panel2: TPanel;
procedure FormShow(Sender: TObject);
procedure Video2;
procedure TBildTimer(Sender: TObject);
procedure BildMachen(Nr: integer);
procedure CapStatus(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
i: integer;
implementation
{$R *.DFM}
procedure TForm1.FormShow(Sender: TObject);
begin
CapCloseDriver;
Video2;
i:= 1;
TBild.Enabled:= True;
end;
procedure TForm1.Video2;
var
MyCapStatusProc : TCapStatusProc;
begin
// Start CAP - Video
CapSetVideoArea( PanelVideo2 );
CapSetInfoLabel( VideoLabel );
MyCapStatusProc := CAPStatus;
CapSetStatusProcedure( MyCapStatusProc );
if CapOpenDriver then
begin
CapSetCapSec(15 * 3);
CapShow;
end;
end;
procedure TForm1.CapStatus(Sender: TObject);
begin
Panel2.Color := clBtnFace;
Panel2.Refresh;
end;
procedure TForm1.TBildTimer(Sender: TObject);
begin
// BildMachen(i);
{ i:= i + 1;
if i = 6 then
begin
TBild.Enabled:= False;
FlirtBildWahl.Show;
end
else
begin
GBUserBild.Caption:= 'Bitte warten, Bilder werden gemacht: noch ' + IntToStr(5 - i) + '...';
end; }
end;
procedure TForm1.BildMachen(Nr: integer);
var
SingleImageFileName : string;
begin
// Save Video as Bitmap to file in TEMP-Path
// SingleImageFileName:= ExtractFilePath(ParamStr(0)) + UserLog + '\' + IntToStr(Nr) + '.bmp';
// CapSetSingleImageFileName( SingleImageFileName );
CapGrabSingleFrame;
CapSetVideoLive;
end;
end.
unit VideoCap;
interface
uses Windows, Dialogs, Controls, SysUtils, StdCtrls, MMSystem, AviCap;
const
MAXVIDDRIVERS = 10;
MS_FOR_15FPS = 66;
MS_FOR_20FPS = 50;
MS_FOR_30FPS = 33;
MS_FOR_25FPS = 40; // rate in msec
type
TCapStatusProc = procedure(Sender: TObject) of object;
var
ghCapWnd : THandle;
gCapVideoArea : TWinControl;
gCapVideoDriverName : string;
gdwCapNofMaxVideoFrame : DWord;
gCapVideoFileName : string;
gCapSingleImageFileName : string;
gCapVideoInfoLabel : TLabel;
gCapStatusProcedure : TCapStatusProc;
procedure CapSetVideoArea( Container: TWinControl );
procedure CapSetVideoFileName( FileName : string );
procedure CapSetSingleImageFileName( FileName : string );
procedure CapSetInfoLabel( InfoLabel : TLabel );
procedure CapSetStatusProcedure( StatusProc : TCapStatusProc );
function CapOpenDriver : Boolean;
function CapInitDriver( Index : Integer ): Boolean;
procedure CapCloseDriver;
procedure CapShow;
procedure CapSetCapSec( NofMaxVideoFrame : Integer );
procedure CapStart;
procedure CapStop;
function CapHasDlgVFormat : Boolean;
function CapHasDlgVDisplay : Boolean;
function CapHasDlgVSource : Boolean;
procedure CapDlgVFormat;
procedure CapDlgVDisplay;
procedure CapDlgVSource;
procedure CapSetVideoOverlay;
procedure CapSetVideoLive;
procedure CapGrabSingleFrame;
implementation
(*---------------------------------------------------------------*)
(*--- C A P - V I D E O D R I V E R ---*)
(*---------------------------------------------------------------*)
(*---------------------------------------------------------------*)
procedure CapSetVideoArea( Container: TWinControl );
begin
gCapVideoArea := Container;
end;
(*---------------------------------------------------------------*)
procedure CapSetVideoFileName( FileName : string );
begin
gCapVideoFileName := FileName;
end;
(*---------------------------------------------------------------*)
procedure CapSetSingleImageFileName( FileName : string );
begin
gCapSingleImageFileName := FileName;
end;
(*---------------------------------------------------------------*)
procedure CapSetInfoLabel( InfoLabel : TLabel );
begin
gCapVideoInfoLabel := InfoLabel;
end;
(*---------------------------------------------------------------*)
procedure CapSetStatusProcedure( StatusProc : TCapStatusProc );
begin
gCapStatusProcedure := StatusProc;
end;
(*---------------------------------------------------------------*)
(* -- Video For Windows Status Callback Function --- *)
(*---------------------------------------------------------------*)
function StatusCallbackProc(hWnd : HWND; nID : Integer; lpsz : LongInt): LongInt; stdcall;
var
TmpStr : string;
dwVideoNum : Integer;
begin
// hWnd: Application main window handle
// nID: Status code for the current status
// lpStatusText: Status text string for the current status
TmpStr := StrPas(PChar(lpsz));
gCapVideoInfoLabel.Caption := TmpStr;
gCapVideoInfoLabel.Refresh;
if nID = IDS_CAP_STAT_VIDEOCURRENT then
begin
dwVideoNum := StrToInt( Copy(TmpStr, 0, Pos(' ', TmpStr)-1));
if dwVideoNum >= gdwCapNofMaxVideoFrame then
begin
capCaptureAbort(ghCapWnd);
if @gCapStatusProcedure <> nil then gCapStatusProcedure(nil);
end;
end;
Result := 1;
end;
(*---------------------------------------------------------------*)
function CapOpenDriver : Boolean;
var
Retc : LongInt;
DriverIndex : Integer;
DriverStarted : boolean;
achDeviceName : array [0..80] of Char;
achDeviceVersion : array [0..100] of Char;
achFileName : array [0..255] of Char;
begin
Result := FALSE;
if gCapVideoArea = nil then exit;
Result := TRUE;
// Create the Video Capture Window
ghCapWnd := capCreateCaptureWindow( PChar('KruwoSoft'),
WS_CHILD or WS_VISIBLE, 0, 0,
gCapVideoArea.Width, gCapVideoArea.Height,
gCapVideoArea.Handle, 0);
if ghCapWnd <> 0 then
begin
// Install Status-Callback-Function
retc := capSetCallbackOnStatus(ghCapWnd, LongInt(0));
if retc <> 0 then
begin
retc := capSetCallbackOnStatus(ghCapWnd, LongInt(@StatusCallbackProc));
if retc <> 0 then
begin
// Open Installed Video Driver
DriverIndex := 0;
repeat
DriverStarted := CapInitDriver( DriverIndex );
if NOT DriverStarted then DriverIndex := DriverIndex + 1;
until (DriverStarted = TRUE) OR (DriverIndex >= MAXVIDDRIVERS);
// Keep Name of Video Driver
if capGetDriverDescription( DriverIndex,
achDeviceName, 80,
achDeviceVersion, 100 ) then
begin
gCapVideoDriverName := string(achDeviceName);
end;
// Set Capture FileName
StrPCopy(achFileName, gCapVideoFileName);
retc := capFileSetCaptureFile(ghCapWnd, LongInt(@achFileName));
if retc = 0 then
begin
showmessage(gCapVideoDriverName+': Error in capFileSetCaptureFile');
end;
exit;
end;
end;
end;
Result := FALSE;
CapCloseDriver;
ghCapWnd := 0;
end;
(*---------------------------------------------------------------*)
function CapInitDriver( Index : Integer ): Boolean;
var
Retc : LongInt;
CapParms : TCAPTUREPARMS;
begin
Result := FALSE;
if ghCapWnd = 0 then exit;
// Connect to Video Capture Driver
if capDriverConnect(ghCapWnd, Index) <> 0 then
begin
retc := capCaptureGetSetup(ghCapWnd, LongInt(@CapParms), sizeof(TCAPTUREPARMS));
if retc <> 0 then
begin
// CapParms.dwRequestMicroSecPerFrame := 40000; // 25 FPS Requested capture rate
// CapParms.dwRequestMicroSecPerFrame := 100000; // 10 FPS Requested capture rate
CapParms.dwRequestMicroSecPerFrame := 66667; // 15 FPS Requested capture rate
CapParms.fLimitEnabled := FALSE;
CapParms.fCaptureAudio := FALSE; // NO Audio
CapParms.fMCIControl := FALSE;
CapParms.fYield := TRUE;
CapParms.vKeyAbort := VK_ESCAPE;
CapParms.fAbortLeftMouse := FALSE;
CapParms.fAbortRightMouse := FALSE;
retc := capCaptureSetSetup(ghCapWnd, LongInt(@CapParms), sizeof(TCAPTUREPARMS));
if retc = 0 then exit;
end;
Result := TRUE;
end;
end;
(*---------------------------------------------------------------*)
procedure CapCloseDriver;
begin
if ghCapWnd <> 0 then
begin
capSetCallbackOnStatus(ghCapWnd, LongInt(0));
capDriverDisconnect( ghCapWnd );
DestroyWindow( ghCapWnd ) ;
ghCapWnd := 0;
end;
end;
(*---------------------------------------------------------------*)
procedure CapShow;
begin
if ghCapWnd = 0 then exit;
// Start Video overlay by default
capPreviewScale(ghCapWnd, 1);
capPreviewRate(ghCapWnd, MS_FOR_25FPS);
capOverlay(ghCapWnd, 0);
capPreview(ghCapWnd, 1);
end;
(*---------------------------------------------------------------*)
procedure CapSetCapSec( NofMaxVideoFrame : Integer );
begin
gdwCapNofMaxVideoFrame := DWord( NofMaxVideoFrame );
end;
(*---------------------------------------------------------------*)
procedure CapStart;
begin
if ghCapWnd = 0 then exit;
// Start video capture to file
capCaptureSequence( ghCapWnd );
end;
(*---------------------------------------------------------------*)
procedure CapStop;
begin
if ghCapWnd = 0 then exit;
// Stop video capture to file
capCaptureAbort(ghCapWnd);
end;
(*---------------------------------------------------------------*)
function CapHasDlgVFormat : Boolean;
var
CDrvCaps : TCapDriverCaps;
begin
Result := TRUE;
if ghCapWnd = 0 then exit;
capDriverGetCaps(ghCapWnd, LongInt(@CDrvCaps), sizeof(TCapDriverCaps));
Result := CDrvCaps.fHasDlgVideoFormat;
end;
(*---------------------------------------------------------------*)
function CapHasDlgVDisplay : Boolean;
var
CDrvCaps : TCapDriverCaps;
begin
Result := TRUE;
if ghCapWnd = 0 then exit;
capDriverGetCaps(ghCapWnd, LongInt(@CDrvCaps), sizeof(TCapDriverCaps));
Result := CDrvCaps.fHasDlgVideoDisplay;
end;
(*---------------------------------------------------------------*)
function CapHasDlgVSource : Boolean;
var
CDrvCaps : TCapDriverCaps;
begin
Result := TRUE;
if ghCapWnd = 0 then exit;
capDriverGetCaps(ghCapWnd, LongInt(@CDrvCaps), sizeof(TCapDriverCaps));
Result := CDrvCaps.fHasDlgVideoSource;
end;
(*---------------------------------------------------------------*)
procedure CapDlgVFormat;
begin
if ghCapWnd = 0 then exit;
capDlgVideoFormat(ghCapWnd);
end;
(*---------------------------------------------------------------*)
procedure CapDlgVDisplay;
begin
if ghCapWnd = 0 then exit;
capDlgVideoDisplay(ghCapWnd);
end;
(*---------------------------------------------------------------*)
procedure CapDlgVSource;
begin
if ghCapWnd = 0 then exit;
capDlgVideoSource(ghCapWnd);
end;
(*---------------------------------------------------------------*)
procedure CapSetVideoOverlay;
begin
if ghCapWnd = 0 then exit;
capPreview(ghCapWnd, 0);
capOverlay(ghCapWnd, 1);
end;
(*---------------------------------------------------------------*)
procedure CapSetVideoLive;
begin
if ghCapWnd = 0 then exit;
capOverlay(ghCapWnd, 0);
capPreviewScale(ghCapWnd, 1);
capPreviewRate(ghCapWnd, MS_FOR_25FPS);
capPreview(ghCapWnd, 1);
end;
(*---------------------------------------------------------------*)
procedure CapGrabSingleFrame;
var
achSingleFileName : array [0..255] of Char;
begin
if ghCapWnd = 0 then exit;
capGrabFrame(ghCapWnd);
StrPCopy(achSingleFileName, gCapSingleImageFileName);
capFileSaveDIB(ghCapWnd, LongInt(@achSingleFileName));
end;
initialization
ghCapWnd := 0;
gCapVideoArea := nil;
gCapVideoDriverName := 'No Driver';
gdwCapNofMaxVideoFrame := 0;
gCapVideoFileName := 'Video.avi';
gCapSingleImageFileName := 'Image.bmp';
gCapVideoInfoLabel := nil;
gCapStatusProcedure := nil;
end.
unit VideoMci;
interface
uses Windows, SysUtils, Graphics, Controls, MMSystem, VfW;
type
TMciStatusProc = procedure(Sender: TObject) of object;
var
gMciVideoArea : TWinControl;
gMciVideoFileName : string;
gMciActive : boolean;
gMciStatusProcedure : TMciStatusProc;
gMciVideoHandle : THandle;
procedure MciSetVideoArea( Container: TWinControl );
procedure MciSetVideoFileName( FileName : string );
procedure MciSetStatusProcedure( StatusProc : TMciStatusProc );
procedure MciSetVideoHandle( hVideo: THandle );
procedure MciVideoCommand( TheCommand : string );
function MciReturnVideoCommand( TheCommand : string ) : string;
procedure MciOpen;
procedure MciClose;
procedure MciStart;
procedure MciStop;
procedure MciSeek( Position : Integer );
function MciGetPos: Integer;
procedure MciPlay( FromPos : Integer );
function MciGetNoOfFrames : Integer;
function MciFrameToBmp( TmpBmp : TBitmap ) : Boolean;
procedure MciNotify;
implementation
(*---------------------------------------------------------------*)
(*--- M C I - V I D E O D R I V E R ---*)
(*---------------------------------------------------------------*)
uses WVideo;
(*---------------------------------------------------------------*)
procedure MciSetVideoArea( Container: TWinControl );
begin
gMciVideoArea := Container;
end;
(*---------------------------------------------------------------*)
procedure MciSetVideoFileName( FileName : string );
begin
gMciVideoFileName := FileName;
end;
(*---------------------------------------------------------------*)
procedure MciSetStatusProcedure( StatusProc : TMciStatusProc );
begin
gMciStatusProcedure := StatusProc;
end;
(*---------------------------------------------------------------*)
procedure MciSetVideoHandle( hVideo: THandle );
begin
gMciVideoHandle := hVideo;
end;
(*---------------------------------------------------------------*)
procedure MciVideoCommand( TheCommand : string );
var
FError : LongInt;
ReturnStr : array [0..255] of Char;
// ErrorStr : array [0..127] of Char;
begin
FError := mciSendString( PChar(TheCommand), ReturnStr, 255, gMciVideoHandle );
if FError <> 0 then
begin
gMciActive := FALSE;
(*
mciGetErrorString( FError, ErrorStr, 127 );
Showmessage(' Command : '+ TheCommand + #13 +
' Error : '+ string(ErrorStr) );
*)
end;
end;
(*---------------------------------------------------------------*)
function MciReturnVideoCommand( TheCommand : string ) : string;
var
FError : LongInt;
ReturnStr : array [0..255] of Char;
// ErrorStr : array [0..127] of Char;
begin
FError := mciSendString( PChar(TheCommand), ReturnStr, 255, gMciVideoHandle );
if FError <> 0 then
begin
gMciActive := FALSE;
(*
mciGetErrorString( FError, ErrorStr, 127 );
Showmessage(' Command : '+ TheCommand + #13 +
' Error : '+ string(ErrorStr) );
*)
end;
Result := StrPas( ReturnStr );
end;
(*---------------------------------------------------------------*)
procedure MciNotify;
begin
if @gMciStatusProcedure <> nil then gMciStatusProcedure(nil);
// PostMessage( gdwAppHwnd, Mci_REV_MSG_Status, 0, LongInt(50) );
end;
(*---------------------------------------------------------------*)
procedure MciOpen;
begin
gMciActive := TRUE;
if gMciActive then MciVideoCommand( 'open '
+ gMciVideoFileName + ' alias KruwoVideo style child parent '
+ IntToStr(gMciVideoArea.Handle) + ' wait' );
if gMciActive then MciVideoCommand( 'put KruwoVideo window at '
+ IntToStr(gMciVideoArea.Left-5) + ' '
+ IntToStr(gMciVideoArea.Top-5) + ' '
+ IntToStr(gMciVideoArea.Width) + ' '
+ IntToStr(gMciVideoArea.Height) + ' wait' );
if gMciActive then MciVideoCommand( 'set KruwoVideo seek exactly off wait' );
end;
(*---------------------------------------------------------------*)
procedure MciClose;
begin
if gMciActive then MciVideoCommand( 'close KruwoVideo wait' );
end;
(*---------------------------------------------------------------*)
procedure MciStart;
begin
if gMciActive then MciVideoCommand( 'play KruwoVideo from 0 notify' );
end;
(*---------------------------------------------------------------*)
procedure MciStop;
begin
if gMciActive then MciVideoCommand( 'stop KruwoVideo wait' );
end;
(*---------------------------------------------------------------*)
procedure MciSeek( Position : Integer );
begin
if gMciActive then MciVideoCommand( 'seek KruwoVideo to '+IntToStr(Position)+' wait' );
end;
(*---------------------------------------------------------------*)
function MciGetPos: Integer;
var
PosStr : string;
begin
PosStr := MciReturnVideoCommand('status KruwoVideo position wait');
if Length(PosStr) <= 0
then Result := 0
else Result := LongInt(StrToInt(PosStr));
end;
(*---------------------------------------------------------------*)
procedure MciPlay( FromPos : Integer );
begin
if gMciActive then MciVideoCommand( 'play KruwoVideo from '
+ IntToStr(FromPos) + ' notify' );
end;
(*---------------------------------------------------------------*)
function MciGetNoOfFrames : Integer;
var
retc : Integer;
pfile : PAVIFile;
gapavi : PAVIStream; // the current stream
asi : TAVIStreamInfo;
begin
Result := -1;
// Open and Save Video
AVIFileInit;
retc := AVIFileOpen(pfile, PChar(gMciVideoFileName), 0, nil);
if retc <> 0 then
begin
AVIFileExit;
exit;
end;
retc := AVIFileGetStream(pfile, gapavi, 0, 0);
if retc <> AVIERR_OK then
begin
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
// Get some info about this stream
retc := AVIStreamInfo(gapavi, asi, sizeof(asi));
if retc <> AVIERR_OK then
begin
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
if asi.fccType <> streamtypeVIDEO
then Result := -1
else Result := asi.dwLength;
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
end;
(*---------------------------------------------------------------*)
function MciFrameToBmp( TmpBmp : TBitmap ) : Boolean;
var
CurrentPos : Integer;
retc : Integer;
pfile : PAVIFile;
gapavi : PAVIStream; // the current stream
gapgf : PGETFRAME; // data for decompressing video
lpbi : PBITMAPINFOHEADER;
bits : PChar;
hBmp : HBITMAP;
begin
Result := FALSE;
CurrentPos := MciGetPos;
// Open and Save Video
AVIFileInit;
retc := AVIFileOpen(pfile, PChar(gMciVideoFileName), 0, nil);
if retc <> 0 then
begin
AVIFileExit;
exit;
end;
retc := AVIFileGetStream(pfile, gapavi, 0, 0);
if retc <> AVIERR_OK then
begin
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
gapgf := AVIStreamGetFrameOpen(gapavi, nil);
if gapgf = nil then
begin
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
// Read current Frame
lpbi := AVIStreamGetFrame(gapgf, CurrentPos);
if lpbi = nil then
begin
AVIStreamGetFrameClose(gapgf);
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
exit;
end;
TmpBmp.Height := lpbi.biHeight;
TmpBmp.Width := lpbi.biWidth;
bits := Pointer(Integer(lpbi) + sizeof(TBITMAPINFOHEADER));
hBmp := CreateDIBitmap(
GetDC(gMciVideoArea.Handle), // handle of device context
lpbi^, // address of bitmap size and format data
CBM_INIT, // initialization flag
bits, // address of initialization data
PBITMAPINFO(lpbi)^, // address of bitmap color-format data
DIB_RGB_COLORS ); // color-data usage
TmpBmp.Handle := hBmp;
Result := TRUE;
AVIStreamGetFrameClose(gapgf);
AVIStreamRelease(gapavi);
AVIFileRelease(pfile);
AVIFileExit;
end;
initialization
gMciVideoFileName := 'Video.avi';
gMciActive := FALSE;
gMciStatusProcedure := nil;
end.
unit AviCap;
interface
uses
Windows, MMSystem, Messages;
const
// ------------------------------------------------------------------
// Window Messages WM_CAP... which can be sent to an AVICAP window
// ------------------------------------------------------------------
// Defines start of the message range
WM_CAP_START = WM_USER;
WM_CAP_GET_CAPSTREAMPTR = (WM_CAP_START+ 1);
WM_CAP_SET_CALLBACK_ERROR = (WM_CAP_START+ 2);
WM_CAP_SET_CALLBACK_STATUS = (WM_CAP_START+ 3);
WM_CAP_SET_CALLBACK_YIELD = (WM_CAP_START+ 4);
WM_CAP_SET_CALLBACK_FRAME = (WM_CAP_START+ 5);
WM_CAP_SET_CALLBACK_VIDEOSTREAM = (WM_CAP_START+ 6);
WM_CAP_SET_CALLBACK_WAVESTREAM = (WM_CAP_START+ 7);
WM_CAP_GET_USER_DATA = (WM_CAP_START+

WM_CAP_SET_USER_DATA = (WM_CAP_START+ 9);
WM_CAP_DRIVER_CONNECT = (WM_CAP_START+ 10);
WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START+ 11);
WM_CAP_DRIVER_GET_NAME = (WM_CAP_START+ 12);
WM_CAP_DRIVER_GET_VERSION = (WM_CAP_START+ 13);
WM_CAP_DRIVER_GET_CAPS = (WM_CAP_START+ 14);
WM_CAP_FILE_SET_CAPTURE_FILE = (WM_CAP_START+ 20);
WM_CAP_FILE_GET_CAPTURE_FILE = (WM_CAP_START+ 21);
WM_CAP_FILE_ALLOCATE = (WM_CAP_START+ 22);
WM_CAP_FILE_SAVEAS = (WM_CAP_START+ 23);
WM_CAP_FILE_SET_INFOCHUNK = (WM_CAP_START+ 24);
WM_CAP_FILE_SAVEDIB = (WM_CAP_START+ 25);
WM_CAP_EDIT_COPY = (WM_CAP_START+ 30);
WM_CAP_SET_AUDIOFORMAT = (WM_CAP_START+ 35);
WM_CAP_GET_AUDIOFORMAT = (WM_CAP_START+ 36);
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_GET_VIDEOFORMAT = (WM_CAP_START+ 44);
WM_CAP_SET_VIDEOFORMAT = (WM_CAP_START+ 45);
WM_CAP_DLG_VIDEOCOMPRESSION = (WM_CAP_START+ 46);
WM_CAP_SET_PREVIEW = (WM_CAP_START+ 50);
WM_CAP_SET_OVERLAY = (WM_CAP_START+ 51);
WM_CAP_SET_PREVIEWRATE = (WM_CAP_START+ 52);
WM_CAP_SET_SCALE = (WM_CAP_START+ 53);
WM_CAP_GET_STATUS = (WM_CAP_START+ 54);
WM_CAP_SET_SCROLL = (WM_CAP_START+ 55);
WM_CAP_GRAB_FRAME = (WM_CAP_START+ 60);
WM_CAP_GRAB_FRAME_NOSTOP = (WM_CAP_START+ 61);
WM_CAP_SEQUENCE = (WM_CAP_START+ 62);
WM_CAP_SEQUENCE_NOFILE = (WM_CAP_START+ 63);
WM_CAP_SET_SEQUENCE_SETUP = (WM_CAP_START+ 64);
WM_CAP_GET_SEQUENCE_SETUP = (WM_CAP_START+ 65);
WM_CAP_SET_MCI_DEVICE = (WM_CAP_START+ 66);
WM_CAP_GET_MCI_DEVICE = (WM_CAP_START+ 67);
WM_CAP_STOP = (WM_CAP_START+ 68);
WM_CAP_ABORT = (WM_CAP_START+ 69);
WM_CAP_SINGLE_FRAME_OPEN = (WM_CAP_START+ 70);
WM_CAP_SINGLE_FRAME_CLOSE = (WM_CAP_START+ 71);
WM_CAP_SINGLE_FRAME = (WM_CAP_START+ 72);
WM_CAP_PAL_OPEN = (WM_CAP_START+ 80);
WM_CAP_PAL_SAVE = (WM_CAP_START+ 81);
WM_CAP_PAL_PASTE = (WM_CAP_START+ 82);
WM_CAP_PAL_AUTOCREATE = (WM_CAP_START+ 83);
WM_CAP_PAL_MANUALCREATE = (WM_CAP_START+ 84);
// Following added post VFW 1.1
WM_CAP_SET_CALLBACK_CAPCONTROL = (WM_CAP_START+ 85);
// Defines end of the message range
WM_CAP_END = WM_CAP_SET_CALLBACK_CAPCONTROL;
// ------------------------------------------------------------------
// Message crackers for above
// ------------------------------------------------------------------
function capSetCallbackOnError (hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnStatus(hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnYield (hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnFrame (hwnd : THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnVideoStream(hwnd:THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnWaveStream (hwnd:THandle; fpProc:LongInt):LongInt;
function capSetCallbackOnCapControl (hwnd:THandle; fpProc:LongInt):LongInt;
function capSetUserData(hwnd:THandle; lUser:LongInt):LongInt;
function capGetUserData(hwnd:THandle):LongInt;
function capDriverConnect(hwnd:THandle; I: Word) : LongInt;
function capDriverDisconnect(hwnd:THandle):LongInt;
function capDriverGetName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
function capDriverGetVersion(hwnd:THandle; szVer:LongInt; wSize:Word):LongInt;
function capDriverGetCaps(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capFileSetCaptureFile(hwnd:THandle; szName:LongInt):LongInt;
function capFileGetCaptureFile(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
function capFileAlloc(hwnd:THandle; dwSize:LongInt):LongInt;
function capFileSaveAs(hwnd:THandle; szName:LongInt):LongInt;
function capFileSetInfoChunk(hwnd:THandle; lpInfoChunk:LongInt):LongInt;
function capFileSaveDIB(hwnd:THandle; szName:LongInt):LongInt;
function capEditCopy(hwnd : THandle):LongInt;
function capSetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capGetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capGetAudioFormatSize(hwnd:THandle):LongInt;
function capDlgVideoFormat(hwnd:THandle):LongInt;
function capDlgVideoSource(hwnd:THandle):LongInt;
function capDlgVideoDisplay(hwnd:THandle):LongInt;
function capDlgVideoCompression(hwnd:THandle):LongInt;
function capGetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capGetVideoFormatSize(hwnd:THandle):LongInt;
function capSetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capPreview(hwnd:THandle; f:Word):LongInt;
function capPreviewRate(hwnd:THandle; wMS:Word):LongInt;
function capOverlay(hwnd:THandle; f:Word):LongInt;
function capPreviewScale(hwnd:THandle; f:Word):LongInt;
function capGetStatus(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capSetScrollPos(hwnd:THandle; lpP:LongInt):LongInt;
function capGrabFrame(hwnd:THandle):LongInt;
function capGrabFrameNoStop(hwnd:THandle):LongInt;
function capCaptureSequence(hwnd:THandle):LongInt;
function capCaptureSequenceNoFile(hwnd:THandle):LongInt;
function capCaptureStop(hwnd:THandle):LongInt;
function capCaptureAbort(hwnd:THandle):LongInt;
function capCaptureSingleFrameOpen(hwnd:THandle):LongInt;
function capCaptureSingleFrameClose(hwnd:THandle):LongInt;
function capCaptureSingleFrame(hwnd:THandle):LongInt;
function capCaptureGetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capCaptureSetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
function capSetMCIDeviceName(hwnd:THandle; szName:LongInt):LongInt;
function capGetMCIDeviceName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
function capPaletteOpen(hwnd:THandle; szName:LongInt):LongInt;
function capPaletteSave(hwnd:THandle; szName:LongInt):LongInt;
function capPalettePaste(hwnd:THandle):LongInt;
function capPaletteAuto(hwnd:THandle; iFrames:Word; iColors:LongInt):LongInt;
function capPaletteManual(hwnd:THandle; fGrab:Word; iColors:LongInt):LongInt;
// ------------------------------------------------------------------
// Structures
// ------------------------------------------------------------------
type
PCapDriverCaps = ^TCapDriverCaps;
TCapDriverCaps = record
wDeviceIndex :WORD; // Driver index in system.ini
fHasOverlay :BOOL; // Can device overlay?
fHasDlgVideoSource :BOOL; // Has Video source dlg?
fHasDlgVideoFormat :BOOL; // Has Format dlg?
fHasDlgVideoDisplay :BOOL; // Has External out dlg?
fCaptureInitialized :BOOL; // Driver ready to capture?
fDriverSuppliesPalettes :BOOL; // Can driver make palettes?
hVideoIn :THANDLE; // Driver In channel
hVideoOut :THANDLE; // Driver Out channel
hVideoExtIn :THANDLE; // Driver Ext In channel
hVideoExtOut :THANDLE; // Driver Ext Out channel
end;
PCapStatus = ^TCapStatus;
TCapStatus = packed record
uiImageWidth :UINT; // Width of the image
uiImageHeight :UINT; // Height of the image
fLiveWindow :BOOL; // Now Previewing video?
fOverlayWindow :BOOL; // Now Overlaying video?
fScale :BOOL; // Scale image to client?
ptScroll :TPOINT; // Scroll position
fUsingDefaultPalette :BOOL; // Using default driver palette?
fAudioHardware :BOOL; // Audio hardware present?
fCapFileExists :BOOL; // Does capture file exist?
dwCurrentVideoFrame

dwCurrentVideoFramesDropped

dwCurrentWaveSamples

dwCurrentTimeElapsedMS

hPalCurrent :HPALETTE; // Current palette in use
fCapturingNow :BOOL; // Capture in progress?
dwReturn

wNumVideoAllocated :WORD; // Actual number of video buffers
wNumAudioAllocated :WORD; // Actual number of audio buffers
end;
PCaptureParms = ^TCaptureParms;
TCaptureParms = record // Default values in parenthesis
dwRequestMicroSecPerFrame

fMakeUserHitOKToCapture :BOOL; // Show "Hit OK to cap" dlg?
wPercentDropForError :WORD; // Give error msg if > (10%)
fYield :BOOL; // Capture via background task?
dwIndexSize

wChunkGranularity :WORD; // Junk chunk granularity (2K)
fUsingDOSMemory :BOOL; // Use DOS buffers?
wNumVideoRequested :WORD; // # video buffers, If 0, autocalc
fCaptureAudio :BOOL; // Capture audio?
wNumAudioRequested :WORD; // # audio buffers, If 0, autocalc
vKeyAbort :WORD; // Virtual key causing abort
fAbortLeftMouse :BOOL; // Abort on left mouse?
fAbortRightMouse :BOOL; // Abort on right mouse?
fLimitEnabled :BOOL; // Use wTimeLimit?
wTimeLimit :WORD; // Seconds to capture
fMCIControl :BOOL; // Use MCI video source?
fStepMCIDevice :BOOL; // Step MCI device?
dwMCIStartTime

dwMCIStopTime

fStepCaptureAt2x :BOOL; // Perform spatial averaging 2x
wStepCaptureAverageFrames :WORD; // Temporal average n Frames
dwAudioBufferSize

fDisableWriteCache :BOOL; // Attempt to disable write cache
AVStreamMaster :WORD; // Indicates whether the audio stream
// controls the clock when writing an AVI file.
end;
PCapInfoChunk = ^TCapInfoChunk;
TCapInfoChunk = record
fccInfoID :FOURCC; // Chunk ID, "ICOP" for copyright
lpData :LongInt; // pointer to data
cbData :LongInt; // size of lpData
end;
// ------------------------------------------------------------------
// Callback Definitions
// ------------------------------------------------------------------
type
TCAPSTATUSCALLBACK = function(hWnd:HWND; nID:Integer; lpsz:LongInt):LongInt; stdcall;
TCAPYIELDCALLBACK = function(hWnd:HWND):LongInt; stdcall;
TCAPERRORCALLBACK = function(hWnd:HWND; nID:Integer; lpsz:LongInt):LongInt; stdcall;
TCAPVIDEOCALLBACK = function(hWnd:HWND; lpVHdr:LongInt):LongInt; stdcall;
TCAPWAVECALLBACK = function(hWnd:HWND; lpWHdr:LongInt):LongInt; stdcall;
TCAPCONTROLCALLBACK = function(hWnd:HWND; nState:Integer):LongInt; stdcall;
// ------------------------------------------------------------------
// CapControlCallback states
// ------------------------------------------------------------------
Const
CONTROLCALLBACK_PREROLL = 1; // Waiting to start capture
CONTROLCALLBACK_CAPTURING = 2; // Now capturing
// ------------------------------------------------------------------
// The only exported functions from AVICAP.DLL
// ------------------------------------------------------------------
function capCreateCaptureWindow (
lpszWindowName : PChar;
dwStyle : DWord;
x, y : Integer;
nWidth, nHeight : Integer;
hwndParent : THandle;
nID : Integer ) : THandle; stdcall;
function capGetDriverDescription (
wDriverIndex : DWord;
lpszName : PChar;
cbName : Integer;
lpszVer : PChar;
cbVer : Integer ) : Boolean; stdcall;
// ------------------------------------------------------------------
// New Information chunk IDs
// ------------------------------------------------------------------
(*
infotypeDIGITIZATION_TIME = mmioStringToFOURCC(PChar('IDIT'), MMIO_TOUPPER);
infotypeSMPTE_TIME = mmioStringToFOURCC(PChar('ISMP'), MMIO_TOUPPER);
*)
// ------------------------------------------------------------------
// String IDs from status and error callbacks
// ------------------------------------------------------------------
Const
IDS_CAP_BEGIN = 300; (* "Capture Start" *)
IDS_CAP_END = 301; (* "Capture End" *)
IDS_CAP_INFO = 401; (* "%s" *)
IDS_CAP_OUTOFMEM = 402; (* "Out of memory" *)
IDS_CAP_FILEEXISTS = 403; (* "File '%s' exists -- overwrite it?" *)
IDS_CAP_ERRORPALOPEN = 404; (* "Error opening palette '%s'" *)
IDS_CAP_ERRORPALSAVE = 405; (* "Error saving palette '%s'" *)
IDS_CAP_ERRORDIBSAVE = 406; (* "Error saving frame '%s'" *)
IDS_CAP_DEFAVIEXT = 407; (* "avi" *)
IDS_CAP_DEFPALEXT = 408; (* "pal" *)
IDS_CAP_CANTOPEN = 409; (* "Cannot open '%s'" *)
IDS_CAP_SEQ_MSGSTART = 410; (* "Select OK to start capture\nof video sequence\nto %s." *)
IDS_CAP_SEQ_MSGSTOP = 411; (* "Hit ESCAPE or click to end capture" *)
IDS_CAP_VIDEDITERR = 412; (* "An error occurred while trying to run VidEdit." *)
IDS_CAP_READONLYFILE = 413; (* "The file '%s' is a read-only file." *)
IDS_CAP_WRITEERROR = 414; (* "Unable to write to file '%s'.\nDisk may be full." *)
IDS_CAP_NODISKSPACE = 415; (* "There is no space to create a capture file on the specified device." *)
IDS_CAP_SETFILESIZE = 416; (* "Set File Size" *)
IDS_CAP_SAVEASPERCENT = 417; (* "SaveAs: %2ld%% Hit Escape to abort." *)
IDS_CAP_DRIVER_ERROR = 418; (* Driver specific error message *)
IDS_CAP_WAVE_OPEN_ERROR = 419; (* "Error: Cannot open the wave input device.\nCheck sample size, frequency, and channels." *)
IDS_CAP_WAVE_ALLOC_ERROR = 420; (* "Error: Out of memory for wave buffers." *)
IDS_CAP_WAVE_PREPARE_ERROR = 421; (* "Error: Cannot prepare wave buffers." *)
IDS_CAP_WAVE_ADD_ERROR = 422; (* "Error: Cannot add wave buffers." *)
IDS_CAP_WAVE_SIZE_ERROR = 423; (* "Error: Bad wave size." *)
IDS_CAP_VIDEO_OPEN_ERROR = 424; (* "Error: Cannot open the video input device." *)
IDS_CAP_VIDEO_ALLOC_ERROR = 425; (* "Error: Out of memory for video buffers." *)
IDS_CAP_VIDEO_PREPARE_ERROR = 426; (* "Error: Cannot prepare video buffers." *)
IDS_CAP_VIDEO_ADD_ERROR = 427; (* "Error: Cannot add video buffers." *)
IDS_CAP_VIDEO_SIZE_ERROR = 428; (* "Error: Bad video size." *)
IDS_CAP_FILE_OPEN_ERROR = 429; (* "Error: Cannot open capture file." *)
IDS_CAP_FILE_WRITE_ERROR = 430; (* "Error: Cannot write to capture file. Disk may be full." *)
IDS_CAP_RECORDING_ERROR = 431; (* "Error: Cannot write to capture file. Data rate too high or disk full." *)
IDS_CAP_RECORDING_ERROR2 = 432; (* "Error while recording" *)
IDS_CAP_AVI_INIT_ERROR = 433; (* "Error: Unable to initialize for capture." *)
IDS_CAP_NO_FRAME_CAP_ERROR = 434; (* "Warning: No frames captured.\nConfirm that vertical sync interrupts\nare configured and enabled." *)
IDS_CAP_NO_PALETTE_WARN = 435; (* "Warning: Using default palette." *)
IDS_CAP_MCI_CONTROL_ERROR = 436; (* "Error: Unable to access MCI device." *)
IDS_CAP_MCI_CANT_STEP_ERROR = 437; (* "Error: Unable to step MCI device." *)
IDS_CAP_NO_AUDIO_CAP_ERROR = 438; (* "Error: No audio data captured.\nCheck audio card settings." *)
IDS_CAP_AVI_DRAWDIB_ERROR = 439; (* "Error: Unable to draw this data format." *)
IDS_CAP_COMPRESSOR_ERROR = 440; (* "Error: Unable to initialize compressor." *)
IDS_CAP_AUDIO_DROP_ERROR = 441; (* "Error: Audio data was lost during capture, reduce capture rate." *)
(* status string IDs *)
IDS_CAP_STAT_LIVE_MODE = 500; (* "Live window" *)
IDS_CAP_STAT_OVERLAY_MODE = 501; (* "Overlay window" *)
IDS_CAP_STAT_CAP_INIT = 502; (* "Setting up for capture - Please wait" *)
IDS_CAP_STAT_CAP_FINI = 503; (* "Finished capture, now writing frame %ld" *)
IDS_CAP_STAT_PALETTE_BUILD = 504; (* "Building palette map" *)
IDS_CAP_STAT_OPTPAL_BUILD = 505; (* "Computing optimal palette" *)
IDS_CAP_STAT_I_FRAMES = 506; (* "%d frames" *)
IDS_CAP_STAT_L_FRAMES = 507; (* "%ld frames" *)
IDS_CAP_STAT_CAP_L_FRAMES = 508; (* "Captured %ld frames" *)
IDS_CAP_STAT_CAP_AUDIO = 509; (* "Capturing audio" *)
IDS_CAP_STAT_VIDEOCURRENT = 510; (* "Captured %ld frames (%ld dropped) %d.%03d sec." *)
IDS_CAP_STAT_VIDEOAUDIO = 511; (* "Captured %d.%03d sec. %ld frames (%ld dropped) (%d.%03d fps). %ld audio bytes (%d,%03d sps)" *)
IDS_CAP_STAT_VIDEOONLY = 512; (* "Captured %d.%03d sec. %ld frames (%ld dropped) (%d.%03d fps)" *)
IDS_CAP_STAT_FRAMESDROPPED = 513; (* "Dropped %ld of %ld frames (%d.%02d%%) during capture." *)
const
AVICAP32 = 'AVICAP32.dll';
implementation
(* Externals from AVICAP.DLL *)
function capGetDriverDescription; external AVICAP32 name 'capGetDriverDescriptionA';
function capCreateCaptureWindow; external AVICAP32 name 'capCreateCaptureWindowA';
(* Message crackers for above *)
function capSetCallbackOnError(hwnd : THandle; fpProc:LongInt) : LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_ERROR, 0, fpProc);
end;
function capSetCallbackOnStatus(hwnd : THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_STATUS, 0, fpProc);
end;
function capSetCallbackOnYield (hwnd : THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_YIELD, 0, fpProc);
end;
function capSetCallbackOnFrame (hwnd : THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_FRAME, 0, fpProc);
end;
function capSetCallbackOnVideoStream(hwnd:THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, fpProc);
end;
function capSetCallbackOnWaveStream (hwnd:THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_WAVESTREAM, 0, fpProc);
end;
function capSetCallbackOnCapControl (hwnd:THandle; fpProc:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_CAPCONTROL, 0, fpProc);
end;
function capSetUserData(hwnd:THandle; lUser:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_USER_DATA, 0, lUser);
end;
function capGetUserData(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_USER_DATA, 0, 0);
end;
function capDriverConnect(hwnd:THandle; I: Word) : LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_CONNECT, I, 0);
end;
function capDriverDisconnect(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
end;
function capDriverGetName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_GET_NAME, wSize, szName);
end;
function capDriverGetVersion(hwnd:THandle; szVer:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_GET_VERSION, wSize, szVer);
end;
function capDriverGetCaps(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DRIVER_GET_CAPS, wSize, s);
end;
function capFileSetCaptureFile(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_SET_CAPTURE_FILE, 0, szName);
end;
function capFileGetCaptureFile(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_GET_CAPTURE_FILE, wSize, szName);
end;
function capFileAlloc(hwnd:THandle; dwSize:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_ALLOCATE, 0, dwSize);
end;
function capFileSaveAs(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_SAVEAS, 0, szName);
end;
function capFileSetInfoChunk(hwnd:THandle; lpInfoChunk:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_SET_INFOCHUNK, 0, lpInfoChunk);
end;
function capFileSaveDIB(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_FILE_SAVEDIB, 0, szName);
end;
function capEditCopy(hwnd : THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_EDIT_COPY, 0, 0);
end;
function capSetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_AUDIOFORMAT, wSize, s);
end;
function capGetAudioFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_AUDIOFORMAT, wSize, s);
end;
function capGetAudioFormatSize(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_AUDIOFORMAT, 0, 0);
end;
function capDlgVideoFormat(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
end;
function capDlgVideoSource(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0);
end;
function capDlgVideoDisplay(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DLG_VIDEODISPLAY, 0, 0);
end;
function capDlgVideoCompression(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0);
end;
function capGetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, wSize, s);
end;
function capGetVideoFormatSize(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0);
end;
function capSetVideoFormat(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_VIDEOFORMAT, wSize, s);
end;
function capPreview(hwnd:THandle; f:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_PREVIEW, f, 0);
end;
function capPreviewRate(hwnd:THandle; wMS:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_PREVIEWRATE, wMS, 0);
end;
function capOverlay(hwnd:THandle; f:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_OVERLAY, f, 0);
end;
function capPreviewScale(hwnd:THandle; f:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_SCALE, f, 0);
end;
function capGetStatus(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_STATUS, wSize, s);
end;
function capSetScrollPos(hwnd:THandle; lpP:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_SCROLL, 0, lpP);
end;
function capGrabFrame(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GRAB_FRAME, 0, 0);
end;
function capGrabFrameNoStop(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0);
end;
function capCaptureSequence(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SEQUENCE, 0, 0);
end;
function capCaptureSequenceNoFile(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SEQUENCE_NOFILE, 0, 0);
end;
function capCaptureStop(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_STOP, 0, 0);
end;
function capCaptureAbort(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_ABORT, 0, 0);
end;
function capCaptureSingleFrameOpen(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME_OPEN, 0, 0);
end;
function capCaptureSingleFrameClose(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME_CLOSE, 0, 0);
end;
function capCaptureSingleFrame(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SINGLE_FRAME, 0, 0);
end;
function capCaptureGetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_SEQUENCE_SETUP, wSize, s);
end;
function capCaptureSetSetup(hwnd:THandle; s:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_SEQUENCE_SETUP, wSize, s);
end;
function capSetMCIDeviceName(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_MCI_DEVICE, 0, szName);
end;
function capGetMCIDeviceName(hwnd:THandle; szName:LongInt; wSize:Word):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_GET_MCI_DEVICE, wSize, szName);
end;
function capPaletteOpen(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_OPEN, 0, szName);
end;
function capPaletteSave(hwnd:THandle; szName:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_SAVE, 0, szName);
end;
function capPalettePaste(hwnd:THandle):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_PASTE, 0, 0);
end;
function capPaletteAuto(hwnd:THandle; iFrames:Word; iColors:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_AUTOCREATE, iFrames, iColors);
end;
function capPaletteManual(hwnd:THandle; fGrab:Word; iColors:LongInt):LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_PAL_MANUALCREATE, fGrab, iColors);
end;
end.