Delphi实现拍照控件的程序代码

完整的delphi拍照控件代码，实现利用摄像头进行拍照的功能。需要TVideoCap控件支持。

procedure Tfrm1.Button2Click(Sender: TObject);

Var

jpeg: TJPEGImage;

bmp: TBitmap;

MyStm:TMemoryStream;

strfilename,strcard:String;

begin

inherited;

strfilename:=extractfilepath(Application.ExeName);

with DBEdit12.DataSource.DataSet do

begin

if not VideoCap1.SaveAsDIB then

begin

ShowMessage('拍摄照片失败');

Abort;

end;//

bmp:= TBitmap.Create;

try

bmp.LoadFromFile(strfilename+ 'Capture.bmp' );

MyStm:=TMemoryStream.Create;

jpeg:= TJPEGImage.Create;

try

jpeg.Assign( bmp );

jpeg.compress;

jpeg.SaveTofile( strfilename+'Capture.jpg');

strfilename:=strfilename+'Capture.jpg';

jpeg.LoadFromFile(strfilename);

jpeg.SaveToStream(MyStm);

MyStm.Position:=0;

OpenQry(query1,'select count(1) as cnt from tb_photo where card_no='''+strcard+'''');//先查找是否有此卡号

OpenQry(pubqry,'select * from tb_photo where card_no='''+strcard+'''');//打开卡号数据表

{OpenQry是自定义打开数据表的函数

OpenQry(qry1:TQuery,ssql:String);

begin

with qry1 do

beign

if active then

close;

sql.clear;

sql.add(ssql);

try

open

catch

on E: Exception do ErrorDialog(E.Message, E.HelpContext);

end;//try

end;

end; 

} 

with query1 do

begin

if pubqry.Fields[0].AsInteger >0 then //先判断此卡号的图片是否存在，若存在，替换；否则，插入。

Edit

else

Insert;

FieldByName('card_no').AsString :=strcard;

TBlobField(FieldByName('photo')).LoadFromStream(MyStm);

Post; //统一提交

end;//with

finally

MyStm.Free;

jpeg.free;

end; //try

finally

bmp.free;

end;//try

end;//with

end;