操作系统  办公  实用知识  设计  开发  WEB开发  移动开发  数据库  软件工程  网管  安全  管理  信息化  答疑  渠道 

DIY个照相机-Delphi实现摄像头拍照功能

2005-3-23 作者:mzyp2002 转载自:CSDN 网友评论 0 条 点击进入论坛

简介:本文提供一段完整的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;
//请首先下载TVideoCap控件

已有 0 位对此文章感兴趣的网友发布了看法    
我来评两句 登录邮箱: 密码:
  匿名发表
今日推荐
技术文库(共有 46294 篇文章)
操作系统
办公软件
实用知识
网络管理
软件开发
WEB开发
软件工程
数据库
设计在线
信息安全
行业信息化
管理信息化
移动开发
重点推荐
电子杂志订阅
点击电子杂志名称查看样刊
输入E-mail地址即可订阅
E-mail