谁有采用VFW或者TWAIN开发的视频采集code或者资料(100分)

大家给点资料或code看看，谢谢万分谢谢，ken.jiang@teapo.com

VFW
有个控件
TVideo 2.3

Thanks to all who reported errors and/or give me new suggestions for this component.

The component works with Delphi 3,4,5.


All demos are written with Delphi 5. So user of a earlier version of Delphi get errors/warnings when they open
the projekt files. Ignore all errors, the demos will work.

In Version 2.2 are three Demos, one is a Capturing tool, the oher demonstate the
usage of the OnVideoStreamEvent and the Information you can get with the BitmapInfo ,
the third demo shows the usage of the undocumented TVideoDisp component and the usage of the
Funktions FrameToBitmap and BitmapToFrame.

In Version 2.3 a new demo is added witch shows the Single Frame Functions.
In the unit vfw are now functions for the Video Compression Manager. These funktions are not used in the components,
but you can use it in your own applications. For a desciption of Video for Windows look at:
http://msdn.microsoft.com/library/psdk/multimed/avifile_8dgz.htm

If you have questions mail to: huebler@fbm.fh-weingarten.de



Installation:

Delphi 2:
Install the units vfw.pas, drvedit.pas, videocap.pas and videodisp.pas
(Component is not tested with D2, perhaps it works)


Delphi 3:
Install videocap3.dpk

Delphi 4:
Install videocap4.dpk

Delphi 5:
Install the videocap5.dpk


If you use an earlyer Versions of TVideo, deinstall first !
J. Huebler


e-mail: huebler@fbm.fh-weingarten.de

unit drvedit;

interface

procedure Register;

implementation

// uses classes,dsgnintf,sysutils,vfw,videocap;
// d5 d4 d3

uses classes, DesignIntf, DesignEditors, sysutils, vfw, videocap;
// d6
改为 delphi 6 的

to hfghfghfg兄：
能给一份此控件么？hfghfghfg兄能否给小弟比较一下DX和VFW抓视频的优缺点。
我引入avicap32.dll实现了，可是想了解更多的资料，大家能给点么？

to hfghfghfg　：
请问怎么在这个控件中怎么设置视频压缩器中默认的压缩程序！我安装了DIVX，不可能在程序中每次让人来选择压缩器压缩啊！谢谢！

dx的性能要比vfw高，因为VFW传递数据时，多用的是内存间的copy，而dxshow用的是传递指针
设置默认压缩格式，参考一下这个，不知有没有帮助：
http://richpage.delphibbs.com/?eyes4

能否发一份FOR D6版的VFW给我呢？

邮箱：15104368@163.com jxfcrwl@vip.sina.com

其中的listener是网络侦听和及收发的类，这里就不提供了

unit capture;

interface
uses
Windows, Messages,SysUtils, Classes, Vfw, NetListener, mmsystem,myconsts,MSAcm;
type
TCallBackFunc = procedure (msg:integer) of object;
type
TCapture = class
private
FCaptureWinHnd : THandle;
FClientWinHnd:THandle;

FCaptureHandle: THandle;
//视频捕捉的句柄

Listener:TNetListener;
FEInInfo,FEOutInfo: TBitmapInfo;
//压缩的前后图象
FDInInfo,FDOutInfo: TBitmapInfo;
//解压的前后图象

FCV: TCOMPVARS;
FEncSize : DWORD;
FWidth,FHeight: Integer;

do
Capture:Boolean;
framenum:integer;
procedure FillEncoreBitmapStruc;
//==========填写压缩的图象结构
procedure InitCompressor;
procedure CompressFrame(lpVHdr: PVIDEOHDR);
//==========做压缩的动作==========

public

constructor Create(callback:TCallBackFunc;capHnd,cliHnd : THandle;
w,h : Integer);
destructor Destroy;
override;
function Open:Boolean;
procedure StartCap;
procedure OpenPreView;
procedure ClosePreView;
procedure ClientConnect(addr,port:string);
procedure Clientclose;
procedure SendText(text:string);
end;

var
cap:Tcapture;
EncBuf: PByte;
//--------压缩完成后的视频流------------
audioBuffbyte;


function YieldCallBack(hWnd: HWND): DWORD;
stdcall;
function CapCallBack(hWnd: HWND;
lpVHdr: PVIDEOHDR): DWORD;
stdcall;
implementation
uses main;




constructor TCapture.Create(callback:TCallBackFunc;capHnd,cliHnd : THandle;
w,h : Integer);

begin

inherited Create;
cap:=self;
FCaptureWinHnd := capHnd;
FClientWinHnd := cliHnd;
FWidth := w;
FHeight := h;
GetMem(AudioBuff,40960);
do
Capture:=False;
FillEncoreBitmapStruc;
InitCompressor;
Listener:=TNetListener.Create(callback,clihnd,'5670',FEOutInfo,FCV);
framenum:=0;
end;


destructor TCapture.Destroy;
begin

do
Capture:=False;
dispose(EncBuf);
dispose(audioBuff);
Listener.Free;
if FCV.hic<>0 then

begin

ICSeqCompressFrameEnd(@fcv);
ICClose(FCV.hic);
end;



end;


procedure TCapture.ClientConnect(addr,port:string);
begin

Listener.clientconnect(addr,port);
end;


procedure TCapture.Clientclose;
begin

Listener.clientclose;

end;


procedure TCapture.FillEncoreBitmapStruc;
//==========填写压缩的图象结构
begin

try
//--------------------------
// 填写压缩前的图象信息
//--------------------------
FillChar(FEInInfo.bmiHeader, SizeOf(TBitmapInfoHeader), 0);
with FEInInfo.bmiHeaderdo

begin

biBitCount := 24;
biCompression := BI_RGB;
biWidth := FWidth;
biHeight := FHeight;
biPlanes := 1;
biSize := SizeOf(TBitmapInfoHeader);
end;

except

end;

end;


procedure TCapture.InitCompressor;
//==========初始化压缩器==========
var
res:integer;
begin

{ try
FillChar(FCV, SizeOf(TCOMPVARS), 0);
FCV.cbSize := sizeof(TCOMPVARS );
if ICCompressorChoose( Form1.Handle, ICMF_CHOOSE_ALLCOMPRESSORS, nil, nil, @FCV, 'Select a compressor' ) then

begin

FillChar( FEOutInfo, sizeof(FEOutInfo), 0 );
ICCompressGetFormat( FCV.hic, @FEInInfo, @FEOutInfo );
GetMem( EncBuf, FEOutInfo.bmiHeader.biSizeImage );
ICSeqCompressFrameStart( @FCV, @FEInInfo );
end;

except
//LogFile.WriteLog('InitCompressor Exception');
end;
}
try
FillChar(FCV, SizeOf(FCV), 0);
with FCVdo

begin

dwFlags := ICMF_COMPVARS_VALID;
cbSize := SizeOf(FCV);
fccHandler := mmioFOURCC('d','i','v','4');
//'X','V','I','D' 'D','I','V','X'
fccType := ICTYPE_VIDEO;
hic := ICOpen(ICTYPE_VIDEO, mmioFOURCC('d','i','v','4'), ICMODE_COMPRESS);
if hic=0 then

begin

fccHandler := mmioFOURCC('d','i','v','3');
//'X','V','I','D' 'D','I','V','X'
fccType := ICTYPE_VIDEO;
hic := ICOpen(ICTYPE_VIDEO, mmioFOURCC('d','i','v','3'), ICMODE_COMPRESS);
end;

lDataRate := 780;
lKey := 15;
lQ := ICQUALITY_DEFAULT;
if hic <> 0 then

begin

FillChar(FEOutInfo, SizeOf(FEOutInfo), 0);
ICCompressGetFormat(hic, @FEInInfo, @FEOutInfo);

GetMem( EncBuf, FEOutInfo.bmiHeader.biSizeImage );
ICSeqCompressFrameStart(@FCV, @FEInInfo);
end;

end;

except

end;

end;




function TCapture.Open:Boolean;
var
CapParms:TCAPTUREPARMS;
begin

FCaptureHandle := capCreateCaptureWindow('Capture Window', WS_VISIBLE or WS_CHILD, 0, 0, FWidth, FHeight, FCaptureWinHnd, 0);
if FCaptureHandle = 0 then

begin

result:=False;
exit;
end;

{if not capDlgVideoSource(FCaptureHandle) then

begin

result:=False;
exit;
end;
}
if not capDriverConnect(FCaptureHandle, 0) then

begin

result:=False;
exit;
end;


if not capSetVideoFormat(FCaptureHandle, @FEInInfo, SizeOf(FEInInfo)) then

begin

SendMessage(FCaptureHandle, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
//exit;
end;

capPreviewRate(FCaptureHandle, 320);
//if cappreviewScale(FCaptureHandle,true) then
form1.memo1.Lines.Append('scale ok');
//capSetCallbackOnFrame(FCaptureHandle, CapCallBack);

if not capSetCallbackOnVideoStream(FCaptureHandle,CapCallBack) then

begin

result:=False;
exit;
end;



//capSetCallbackOnYield(FCaptureHandle,YieldCallBack);
if not capSetCallbackOnYield(FCaptureHandle,YieldCallBack) then

begin

result:=False;
exit;
end;

if not capCaptureGetSetup(FCaptureHandle,@CapParms,sizeof(TCAPTUREPARMS)) then

begin

result:=False;
exit;
end;

CapParms.dwIndexSize:=324000;
CapParms.fMakeUserHitOKToCapture:=not CapParms.fMCIControl;
CapParms.wPercentDropForError:=100;
CapParms.wNumVideoRequested:=5;
CapParms.wChunkGranularity:=0;
CapParms.fYield:=true;
CapParms.fCaptureAudio:=False;
CapParms.vKeyAbort:=0;
CapParms.fAbortLeftMouse:=false;
CapParms.fAbortRightMouse:=false;
CapParms.dwRequestMicroSecPerFrame:=trunc(1000000/10);

if not capCaptureSetSetup(FCaptureHandle,@CapParms,sizeof(TCAPTUREPARMS)) then

begin

result:=False;
exit;
end;

result:=True;

end;


procedure TCapture.StartCap;
begin


if not capOverlay(FCaptureHandle, TRUE) then

capPreview(FCaptureHandle, True);
capCaptureSequenceNoFile(FCaptureHandle);
do
Capture:=True;
end;


procedure TCapture.OpenPreView;
begin

capPreview(FCaptureHandle, True);
end;


procedure TCapture.ClosePreView;
begin

capPreview(FCaptureHandle, False);
end;


function CapCallBack(hWnd: HWND;
lpVHdr: PVIDEOHDR): DWORD;
stdcall;

begin

if (cap.Listener.isConnected) and (cap.doCapture) then

begin

cap.CompressFrame(lpVHdr);
end;

end;




function YieldCallBack(hWnd: HWND): DWORD;
stdcall;
var
MsgRec : TMsg;
begin



if PeekMessage(MsgRec,0,0,0,PM_REMOVE) then

begin

TranslateMessage(MsgRec);
DispatchMessage(MsgRec);
end;

end;


procedure TCapture.CompressFrame(lpVHdr: PVIDEOHDR);
//==========做压缩的动作==========
var
KeyFrame: Boolean;
key:integer;
Buffer: PByte;
begin

key:=0;
if Listener.NeedKeyFrame then

begin

ICSeqCompressFrameStart( @FCV, @FEInInfo );
key:=1;
//Listener.setKeyFrameFalse;
//Form1.Memo1.Lines.Append(datetimetostr(now)+'---------------------');
end;

FEncSize := FEInInfo.bmiHeader.biSizeImage;
//cap.FEncSize := lpVHdr^.dwBytesUsed;
//keyframe:=True;
//ICSeqCompressFrameStart( @FCV, @FEInInfo );
Buffer := ICSeqCompressFrame(@FCV, 0, lpVHdr^.lpData, @KeyFrame, @FEncSize);
//if keyframe then
keyframe:=False;
FillChar( EncBuf^, FEncSize, 0);
CopyMemory( EncBuf,Buffer, FEncSize );
try
Listener.SendStream(EncBuf,FEncSize,OPT_CONTENT,framenum,key);
framenum:=(framenum+1) mod 10000;
//Form1.Memo1.Lines.Append(datetimetostr(now)+'---------------------');
except
end;


end;



procedure TCapture.SendText(text:string);
begin

Listener.SendText(text);
end;


end.

这里用的是divx4

能否发一份FOR D6版的VFW给我呢？

邮箱：wang_80920@163.com

谢谢 eyes4兄：
结贴时,送上50分；

多人接受答案了。