使用VFW捕捉图象的一段程序，比较简单，因为我未使用Socket所以
Socket那段在我的程序不使用，仅供参考：
procedure TPos_MainFrm.CAPStatus(Sender: TObject);
begin
Panel6.Color := clBtnFace;
Panel6.Refresh;
end;
procedure TPos_MainFrm.PlayVideo;
var
MyCapStatusProc : TCapStatusProc;
begin
// 开始捕捉视频
CapSetVideoArea( VideoArea );
CapSetInfoLabel( lblVideoInfo);
MyCapStatusProc := CAPStatus;
CapSetStatusProcedure( MyCapStatusProc );
if CapOpenDriver then
begin
CapSetCapSec( 15 * 3 );
CapShow;
end;
end;
procedure TPos_MainFrm.CaptureVideo;
begin
Panel6.Color := clRed;
Panel6.Refresh;
CapSetCapSec( StrToInt(ReadReg('CapTime'))*15);
CapStart;
end;
procedure TPos_MainFrm.StopVideo;
begin
CapStop;
Panel6.Color := clBtnFace;
Panel6.Refresh;
end;
procedure TPos_MainFrm.SaveVideoPicture;
var
SingleImageFIleName:string;
picName:string;
// Mybmp:Tbitmap;
// MyJpg:TJpegImage;
begin
PicName:=FCurrentNO_CUR+'.bmp';
SingleImageFileName :=picSavePath+PicName;
CapSetSingleImageFileName( SingleImageFileName );
CapGrabSingleFrame;
CapSetVideoLive;
// Mybmp:=Tbitmap.Create;
// MyJpg:=TJpegImage.Create;
// Mybmp.LoadFromFile(SingleImageFileName);
// MyJpg.Assign(Mybmp);
// MyJpg.Performance:=JpBestSpeed;
// MyJpg.CompressionQuality:=10;
// MyJpg.Compress;
// MyJpg.SaveToFile(currentNO_Cur+'.jpg');
// MyJpg.Free;
// Mybmp.Free;
TransPictrue(SingleImageFileName);
end;
procedure TPos_MainFrm.TransPictrue(PictureName:string);
var
//S, S1: string;
MyBmp: TBitmap;
Myjpg: TJpegimage;
begin
{ try
MyStream := TMemorystream.Create; //建立内存流
MyBmp := TBitmap.Create;
Myjpg := TJpegimage.Create;
MyBmp.LoadFromFile(pictrueName);
Myjpg.Assign(MyBmp); //将BMP图象转成JPG格式
MyJpg.Performance:=JPBestSpeed;
Myjpg.CompressionQuality := 10; //JPG文件压缩百分比设置,数字越大图像越清晰,但数据也越大
Myjpg.SaveToStream(MyStream); //将JPG图象写入流中
Myjpg.free;
MyStream.Position := 0;
s1 :=inttostr(MyStream.size); //流的大小
Socket1.Socket.SendText(s1); //发送流大小
finally
MyBmp.free;
end;
MyStream.Position := 0;
Socket1.Socket.SendStream(MyStream);//将流发送出去
}
try
MyBmp:=Tbitmap.Create;
Mybmp.LoadFromFile(PictureName);
Myjpg:=TJpegImage.Create;
With MyJpg do
begin
Assign(Mybmp);
//Performance:=JPBestSpeed;
CompressionQuality :=50;
Compress;
SaveTofile(PicSavePath+'/'+FCurrentNO_Cur+'.jpg');
DeleteFile(pictureName);
end;
finally
Mybmp.Free;
Myjpg.Free;
end;
if conn then
CopyFile(Pchar(SourcePath +FCurrentNo_CUR+'.jpg'),Pchar(DestPath+FCurrentNO_Cur+'.jpg'),false)
else
begin
{如果图片没有传送成功，那么在本地存放图片的目录下建立一个文件夹
来存放未传送成功的图片}
if Not DirectoryExists(SourcePath+'未传送图片') then
CreateDir(sourcePath+'未传送图片');
CopyFile(Pchar(SourcePath +FCurrentNo_CUR+'.jpg'),Pchar(SourcePath+'未传送图片/'+FCurrentNO_Cur+'.jpg'),false);
end;
end;
