avicap32.pas哪里有，我想做个视频扑捉程序------在线等（急）(30分)

一定送分

去下一个Jvcl3.0吧，那里面有个视频捕捉控件，而且还有个例子，免费的。在www.playicq.com上有.

avicap32.pas 是 avicap.pas 新版本？
如果要把视频扑捉程序做好，建议买一块带 SDK 的捕捉卡，直接调用SDK.
俺上次为了在程序里解决 N制式 和 P制式转换 买了一块 天敏 SDK 2000 视频捕捉卡

avicap.pas原码：
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 + 8);
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;

// dwFlags field of TVIDEOHDR
VHDR_DONE = $00000001; // Done bit */
VHDR_PREPARED = $00000002; // Set if this header has been prepared */
VHDR_INQUEUE = $00000004; // Reserved for driver */
VHDR_KEYFRAME = $00000008; // Key Frame */

// ------------------------------------------------------------------
// 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 = 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: DWORD; // # of video frames cap'td
dwCurrentVideoFramesDropped: DWORD; // # of video frames dropped
dwCurrentWaveSamples: DWORD; // # of wave samples cap'td
dwCurrentTimeElapsedMS: DWORD; // Elapsed capture duration
hPalCurrent: HPALETTE; // Current palette in use
fCapturingNow: BOOL; // Capture in progress?
dwReturn: DWORD; // Error value after any operation
wNumVideoAllocated: UINT; // Actual number of video buffers
wNumAudioAllocated: UINT; // Actual number of audio buffers
end;

pCaptureParms = ^TCaptureParms;
TCaptureParms = record // Default values in parenthesis
dwRequestMicroSecPerFrame: DWORD; // Requested capture rate
fMakeUserHitOKToCapture: BOOL; // Show "Hit OK to cap" dlg?
wPercentDropForError: UINT; // Give error msg if > (10%)
fYield: BOOL; // Capture via background task?
dwIndexSize: DWORD; // Max index size in frames (32K)
wChunkGranularity: UINT; // Junk chunk granularity (2K)
fUsingDOSMemory: BOOL; // Use DOS buffers?
wNumVideoRequested: UINT; // # video buffers, If 0, autocalc
fCaptureAudio: BOOL; // Capture audio?
wNumAudioRequested: UINT; // # audio buffers, If 0, autocalc
vKeyAbort: UINT; // Virtual key causing abort
fAbortLeftMouse: BOOL; // Abort on left mouse?
fAbortRightMouse: BOOL; // Abort on right mouse?
fLimitEnabled: BOOL; // Use wTimeLimit?
wTimeLimit: UINT; // Seconds to capture
fMCIControl: BOOL; // Use MCI video source?
fStepMCIDevice: BOOL; // Step MCI device?
dwMCIStartTime: DWORD; // Time to start in MS
dwMCIStopTime: DWORD; // Time to stop in MS
fStepCaptureAt2x: BOOL; // Perform spatial averaging 2x
wStepCaptureAverageFrames: UINT; // Temporal average n Frames
dwAudioBufferSize: DWORD; // Size of audio bufs (0 = default)
fDisableWriteCache: BOOL; // Attempt to disable write cache
AVStreamMaster: UINT; // Which stream controls length?
end;

PCapInfoChunk = ^TCapInfoChunk;
TCapInfoChunk = record
fccInfoID: FOURCC; // Chunk ID, "ICOP" for copyright
lpData: Pointer; // pointer to data
cbData: LongInt; // size of lpData
end;

PVIDEOHDR = ^TVIDEOHDR;
TVIDEOHDR = record
lpData: pByte; // pointer to locked data buffer
dwBufferLength: DWORD; // Length of data buffer
dwBytesUsed: DWORD; // Bytes actually used
dwTimeCaptured: DWORD; // Milliseconds from start of stream
dwUser: DWORD; // for client's use
dwFlags: DWORD; // assorted flags (see defines)
dwReserved: array[0..4] of DWORD; // reserved for driver
end;

// ------------------------------------------------------------------
// Callback Definitions
// ------------------------------------------------------------------
type
TCAPSTATUSCALLBACK = function(hWnd: HWND; nID: Integer; lpsz: PChar): LongInt;
stdcall;
TCAPYIELDCALLBACK = function(hWnd: HWND): LongInt; stdcall;
TCAPERRORCALLBACK = function(hWnd: HWND; nID: Integer; lpsz: Pchar): LongInt;
stdcall;
TCAPVIDEOSTREAMCALLBACK = function(hWnd: HWND; lpVHdr: PVIDEOHDR): LongInt;
stdcall;
TCAPWAVESTREAMCALLBACK = function(hWnd: HWND; lpWHdr: PWAVEHDR): 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

// ------------------------------------------------------------------
// Message crackers for above
// ------------------------------------------------------------------
function capSetCallbackOnError(hwnd: THandle; fpProc: TCAPERRORCALLBACK):
LongInt;
function capSetCallbackOnStatus(hwnd: THandle; fpProc: TCAPSTATUSCALLBACK):
LongInt;
function capSetCallbackOnYield(hwnd: THandle; fpProc: TCAPYIELDCALLBACK):
LongInt;
function capSetCallbackOnFrame(hwnd: THandle; fpProc: Pointer): LongInt;
// Hier ist der Type der Callbackfunktion nicht klar !
function capSetCallbackOnVideoStream(hwnd: THandle; fpProc:
TCAPVIDEOSTREAMCALLBACK): LongInt;
function capSetCallbackOnWaveStream(hwnd: THandle; fpProc:
TCAPWAVESTREAMCALLBACK): LongInt;
function capSetCallbackOnCapControl(hwnd: THandle; fpProc: TCAPCONTROLCALLBACK):
LongInt;

function capSetUserData(hwnd: THandle; lUser: LongInt): LongInt;
function capGetUserData(hwnd: THandle): LongInt;

function capDriverConnect(hwnd: THandle; I: Word): boolean;
function capDriverDisconnect(hwnd: THandle): boolean;

function capDriverGetName(hwnd: THandle; szName: PChar; wSize: Word): boolean;
function capDriverGetVersion(hwnd: THandle; szVer: PChar; wSize: Word): Boolean;
function capDriverGetCaps(hwnd: THandle; s: PCapDriverCaps; wSize: Word):
boolean;

function capFileSetCaptureFile(hwnd: THandle; szName: PChar): boolean;
function capFileGetCaptureFile(hwnd: THandle; szName: PChar; wSize: Word):
boolean;
function capFileAlloc(hwnd: THandle; dwSize: DWORD): boolean;
function capFileSaveAs(hwnd: THandle; szName: Pchar): boolean;
function capFileSetInfoChunk(hwnd: THandle; lpInfoChunk: pCapInfoChunk):
boolean;
function capFileSaveDIB(hwnd: THandle; szName: Pchar): boolean;

function capEditCopy(hwnd: THandle): boolean;

function capSetAudioFormat(hwnd: THandle; s: PWaveFormatEx; wSize: Word):
Boolean;
function capGetAudioFormat(hwnd: THandle; s: PWaveFormatEx; wSize: Word): DWORD;
function capGetAudioFormatSize(hwnd: THandle): DWORD;

function capDlgVideoFormat(hwnd: THandle): boolean;
function capDlgVideoSource(hwnd: THandle): boolean;
function capDlgVideoDisplay(hwnd: THandle): boolean;
function capDlgVideoCompression(hwnd: THandle): boolean;

function capGetVideoFormat(hwnd: THandle; s: pBitmapInfo; wSize: Word): DWord;
function capGetVideoFormatSize(hwnd: THandle): DWORD;

function capSetVideoFormat(hwnd: THandle; s: pBitmapInfo; wSize: Word): boolean;

function capPreview(hwnd: THandle; f: boolean): boolean;
function capPreviewRate(hwnd: THandle; wMS: Word): boolean;
function capOverlay(hwnd: THandle; f: boolean): boolean;
function capPreviewScale(hwnd: THandle; f: boolean): boolean;
function capGetStatus(hwnd: THandle; s: pCapStatus; wSize: Word): boolean;
function capSetScrollPos(hwnd: THandle; lpP: pPoint): boolean;

function capGrabFrame(hwnd: THandle): boolean;
function capGrabFrameNoStop(hwnd: THandle): boolean;

function capCaptureSequence(hwnd: THandle): Boolean;
function capCaptureSequenceNoFile(hwnd: THandle): Boolean;
function capCaptureStop(hwnd: THandle): boolean;
function capCaptureAbort(hwnd: THandle): boolean;

function capCaptureSingleFrameOpen(hwnd: THandle): boolean;
function capCaptureSingleFrameClose(hwnd: THandle): boolean;
function capCaptureSingleFrame(hwnd: THandle): boolean;

function capCaptureGetSetup(hwnd: THandle; s: pCaptureParms; wSize: Word):
boolean;
function capCaptureSetSetup(hwnd: THandle; s: pCaptureParms; wSize: Word):
boolean;

function capSetMCIDeviceName(hwnd: THandle; szName: PChar): boolean;
function capGetMCIDeviceName(hwnd: THandle; szName: PChar; wSize: Word):
boolean;

function capPaletteOpen(hwnd: THandle; szName: PChar): boolean;
function capPaletteSave(hwnd: THandle; szName: PChar): boolean;
function capPalettePaste(hwnd: THandle): Boolean;
function capPaletteAuto(hwnd: THandle; iFrames: Word; iColors: word): boolean;
function capPaletteManual(hwnd: THandle; fGrab: Word; iColors: word): boolean;

// ------------------------------------------------------------------
// 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: TCAPERRORCALLBACK):
LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_ERROR, 0, LPARAM(@fpProc));
end;

function capSetCallbackOnStatus(hwnd: THandle; fpProc: TCAPSTATUSCALLBACK):
LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_STATUS, 0, LPARAM(@fpProc));
end;

function capSetCallbackOnYield(hwnd: THandle; fpProc: TCAPYIELDCALLBACK):
LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_YIELD, 0, LPARAM(@fpProc));
end;

function capSetCallbackOnFrame(hwnd: THandle; fpProc: POINTER): LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_FRAME, 0, LPARAM(fpProc));
end;

function capSetCallbackOnVideoStream(hwnd: THandle; fpProc:
TCAPVIDEOSTREAMCALLBACK): LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0,
LPARAM(@fpProc));
end;

function capSetCallbackOnWaveStream(hwnd: THandle; fpProc:
TCAPWAVESTREAMCALLBACK): LongInt;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_WAVESTREAM, 0,
LPARAM(@fpProc));
end;

function capSetCallbackOnCapControl(hwnd: THandle; fpProc: TCAPCONTROLCALLBACK):
longint;
begin
Result := SendMessage(hwnd, WM_CAP_SET_CALLBACK_CAPCONTROL, 0,
LPARAM(@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): boolean;
begin
Result := boolean(SendMessage(hwnd, WM_CAP_DRIVER_CONNECT, WPARAM(I), 0));
end;

function capDriverDisconnect(hwnd: THandle): Boolean;
begin
Result := boolean(SendMessage(hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0));
end;

function capDriverGetName(hwnd: THandle; szName: PChar; wSize: Word): boolean;
begin
Result := boolean(SendMessage(hwnd, WM_CAP_DRIVER_GET_NAME, WPARAM(wSize),
LPARAM(szName)));
end;

function capDriverGetVersion(hwnd: THandle; szVer: PChar; wSize: Word): boolean;
begin
Result := boolean(SendMessage(hwnd, WM_CAP_DRIVER_GET_VERSION, WPARAM(wSize),
LPARAM(szVer)));
end;

function capDriverGetCaps(hwnd: THandle; s: pCapDriverCaps; wSize: Word):
boolean;
begin
Result := boolean(SendMessage(hwnd, WM_CAP_DRIVER_GET_CAPS, WPARAM(wSize),
LPARAM(s)));
end;

function capFileSetCaptureFile(hwnd: THandle; szName: PChar): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_FILE_SET_CAPTURE_FILE, 0,
LPARAM(szName)));
end;

function capFileGetCaptureFile(hwnd: THandle; szName: PChar; wSize: Word):
Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_FILE_GET_CAPTURE_FILE, wSize,
LPARAM(szName)));
end;

function capFileAlloc(hwnd: THandle; dwSize: DWord): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_FILE_ALLOCATE, 0, LPARAM(dwSize)));
end;

function capFileSaveAs(hwnd: THandle; szName: Pchar): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_FILE_SAVEAS, 0, LPARAM(szName)));
end;

function capFileSetInfoChunk(hwnd: THandle; lpInfoChunk: pCapInfoChunk):
boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_FILE_SET_INFOCHUNK, 0,
LPARAM(lpInfoChunk)));
end;

function capFileSaveDIB(hwnd: THandle; szName: Pchar): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_FILE_SAVEDIB, 0, LPARAM(szName)));
end;

function capEditCopy(hwnd: THandle): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_EDIT_COPY, 0, 0));
end;

function capSetAudioFormat(hwnd: THandle; s: PWaveFormatEx; wSize: Word):
boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SET_AUDIOFORMAT, WPARAM(wSize),
LPARAM(s)));
end;

function capGetAudioFormat(hwnd: THandle; s: PWaveFormatEx; wSize: Word): DWORD;
begin
Result := DWORD(SendMessage(hwnd, WM_CAP_GET_AUDIOFORMAT, WPARAM(wSize),
LPARAM(s)));
end;

function capGetAudioFormatSize(hwnd: THandle): DWORD;
begin
Result := DWORD(SendMessage(hwnd, WM_CAP_GET_AUDIOFORMAT, 0, 0));
end;

function capDlgVideoFormat(hwnd: THandle): boolean;
begin
Result := boolean(SendMessage(hwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0));
end;

function capDlgVideoSource(hwnd: THandle): boolean;
begin
Result := boolean(SendMessage(hwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0));
end;

function capDlgVideoDisplay(hwnd: THandle): boolean;
begin
Result := boolean(SendMessage(hwnd, WM_CAP_DLG_VIDEODISPLAY, 0, 0));
end;

function capDlgVideoCompression(hwnd: THandle): boolean;
begin
Result := boolean(SendMessage(hwnd, WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0));
end;

function capGetVideoFormat(hwnd: THandle; s: pBitmapInfo; wSize: Word): DWord;
begin
Result := DWord(SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, Wparam(wSize),
LPARAM(s)));
end;

function capGetVideoFormatSize(hwnd: THandle): DWord;
begin
Result := DWord(SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0));
end;

function capSetVideoFormat(hwnd: THandle; s: PBitmapInfo; wSize: Word): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SET_VIDEOFORMAT, WPARAM(wSize),
LPARAM(s)));
end;

function capPreview(hwnd: THandle; f: boolean): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SET_PREVIEW, WPARAM(f), 0));
end;

function capPreviewRate(hwnd: THandle; wMS: Word): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SET_PREVIEWRATE, WPARAM(wMS), 0));
end;

function capOverlay(hwnd: THandle; f: boolean): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SET_OVERLAY, WPARAM(f), 0));
end;

function capPreviewScale(hwnd: THandle; f: boolean): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SET_SCALE, WPARAM(f), 0));
end;

function capGetStatus(hwnd: THandle; s: PCapStatus; wSize: Word): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_GET_STATUS, WPARAM(wSize),
LPARAM(s)));
end;

function capSetScrollPos(hwnd: THandle; lpP: pPoint): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SET_SCROLL, 0, LParam(lpP)));
end;

function capGrabFrame(hwnd: THandle): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_GRAB_FRAME, 0, 0));
end;

function capGrabFrameNoStop(hwnd: THandle): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0));
end;

function capCaptureSequence(hwnd: THandle): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SEQUENCE, 0, 0));
end;

function capCaptureSequenceNoFile(hwnd: THandle): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SEQUENCE_NOFILE, 0, 0));
end;

function capCaptureStop(hwnd: THandle): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_STOP, 0, 0));
end;

function capCaptureAbort(hwnd: THandle): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_ABORT, 0, 0));
end;

function capCaptureSingleFrameOpen(hwnd: THandle): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SINGLE_FRAME_OPEN, 0, 0));
end;

function capCaptureSingleFrameClose(hwnd: THandle): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SINGLE_FRAME_CLOSE, 0, 0));
end;

function capCaptureSingleFrame(hwnd: THandle): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SINGLE_FRAME, 0, 0));
end;

function capCaptureGetSetup(hwnd: THandle; s: pCaptureParms; wSize: Word):
boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_GET_SEQUENCE_SETUP, WPARAM(wSize),
LPARAM(s)));
end;

function capCaptureSetSetup(hwnd: THandle; s: pCaptureParms; wSize: Word):
boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SET_SEQUENCE_SETUP, WParam(wSize),
LParam(s)));
end;

function capSetMCIDeviceName(hwnd: THandle; szName: Pchar): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_SET_MCI_DEVICE, 0,
LParam(szName)));
end;

function capGetMCIDeviceName(hwnd: THandle; szName: Pchar; wSize: Word):
Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_GET_MCI_DEVICE, Wparam(wSize),
LPARAM(szName)));
end;

function capPaletteOpen(hwnd: THandle; szName: PChar): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_PAL_OPEN, 0, LParam(szName)));
end;

function capPaletteSave(hwnd: THandle; szName: PChar): boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_PAL_SAVE, 0, LParam(szName)));
end;

function capPalettePaste(hwnd: THandle): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_PAL_PASTE, 0, 0));
end;

function capPaletteAuto(hwnd: THandle; iFrames: Word; iColors: word): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_PAL_AUTOCREATE, WPARAM(iFrames),
LPARAM(iColors)));
end;

function capPaletteManual(hwnd: THandle; fGrab: Word; iColors: word): Boolean;
begin
Result := Boolean(SendMessage(hwnd, WM_CAP_PAL_MANUALCREATE, WPARAM(fGrab),
LPARAM(iColors)));
end;

end.
unit Video;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, stdctrls,
ExtCtrls, avicap, mmsystem, dsgnintf;

// Types for event-procedures
type
TCapStatusProc = procedure(Sender: TObject) of object;
TCapStatusCallback = procedure(Sender: TObject; nID: integer; status: string)
of object;
TVideoStream = procedure(sender: TObject; lpVhdr: PVIDEOHDR) of object;
TAudioStream = procedure(sender: TObject; lpWHdr: PWAVEHDR) of object;

// Property Editor for driver selection
type
TDrivereditor = class(TPropertyEditor)
function GetAttributes: TPropertyAttributes; override;
procedure GetValues(Proc: TGetStrProc); override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
end;

type
ENoDriverException = class(Exception);
type
ENoCapWindowException = class(Exception);
type
ENotConnectException = class(Exception);
type
ENoOverlayException = class(Exception);
type
EFalseFormat = class(Exception);

type
TVideo = class(TCustomControl)
private

fdriverIndex: integer; // Videodriver index
fVideoDriverName: string; // name of videodriver
fhCapWnd: THandle; // handle for CAP-Window
fpDrivercaps: PCapDriverCaps; // propertys of videodriver
fpDriverStatus: pCapStatus; // status of capdriver
fscale: boolean; // window scaling
fprop: boolean; // proportional scaling
fpreviewrate: word; // Frames p. sec during preview
fmicrosecpframe: cardinal; // framerate as microsconds
fCapVideoFileName: string; // name of the capture file
fCapSingleImageFileName: string; // name of the file for a single image
fcapAudio: boolean; // Capture also audio stream
fcapTimeLimit: word; // Time limit for captureing
fIndexSize: cardinal; // size of the index in the capture file
fcapToFile: boolean; // Write frames to file druing capturing

fCapStatusProcedure: TCapStatusProc;
// Event procedure for internal component status
fcapStatusCallBack: TCapStatusCallback;
// Event procedure for status of then driver
fcapVideoStream: TVideoStream; // Event procedure for each Video frame
fcapAudioStream: TAudiostream; // Event procedure for each Audio buffer

procedure setsize(var msg: TMessage); message WM_SIZE;
// Changing size of cap window
function GetDriverCaps: boolean; // get driver capitiyties
procedure DeleteDriverProps; // delete driver capitilyites
function GetDriverStatus(callback: boolean): boolean;
// Getting state of driver
procedure SetDriverOpen(value: boolean); // Open and Close the driver
function GetDriverOpen: boolean; // is Driver open ?
function GetPreview: boolean; // previwe mode
function GetOverlay: Boolean; // overlay eode;
procedure SizeCap; // calc size of the Capture Window
procedure Setprop(value: Boolean);
// Stretch Picture proportional to Window Size
procedure SetMicroSecPerFrame(value: cardinal);
// micro seconds between two frames
procedure setFrameRate(value: word); // Setting Frames p. second
function GetFrameRate: word; // Getting Frames p. second.

// Handlers for Propertys
procedure SetDriverName(value: string);
// Select Driver by setting driver name
procedure SetDriverIndex(value: integer);
// Select Driver by setting driver index
function CreateCapWindow: boolean; // Opening driver, create capture window
procedure DestroyCapwindow; // Closing Driver, destrying capture window
function GetCapWidth: word; // Width and Heigth of Video-Frame
function GetCapHeight: word;
function GetHasDlgVFormat: Boolean; // Driver has a format dialog
function GetHasDlgVDisplay: Boolean; // Driver has a display dialog
function GetHasDlgVSource: Boolean; // Driver has a source dialog
function GetHasVideoOverlay: Boolean; // Driver has overlay mode
procedure Setoverlay(value: boolean); // Driver will use overlay mode
procedure SetPreview(value: boolean); // Driver will use preview mode
procedure SetScale(value: Boolean); // Stretching Frame to component size
procedure SetpreviewRate(value: word); // Setting preview frame rate
function GetCapInProgress: boolean; // Capturing in progress
procedure SetIndexSize(value: cardinal);
// Setting index size in capture file
function GetBitMapInfo: TBITMAPINFO; // Bitmapinfo

// Setting callbacks as events
procedure SetStatCallBack(value: TCapStatusCallback);
procedure SetCapVideoStream(value: TVideoStream);
procedure SetCapAudioStream(value: TAudioStream);

public
constructor Create(AOwner: TComponent); override;
destructor destroy; override;

property HasDlgFormat: Boolean read GetHasDlgVFormat;
// Driver has a format dialog
property HasDlgDisplay: Boolean read GetHasDlgVDisplay;
// Driver has a display dialog
property HasDlgSource: Boolean read GetHasDlgVSource;
// Driver has a sourve dialog
property HasVideoOverlay: boolean read GetHasVideoOverlay;
// Driver has overlay mode
property CapWidth: word read GetCapWidth; // Width of the captured frames
property CapHeight: word read GetCapHeight; // Hight of the captured frames
property CapInProgess: boolean read getCapinProgress;
/// capturing is progress
property BitMapInfo: TBitmapinfo read GetBitmapInfo;
// Get the Bitmapinfo of the frames

function DlgVFormat: Boolean; // Shows VideoFormat dialog of the Driver
function DlgVDisplay: boolean; // Shows VideoDisplay dialog of the Driver
function DlgVSource: boolean; // Shows VideoSource dialog of the Driver
function DlgVCompression: Boolean; // Shows VideoCompression dialog from VfW
function GrabFrame: boolean;
// Capture one Frame and stops overlay or preview mode
function GrabFrameNoStop: boolean;
// Capture one frame without stoppin overlay or preview
function SaveAsDIB: Boolean; // saves actual frame as DIB
function SaveToClipboard: Boolean; // Puts actual fasme to then Clipboard
function StartCapture: Boolean; // Starts Capturing
function StopCapture: Boolean; // Stops capturing

published
property align;
property color;
property visible;
property DriverOpen: boolean read getDriveropen write setDriverOpen;
// Opens the Driver / or is Driver open
property DriverIndex: integer read fdriverindex write SetDriverIndex;
// Index of driver
property DriverName: string read fVideoDriverName write SetDrivername;
// Name of the Driver
property VideoOverlay: boolean read GetOverlay write SetOverlay;
// Overlay - Mode
property VideoPreview: boolean read GetPreview write SetPreview;
// Preview - Mode
property PreviewScaleToWindow: boolean read fscale write Setscale;
// Stretching Frame to component size
property PreviewScaleProportional: boolean read fprop write Setprop;
// Stretching Frame poportional to original size
property PreviewRate: word read fpreviewrate write SetpreviewRate;
//Preview frame rate
property MicroSecPerFrame: cardinal read fmicrosecpframe write
SetMicroSecPerFrame; //micro seconds between two frames
property FrameRate: word read getFramerate write setFrameRate;
//Frames p. second
property CapAudio: Boolean read fcapAudio write fcapAudio;
// Captue audio stream to
property VideoFileName: string read fCapVideoFileName write
fCapVideoFileName; // Name of capture file
property SingleImageFile: string read FCapSingleImageFileName write
FCapSingleImageFileName; // Name of file for single image
property CapTimeLimit: word read fCapTimeLimit write fCapTimeLimit;
// time limit for Capturing
property CapIndexSize: cardinal read findexSize write setIndexSize;
// Size of the index for capture file
property CapToFile: boolean read fcaptoFile write fcapToFile;
// Write Frames to capture file
// Internal Events and Callbacks as Events
property OnStatus: TCapStatusProc read fCapStatusProcedure write
FCapStatusProcedure;
property OnStatusCallback: TCapStatusCallback read fcapStatuscallback write
SetStatCallback;
property OnVideoStream: TVideoStream read fcapVideoStream write
SetCapVideoStream;
property OnAudioStream: TAudioStream read fcapAudioStream write
SetCapAudioStream;
property OnMouseMove;
property OnMouseUp;
property OnMouseDown;
property OnClick;
property OnDblClick;
end;

procedure Register;

function GetDriverList: TStringList;
// Fill stringlist with names and versioninfo of all installed capture drivers
procedure FrameToBitmap(Bitmap: TBitmap; FrameBuffer: pointer; BitmapInfo:
TBitmapInfo); // Make a TBitmap from a Frame

implementation

// Callback for status of video captures

function StatusCallbackProc(hWnd: HWND; nID: Integer; lpsz: Pchar): LongInt;
stdcall;
var
Control: TVideo;
begin
control := TVideo(capGetUserData(hwnd));
if assigned(control) then
begin
if assigned(control.fcapStatusCallBack) then
control.fcapStatusCallBack(control, nId, strPas(lpsz));
end;
result := 1;
end;

// Callback for video stream

function VideoStreamCallbackProc(hWnd: Hwnd; lpVHdr: PVIDEOHDR): longint;
stdcall;
var
Control: TVideo;
begin
control := TVideo(capGetUserData(hwnd));
if assigned(control) then
begin
if assigned(control.fcapVideoStream) then
control.fcapVideoStream(control, lpvHdr);
end;
result := 1;
end;

// Callback for audio stream

function AudioStreamCallbackProc(hwnd: HWND; lpWHdr: PWaveHdr): longInt;
stdcall;
var
control: TVideo;
begin
control := TVideo(capGetUserData(hwnd));
if assigned(control) then
if assigned(control.fcapAudioStream) then
begin
control.fcapAudioStream(control, lpwhdr);
end;
result := 1;
end;

// New Window-Procedure for CaputreWindow to post messages like WM_MouseMove to Component

function WCapproc(hw: THandle; messa: DWord; w: wParam; l: lParam): integer;
stdcall;
var
oldwndProc: Pointer;
parentWnd: Thandle;
begin
oldwndproc := Pointer(GetWindowLong(hw, GWL_USERDATA));
case Messa of
WM_MOUSEMOVE,
WM_LBUTTONDBLCLK,
WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN,
WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP:
begin
ParentWnd := Thandle(GetWindowLong(hw, GWL_HWNDPARENT));
sendMessage(ParentWnd, messa, w, l);
result := integer(true);
end
else
result := callWindowProc(oldwndproc, hw, messa, w, l);
end;

end;

(*---------------------------------------------------------------*)
// constructor and Destructor

constructor TVideo.Create(aowner: TComponent);

begin
inherited create(aowner);
height := 100;
width := 100;
Color := clblack;
fVideoDriverName := '';
fdriverindex := -1;
fhCapWnd := 0;
fCapVideoFileName := 'Video.avi';
fCapSingleImageFileName := 'Capture.bmp';
fscale := false;
fprop := false;
fpreviewrate := 30;
fmicrosecpframe := 66667;
fpDrivercaps := nil;
fpDriverStatus := nil;
fcapToFile := true;

fCapStatusProcedure := nil;
fcapStatusCallBack := nil;
fcapVideoStream := nil;
fcapAudioStream := nil;

end;

destructor TVideo.destroy;
begin
DestroyCapWindow;
deleteDriverProps;
inherited destroy;
end;

(*---------------------------------------------------------------*)
// Messagehandler for sizing the capture window

procedure TVideo.SetSize(var msg: TMessage);
begin
if (fhCapWnd <> 0) and (Fscale) then
begin
if msg.msg = WM_SIZE then SizeCap;
end;
end;

// Sizing capture window

procedure TVideo.SizeCap;
var
h, w: integer;
f, cf: single;
begin
if not fscale then
MoveWindow(fhcapWnd, 0, 0, Capwidth, capheight, true)
else
begin
if fprop then
begin
f := Width / height;
cf := CapWidth / CapHeight;
if f > cf then
begin
h := height;
w := round(h * cf);
end
else
begin
w := width;
h := round(w * 1 / cf);
end
end
else
begin
h := height;
w := Width;
end;
MoveWindow(fhcapWnd, 0, 0, w, h, true);
end;
end;

(*---------------------------------------------------------------*)
// Delete driver infos

procedure TVideo.DeleteDriverProps;
begin
if assigned(fpDrivercaps) then
begin
dispose(fpDrivercaps);
fpDriverCaps := nil;
end;
if assigned(fpDriverStatus) then
begin
dispose(fpDriverStatus);
fpDriverStatus := nil;
end;

end;

(*---------------------------------------------------------------*)
// Capitilies of the Driver

function TVideo.GetDriverCaps: boolean;
var
savestat: integer;

begin
result := false;
if assigned(fpDrivercaps) then
begin
result := true;
exit;
end;
if fdriverIndex = -1 then exit;
savestat := fhCapwnd; // save state of the window
if fhCapWnd = 0 then CreateCapWindow;
if fhCapWnd = 0 then exit;
new(fpDrivercaps);
if capDriverGetCaps(fhCapWnd, fpDriverCaps, sizeof(TCapDriverCaps)) then
begin
result := true;
if savestat = 0 then destroyCapWindow;
exit;
end;
dispose(fpDriverCaps); // Error can't open then Driver
fpDriverCaps := nil;
if savestat = 0 then destroyCapWindow;
end;

(*---------------------------------------------------------------*)
// BitmapInfo

function TVideo.GetBitMapInfo: TBitmapinfo;
var
size: integer;
begin
if driveropen then
begin
size := capGetVideoFormat(fhcapWnd, nil, 0);
capGetVideoFormat(fhcapWnd, @result, size);
exit;
end;
fillchar(result, sizeof(TBitmapInfo), 0);
end;

(*---------------------------------------------------------------*)

function TVideo.getDriverStatus(callback: boolean): boolean;
begin
result := false;
if fhCapWnd <> 0 then
begin
if not assigned(fpDriverstatus) then new(fpDriverStatus);
if capGetStatus(fhCapWnd, fpdriverstatus, sizeof(TCapStatus)) then
begin
result := true;
end;
end;
if assigned(fCapStatusProcedure) and callback then fcapStatusProcedure(self);
end;

(*---------------------------------------------------------------*)
// Treibername Setzen

procedure TVideo.SetDrivername(value: string);
var
i: integer;
name: array[0..80] of char;
ver: array[0..80] of char;
begin
if fVideoDrivername = value then exit;
for i := 0 to 9 do
if capGetDriverDescription(i, name, 80, ver, 80) then
if strpas(name) = value then
begin
fVideoDriverName := value;
Driverindex := i;
exit;
end;
fVideoDrivername := '';
DriverIndex := -1;
end;
(*---------------------------------------------------------------*)

procedure TVideo.SetDriverIndex(value: integer);
var
name: array[0..80] of char;
ver: array[0..80] of char;

begin
if value = fdriverindex then exit;
destroyCapWindow;
deleteDriverProps; // Alte Treiberf鋒igkeiten L鰏chen
if value > -1 then
begin
if capGetDriverDescription(value, name, 80, ver, 80) then
fVideoDriverName := StrPas(name)
else
value := -1;
end;
if value = -1 then fvideoDriverName := '';
fdriverindex := value;
end;
(*---------------------------------------------------------------*)

function TVideo.CreateCapWindow;
var
Ex: Exception;
savewndproc: integer;
begin
result := false;
if fhCapWnd <> 0 then
begin
result := true;
exit;
end;

if fdriverIndex = -1 then
begin
Ex := ENoDriverException.Create('No capture driver selected');
GetDriverStatus(true);
raise ex;
exit;
end;
fhCapWnd := capCreateCaptureWindow(PChar(Name),
WS_CHILD or WS_VISIBLE, 0, 0,
Width, Height,
Handle, 5001);
if fhCapWnd = 0 then
begin
Ex := ENoCapWindowException.Create('Can not create capture window');
GetDriverStatus(true);
raise ex;
exit;
end;

// Set ouwer own Adress to the CapWindow
capSetUserData(fhCapwnd, integer(self));
// Set ouer own window procedure to Capture-Window
savewndproc := SetWindowLong(fhcapWnd, GWL_WNDPROC, integer(@WCapProc));
// User Data for old WndProc adress
SetWindowLong(fhcapWnd, GWL_USERDATA, savewndProc);
// Setting callbacks as events
if assigned(fcapStatusCallBack) then
capSetCallbackOnStatus(fhcapWnd, StatusCallbackProc);
if assigned(fcapVideoStream) then
capSetCallbackOnVideoStream(fhcapwnd, VideoStreamCallbackProc);
if assigned(fcapAudioStream) then
capSetCallbackOnWaveStream(fhcapWnd, AudioStreamCallbackProc);

if not capDriverConnect(fhCapWnd, fdriverIndex) then
begin
Ex :=
ENotConnectException.Create('Can not connect capture driver with capture window');
// MessageDlg('Can not connect capture driver with capture window',mterror,[mbOK],0);
Destroycapwindow;
GetDriverStatus(true);
raise ex;
exit;
end;
capPreviewScale(fhCapWnd, fscale);
capPreviewRate(fhCapWnd, round(1 / fpreviewrate * 1000));
GetDriverStatus(true);
Sizecap;
result := true;
end;

// Setting callbacks as events

procedure TVideo.SetStatCallBack(value: TCapStatusCallback);
begin
fcapStatusCallBack := value;
if DriverOpen then
if assigned(fcapStatusCallBack) then
capSetCallbackOnStatus(fhcapWnd, StatusCallbackProc)
else
capSetCallbackOnStatus(fhcapWnd, nil);
end;

procedure TVideo.SetCapVideoStream(value: TVideoStream);
begin
fcapVideoStream := value;
if DriverOpen then
if assigned(fcapVideoStream) then
capSetCallbackOnVideoStream(fhcapwnd, VideoStreamCallbackProc)
else
capSetCallbackOnVideoStream(fhcapwnd, nil);
end;

procedure TVideo.SetCapAudioStream(value: TAudioStream);
begin
fcapAudioStream := value;
if DriverOpen then
if assigned(fcapAudioStream) then
capSetCallbackOnWaveStream(fhcapWnd, AudioStreamCallbackProc)
else
capSetCallbackOnWaveStream(fhcapWnd, nil);
end;

(*---------------------------------------------------------------*)

procedure TVideo.DestroyCapWindow;
begin
if fhCapWnd = 0 then exit;
CapDriverDisconnect(fhCapWnd);
SetWindowLong(fhcapWnd, GWL_WNDPROC, GetWindowLong(fhcapwnd, GWL_USERDATA));
// Old windowproc
DestroyWindow(fhCapWnd);
fhCapWnd := 0;
end;

(*---------------------------------------------------------------*)

function TVideo.GetHasVideoOverlay: Boolean;

begin
if getDriverCaps then
Result := fpDriverCaps^.fHasOverlay
else
result := false;
end;

(*---------------------------------------------------------------*)

function TVideo.GetHasDlgVFormat: Boolean;
begin
if getDriverCaps then
Result := fpDriverCaps^.fHasDlgVideoFormat
else
result := false;
end;

(*---------------------------------------------------------------*)

function TVideo.GetHasDlgVDisplay: Boolean;

begin
if getDriverCaps then
Result := fpDriverCaps^.fHasDlgVideoDisplay
else
result := false;
end;

(*---------------------------------------------------------------*)

function TVideo.GetHasDlgVSource: Boolean;
begin
if getDriverCaps then
Result := fpDriverCaps^.fHasDlgVideoSource
else
result := false;
end;

(*---------------------------------------------------------------*)

function TVideo.DlgVFormat: boolean;
var
savestat: integer;
begin
result := false;
if fdriverIndex = -1 then exit;
savestat := fhCapwnd;
if fhCapWnd = 0 then
if not CreateCapWindow then exit;
result := capDlgVideoFormat(fhCapWnd);
if result then GetDriverStatus(true);
if savestat = 0 then destroyCapWindow;
if result then
begin
Sizecap;
Repaint;
end;
end;

(*---------------------------------------------------------------*)

function TVideo.DlgVDisplay: boolean;
var
savestat: integer;
begin
result := false;
if fdriverIndex = -1 then exit;
savestat := fhCapwnd;
if fhCapWnd = 0 then
if not CreateCapWindow then exit;
result := capDlgVideoDisplay(fhCapWnd);
if result then GetDriverStatus(true);
if savestat = 0 then destroyCapWindow;
if result then
begin
SizeCap;
Repaint;
end;
end;

(*---------------------------------------------------------------*)

function TVideo.DlgVSource: boolean;
var
savestat: integer;

begin
result := false;
if fdriverIndex = -1 then exit;
savestat := fhCapwnd;
if fhCapWnd = 0 then
if not createCapWindow then exit;
result := capDlgVideoSource(fhCapWnd);
if result then GetDriverStatus(true);
if savestat = 0 then destroyCapWindow;
if result then
begin
SizeCap;
Repaint;
end;
end;
(*---------------------------------------------------------------*)

function TVideo.DlgVCompression;
var
savestat: integer;

begin
result := false;
if fdriverIndex = -1 then exit;
savestat := fhCapwnd;
if fhCapWnd = 0 then
if not createCapWindow then exit;
result := capDlgVideoCompression(fhCapWnd);
if savestat = 0 then destroyCapWindow;
end;

(*---------------------------------------------------------------*)
// Single Frame Grabbling

function TVideo.GrabFrame: boolean;
begin
result := false;
if not DriverOpen then exit;
Result := capGrabFrame(fhcapwnd);
if result then GetDriverStatus(true);
end;

function TVideo.GrabFrameNoStop: boolean;
begin
result := false;
if not DriverOpen then exit;
Result := capGrabFrameNoStop(fhcapwnd);
if result then GetDriverStatus(true);
end;

(*---------------------------------------------------------------*)
// save frame as DIP

function TVideo.SaveAsDIB: Boolean;
var
s: array[0..MAX_PATH] of char;
begin
result := false;
if not DriverOpen then exit;
result := capFileSaveDIB(fhcapwnd, strpCopy(s, fCapSingleImageFileName));
end;

function TVideo.SaveToClipboard: boolean;
begin
result := false;
if not Driveropen then exit;
result := capeditCopy(fhcapwnd);
end;

(*---------------------------------------------------------------*)

procedure TVideo.Setoverlay(value: boolean);
var
ex: Exception;
begin
if value = GetOverlay then exit;
if gethasVideoOverlay = false then
begin
Ex := ENoOverlayException.Create('Driver has no overlay mode');
raise ex;
//MessageDlg('Treiber kann kein Overlay',mtError,[mbOK],0);
exit;
end;
if value = true then
begin
if fhcapWnd = 0 then CreateCapWindow;
GrabFrame;
end;

capOverlay(fhCapWnd, value);
GetDriverStatus(true);
invalidate;
end;

function TVideo.GetOverlay: boolean;
begin
if fhcapWnd = 0 then
result := false
else
result := fpDriverStatus^.fOverlayWindow;
end;

(*---------------------------------------------------------------*)

procedure TVideo.SetPreview(value: boolean);
begin
if value = GetPreview then exit;
if value = true then
if fhcapWnd = 0 then CreateCapWindow;
capPreview(fhCapWnd, value);
GetDriverStatus(true);
invalidate;
end;

function TVideo.GetPreview: boolean;
begin
if fhcapWnd = 0 then
result := false
else
result := fpDriverStatus^.fLiveWindow;
end;

procedure TVideo.SetPreviewRate(value: word);
begin
if value = fpreviewrate then exit;
if value < 1 then value := 1;
if value > 30 then value := 30;
fpreviewrate := value;
if DriverOpen then capPreviewRate(fhCapWnd, round(1 / fpreviewrate * 1000));
end;

(*---------------------------------------------------------------*)

procedure TVideo.SetMicroSecPerFrame(value: cardinal);
begin
if value = fmicrosecpframe then exit;
if value < 33333 then value := 33333;
fmicrosecpframe := value;
end;

procedure TVideo.setFrameRate(value: word);
begin
if value = 0 then value := 10;
fmicrosecpframe := round(1.0 / value * 1000000.0);
end;

function TVideo.GetFrameRate: word;
begin
if fmicrosecpFrame > 0 then
result := round(1. / fmicrosecpframe * 1000000.0)
else
result := 0;
end;

function TVideo.StartCapture;
var
CapParms: TCAPTUREPARMS;
name: array[0..MAX_PATH] of char;

begin
result := false;
if not DriverOpen then exit;
capCaptureGetSetup(fhCapWnd, @CapParms, sizeof(TCAPTUREPARMS));
capFileSetCaptureFile(fhCapWnd, strpCopy(name, fCapVideoFileName));
CapParms.dwRequestMicroSecPerFrame := fmicrosecpframe;
CapParms.fLimitEnabled := BOOL(FCapTimeLimit);
CapParms.wTimeLimit := fCapTimeLimit;
CapParms.fCaptureAudio := fCapAudio;
CapParms.fMCIControl := FALSE;
CapParms.fYield := TRUE;
CapParms.vKeyAbort := VK_ESCAPE;
CapParms.fAbortLeftMouse := FALSE;
CapParms.fAbortRightMouse := FALSE;
capCaptureSetSetup(fhCapWnd, @CapParms, sizeof(TCAPTUREPARMS));
if CapToFile then
result := capCaptureSequence(fhCapWnd)
else
result := capCaptureSequenceNoFile(fhCapWnd);
GetDriverStatus(true);
end;

function TVideo.StopCapture;
begin
result := false;
if not DriverOpen then exit;
result := CapCaptureStop(fhcapwnd);
getDriverstatus(true);
end;

procedure TVideo.SetIndexSize(value: cardinal);
begin
if value = 0 then
begin
findexSize := 0;
exit;
end;
if value < 1800 then value := 1800;
if value > 324000 then value := 324000;
findexsize := value;

end;

function TVideo.GetCapInProgress: boolean;
begin
result := false;
if not DriverOpen then exit;
GetDriverStatus(false);
result := fpDriverStatus^.fCapturingNow;
end;
(*---------------------------------------------------------------*)

procedure TVideo.SetScale(value: boolean);

begin
if value = fscale then exit;
fscale := value;
if DriverOpen then
begin
capPreviewScale(fhCapWnd, fscale);
SizeCap;
end;
Repaint;
end;

procedure TVideo.Setprop(value: Boolean);
begin
if value = fprop then exit;
fprop := value;
if DriverOpen then Sizecap;
Repaint;
end;

(*---------------------------------------------------------------*)

function TVideo.GetCapWidth;

begin
if assigned(fpDriverStatus) then
result := fpDriverStatus^.uiImageWidth
else
result := 0;
end;

function TVideo.GetCapHeight;

begin
if assigned(fpDriverStatus) then
result := fpDriverStatus^.uiImageHeight
else
result := 0;
end;

(*---------------------------------------------------------------*)

procedure TVideo.SetDriverOpen(value: boolean);
begin
if value = GetDriverOpen then exit;
if value = false then DestroyCapWindow;
if value = true then CreateCapWindow;
end;

function TVideo.GetDriverOpen: boolean;
begin
result := fhcapWnd <> 0;
end;

function TDriverEditor.GetAttributes: TPropertyAttributes;
begin
result := [paRevertable, paValueList];
end;

procedure TDriverEditor.GetValues(Proc: TGetStrProc);
var
i: integer;
name: array[0..80] of char;
ver: array[0..80] of char;
s: string;

begin
for i := 0 to 9 do
begin
if capGetDriverDescription(i, name, 80, ver, 80) then
s := strpas(name)
else
s := '';
proc(s);
end;

end;

function TDriverEditor.GetValue: string;
begin
with Getcomponent(0) as TVideo do
result := fVideoDrivername;
end;

procedure TDriverEditor.SetValue(const Value: string);
begin
with Getcomponent(0) as TVideo do
SetDrivername(value);
Modified;
end;

// Creating a list with capture drivers

function GetDriverList: TStringList;
var
i: integer;
name: array[0..80] of char;
ver: array[0..80] of char;
begin
result := TStringList.Create;
result.Capacity := 10;
result.Sorted := false;
for i := 0 to 9 do
if capGetDriverDescription(i, name, 80, ver, 80) then
result.Add(StrPas(name) + ' ' + strpas(ver))
else
break; // result.add('');
end;

procedure FrameToBitmap(Bitmap: TBitmap; FrameBuffer: pointer; BitmapInfo:
TBitmapInfo);
var
ex: Exception;
begin
if bitmapInfo.bmiHeader.BiCompression <> bi_RGB then
begin
ex := EFalseFormat.Create('Not Supported DIB format');
raise ex;
end;
with Bitmap do
begin
Width := BitmapInfo.bmiHeader.biWidth; // New size of Bitmap
Height := Bitmapinfo.bmiHeader.biHeight;
setDiBits(canvas.handle, handle, 0, BitmapInfo.bmiHeader.biheight,
FrameBuffer, BitmapInfo, DIB_RGB_COLORS);
end;
end;

procedure Register;
begin
RegisterComponents('Video Capturing', [TVideo]);
RegisterPropertyEditor(TypeInfo(string), TVideo, 'DriverName', TDriverEditor);
end;

end.