Code:
function capGetDriverDescriptionA(
wDriverIndex : UINT;
lpszName : LPSTR;
cbName : integer;
lpszVer : LPSTR;
cbVer : integer
): BOOL; stdcall; external
CAPTUREDLL name 'capGetDriverDescriptionA';
function capCreateCaptureWindowA(
lpszWindowName : LPCSTR;
dwStyle : DWORD;
x, y : integer;
nWidth, nHeight : integer;
hwndParent : HWND;
nID : integer
): HWND; stdcall; external
CAPTUREDLL name 'capCreateCaptureWindowA';
function capCreateCaptureWindowW(
lpszWindowName : LPCWSTR;
dwStyle : DWORD;
x, y : integer;
nWidth, nHeight : integer;
hwndParent : HWND;
nID : integer
): HWND; stdcall; external
CAPTUREDLL name 'capCreateCaptureWindowW';
function capGetDriverDescriptionW(
wDriverIndex : UINT;
lpszName : LPWSTR;
cbName : integer;
lpszVer : LPWSTR;
cbVer : integer
): BOOL; external
CAPTUREDLL name 'capGetDriverDescriptionW';
function capCreateCaptureWindow(
lpszWindowName : LPCSTR;
dwStyle : DWORD;
x, y : integer;
nWidth, nHeight : integer;
hwndParent : HWND;
nID : integer
): HWND; stdcall; external
CAPTUREDLL name 'capCreateCaptureWindow'
Function GetwdmDriverList:TStringList;
var i:integer;
Names: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 capGetDriverDescriptionA( i,names,80,ver,80) then
result.Add(StrPas(names)+ ' '+strpas(ver))
else
break;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Drivers: TStringList;
newitem :Tlistitem;
i:integer;
begin
Drivers := GetwdmDriverList();
for i := 0 to drivers.Count -1 do
begin
newitem :=listview1.Items.Add;
newitem.Caption := drivers.Strings[i];
end;
Drivers.Free();
end;
procedure TForm1.ListView1DblClick(Sender: TObject);
begin
if listview1.Selected <> nil then
begin
setdrivername (listview1.Selected.Caption);
end;
end;
var
fVideoDriverName : string;
driverIndex :integer;
procedure TForm1.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 capGetDriverDescriptionA( i,name,80,ver,80) then
if strpas(name) = value then
begin
fVideoDriverName := value;
Driverindex:= i;
exit;
end;
fVideoDrivername:= '';
DriverIndex:= -1;
end;
type
PCAPSTATUS = ^TCAPSTATUS;
TCapStatusCallback = procedure (Sender:TObject;nID:integer;status:string) of object;
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;
TCapStatusProc = procedure(Sender: TObject) of object;
const
WM_CAP_START = WM_USER;
WM_CAP_UNICODE_START = WM_USER + 100;
WM_CAP_GET_CAPSTREAMPTR = WM_CAP_START + 1;
WM_CAP_SET_CALLBACK_ERRORW = WM_CAP_UNICODE_START + 2;
WM_CAP_SET_CALLBACK_STATUSW = WM_CAP_UNICODE_START + 3;
WM_CAP_SET_CALLBACK_ERRORA = WM_CAP_START + 2;
WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3;
WM_CAP_SET_CALLBACK_ERROR = WM_CAP_SET_CALLBACK_ERRORA;
WM_CAP_SET_CALLBACK_STATUS = WM_CAP_SET_CALLBACK_STATUSA;
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_NAMEA = WM_CAP_START + 12;
WM_CAP_DRIVER_GET_VERSIONA = WM_CAP_START + 13;
WM_CAP_DRIVER_GET_NAMEW = WM_CAP_UNICODE_START + 12;
WM_CAP_DRIVER_GET_VERSIONW = WM_CAP_UNICODE_START + 13;
WM_CAP_DRIVER_GET_NAME = WM_CAP_DRIVER_GET_NAMEA;
WM_CAP_DRIVER_GET_VERSION = WM_CAP_DRIVER_GET_VERSIONA;
WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
WM_CAP_FILE_GET_CAPTURE_FILEA = WM_CAP_START + 21;
WM_CAP_FILE_SAVEASA = WM_CAP_START + 23;
WM_CAP_FILE_SAVEDIBA = WM_CAP_START + 25;
WM_CAP_FILE_SET_CAPTURE_FILEW = WM_CAP_UNICODE_START + 20;
WM_CAP_FILE_GET_CAPTURE_FILEW = WM_CAP_UNICODE_START + 21;
WM_CAP_FILE_SAVEASW = WM_CAP_UNICODE_START + 23;
WM_CAP_FILE_SAVEDIBW = WM_CAP_UNICODE_START + 25;
WM_CAP_FILE_SET_CAPTURE_FILE = WM_CAP_FILE_SET_CAPTURE_FILEA;
WM_CAP_FILE_GET_CAPTURE_FILE = WM_CAP_FILE_GET_CAPTURE_FILEA;
WM_CAP_FILE_SAVEAS = WM_CAP_FILE_SAVEASA;
WM_CAP_FILE_SAVEDIB = WM_CAP_FILE_SAVEDIBA;
// out of order to save on ifdefs
WM_CAP_FILE_ALLOCATE = WM_CAP_START + 22;
WM_CAP_FILE_SET_INFOCHUNK = WM_CAP_START + 24;
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_DEVICEA = WM_CAP_START + 66;
WM_CAP_GET_MCI_DEVICEA = WM_CAP_START + 67;
WM_CAP_SET_MCI_DEVICEW = WM_CAP_UNICODE_START + 66;
WM_CAP_GET_MCI_DEVICEW = WM_CAP_UNICODE_START + 67;
WM_CAP_SET_MCI_DEVICE = WM_CAP_SET_MCI_DEVICEA;
WM_CAP_GET_MCI_DEVICE = WM_CAP_GET_MCI_DEVICEA;
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_OPENA = WM_CAP_START + 80;
WM_CAP_PAL_SAVEA = WM_CAP_START + 81;
WM_CAP_PAL_OPENW = WM_CAP_UNICODE_START + 80;
WM_CAP_PAL_SAVEW = WM_CAP_UNICODE_START + 81;
WM_CAP_PAL_OPEN = WM_CAP_PAL_OPENA;
WM_CAP_PAL_SAVE = WM_CAP_PAL_SAVEA;
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_UNICODE_END = WM_CAP_PAL_SAVEW;
WM_CAP_END = WM_CAP_UNICODE_END;
var
fhCapWnd : THandle;
Fdriverindex :Integer;
fpDriverStatus : pCapStatus;
fCapStatusProcedure : TCapStatusProc;
fcapStatusCallBack : TCapStatusCallback;
function AVICapSM(hwnd: HWND; m: UINT; w: WPARAM; l: LPARAM): DWORD;
begin
if IsWindow(hwnd) then
Result := SendMessage(hwnd,m,w,l)
else
Result := 0;
end;
function capGetStatus(hwnd: HWND; s: PCAPSTATUS; wSize: WORD): BOOL;
begin
Result := AVICapSM(hwnd, WM_CAP_GET_STATUS, wSize, LPARAM(s)) <> 0;
end;
function 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 (nil);
end;
function capSetUserData(hwnd: HWND; lUser: DWORD): BOOL;
begin
Result := AVICapSM(hwnd, WM_CAP_SET_USER_DATA, 0, lUser) <> 0;
end;
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;
function capSetCallbackOnStatus(hwnd: HWND; fpProc: TCAPSTATUSCALLBACK): BOOL;
begin
Result := AVICapSM(hwnd, WM_CAP_SET_CALLBACK_STATUS, 0, LPARAM(@fpProc)) <> 0;
end;
function capGetUserData(hwnd: HWND): DWORD;
begin
Result := AVICapSM(hwnd, WM_CAP_GET_USER_DATA, 0, 0);
end;
function StatusCallbackProc(hWnd : HWND; nID : Integer; lpsz : Pchar): LongInt; stdcall;
var Control:Tpanel;
begin
control:=Tpanel(capGetUserData(hwnd));
if assigned(control) then
begin
end;
result:= 1;
end;
function capDriverConnect(hwnd: HWND; i: INTeger): BOOL;
begin
Result := AVICapSM(hwnd, WM_CAP_DRIVER_CONNECT, i, 0) <> 0;
end;
function capDriverDisconnect(hwnd: HWND): BOOL;
begin
Result := AVICapSM(hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0) <> 0;
end;
procedure DestroyCapWindow;
begin
if fhCapWnd = 0 then exit;
// CreateTmpFile(False);
CapDriverDisconnect (fhCapWnd);
SetWindowLong(fhcapWnd,GWL_WNDPROC,GetWindowLong(fhcapwnd,GWL_USERDATA)); // Old windowproc
DestroyWindow( fhCapWnd ) ;
fhCapWnd := 0;
end;
var
width, height :integer;
handle :hwnd;
function CreateCapWindow:boolean;
var Ex:Exception;
savewndproc:integer;
begin
if fhCapWnd <> 0 then
begin
result:= true;
exit;
end;
if fdriverIndex = -1 then
begin
Ex := Exception.Create('No capture driver selected');
GetDriverStatus(true);
raise ex;
exit;
end;
fhCapWnd := capCreateCaptureWindow( PChar('pamel1'),
WS_CHILD or WS_VISIBLE , 0, 0,
Width, Height,
Handle, 5001);
if fhCapWnd =0 then
begin
Ex:= Exception.Create('Can not create capture window');
GetDriverStatus(true);
raise ex;
exit;
end;
// Set our own Adress to the CapWindow
capSetUserData(fhCapwnd,integer(nil));
// Set our 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 not capDriverConnect(fhCapWnd, fdriverIndex) then
begin
Ex:= Exception.Create('Can not connect capture driver with capture window');
Destroycapwindow;
GetDriverStatus(true);
raise ex;
exit;
end;
// CreateTmpFile(True);
// capPreviewScale(fhCapWnd, fscale);
// capPreviewRate(fhCapWnd, round( 1/fpreviewrate*1000));
GetDriverStatus(true);
// Sizecap;
result:= true;
end;
Bookmarks