zoukankan      html  css  js  c++  java
  • 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;
  • 相关阅读:
    1-直播转点播
    3-美团 HTTP 服务治理实践
    3-SSDB 高性能NoSQL数据库, 用于替代 Redis.
    配置kubectl在Mac(本地)远程连接Kubernetes集群
    4-rocketmq 发送时异常:system busy 和 broker busy 解决方案
    3-RocketMQ 简单梳理 及 集群部署笔记
    2-Rocketmq产品架构(参考阿里云)
    1-RocketMq 学习 中文文档(一)
    tar命令参数详解
    Ubuntu 安装 .bundle 文件
  • 原文地址:https://www.cnblogs.com/westsoft/p/10166786.html
Copyright © 2011-2022 走看看