程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi實現攝像頭拍照功能

Delphi實現攝像頭拍照功能

編輯: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;
//請首先下載TVideoCap控件

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved