⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 utxcj.pas

📁 图书管理系统,已经用于市场,此软件只供学习使用,不的用于商业行为
💻 PAS
📖 第 1 页 / 共 2 页
字号:

unit Utxcj;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Grids, DBGrids, StdCtrls,DB, Buttons;

type
  Ttxcjfrm = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    cbxy: TComboBox;
    cbzy: TComboBox;
    cbnj: TComboBox;
    cbbj: TComboBox;
    Btquery: TBitBtn;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    editxm: TEdit;
    editxh: TEdit;
    editxy: TEdit;
    editzy: TEdit;
    editbj: TEdit;
    Image2: TImage;
    Btprior: TBitBtn;
    Btnext: TBitBtn;
    Btrefresh: TBitBtn;
    Btphoto: TBitBtn;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    dbxsxx: TDBGrid;
    Btexit: TBitBtn;
    Timer1: TTimer;
    procedure BtexitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cbxyChange(Sender: TObject);
    procedure cbzyDropDown(Sender: TObject);
    procedure cbzyChange(Sender: TObject);
    procedure cbbjDropDown(Sender: TObject);
    procedure BtqueryClick(Sender: TObject);
    procedure cbxyClick(Sender: TObject);
    procedure cbzyClick(Sender: TObject);
    procedure cbnjClick(Sender: TObject);
    procedure cbbjClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure BtphotoClick(Sender: TObject);
    procedure BtrefreshClick(Sender: TObject);
    procedure readfromdatabase();
    procedure BtnextClick(Sender: TObject);
    procedure BtpriorClick(Sender: TObject);
    procedure dbxsxxCellClick(Column: TColumn);
    procedure dbxsxxDrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction); //读数据中的图片数据过程
  private
    hWndC : THandle;
    procedure ZoomImage (SetWidth: integer; SetHeight: integer);//缩小图片尺寸过程声明

    { Private declarations }
  public
    { Public declarations }
  end;
 Procedure SetColomnWidth(Sender:TDBGrid);
var
  txcjfrm: Ttxcjfrm;
implementation

uses UDM, UMain;

{$R *.dfm}
const WM_CAP_START = WM_USER;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_SET_OVERLAY =WM_CAP_START+  51 ;
const WM_CAP_SET_PREVIEW =WM_CAP_START+  50 ;
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
const WM_CAP_SET_SCALE=WM_CAP_START+  53 ;
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+  52 ;
function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint;
x : integer;
y : integer;
nWidth : integer;
nHeight : integer;
ParentWin : HWND;
nId : integer): HWND;
STDCALL EXTERNAL 'AVICAP32.DLL';  //使用MS的AVICAP32.DLL实现对摄像头编程

Procedure SetColomnWidth(Sender:TDBGrid); //使dbgrid中的列的宽度适宜
var i:Integer;
begin
   for i:= 0 to Sender.Columns.Count-1 do
       Sender.Columns[i].Width:=90;
end;

procedure savetodatabase(); //保存图片到数据库中
var ms:tmemorystream;
begin
  with dm.adocard do
     begin
        close;
        sql.Clear;
        sql.Add('select * from card');
        open;
     end;
     ms:=tmemorystream.Create;
     try
        ms.LoadFromFile(extractfilepath(application.ExeName)+'picture\photo\photo.bmp');
        dm.adocard.Insert ;
        dm.adocard.FieldByName('xh').AsString :=trim(dm.adoinfoquery.FieldValues['xh']);
        dm.adocard.FieldByName('xm').AsString :=trim(dm.adoinfoquery.FieldValues['xm']);
        dm.adocard.FieldByName('zymc').AsString :=trim(dm.adoinfoquery.FieldValues['zymc']);
        dm.adocard.FieldByName('zyxh').AsString :=trim(dm.adoinfoquery.FieldValues['zyxh']);
        dm.adocard.FieldByName('yx').AsString :=trim(dm.adoinfoquery.FieldValues['yx']);
        dm.adocard.FieldByName('bhmc').AsString :=trim(dm.adoinfoquery.FieldValues['bhmc']);
        dm.adocard.FieldByName('tm').AsString :=concat('*',trim(dm.adoinfoquery.FieldValues['xh']),'*');
        (dm.adocard.FieldByName('photo') as TBlobfield).LoadFromStream(ms);
        dm.adocard.Post;
     finally
        ms.free;
     end;
end;

procedure Ttxcjfrm.readfromdatabase();//读数据库中的图像数据并显示在image1图片框中
var path: string;
    ms:tmemorystream;
begin
    path:=extractfilepath(application.ExeName);
    ms:=tmemorystream.Create ;
   try
      (dm.adocard.FieldByName('photo') as tblobfield).SaveToStream(ms);
       ms.SaveToFile(path+'picture\photo\photo.bmp');
       image1.Picture.LoadFromFile(path+'picture\photo\photo.bmp');
    finally
      ms.free;
    end;

 end;

procedure Ttxcjfrm.ZoomImage (SetWidth: integer; SetHeight: integer); //缩小图片尺寸过程
var Bitmap: TBitmap;
     // DstRect: TRect;
begin
   { Refresh first -- needed as one maked the image really big first}
   Image1.Picture.Graphic.LoadFromFile(extractfilepath(application.ExeName)+'picture\photo\photo.bmp');
   Bitmap := TBitmap.Create;
   Bitmap.Width := SetWidth;
   Bitmap.Height := SetHeight;
   Bitmap.Canvas.StretchDraw(Bitmap.Canvas.ClipRect,Image1.Picture.Graphic);
   Image1.Picture.Graphic := Bitmap;
   Image1.Invalidate; //quite important...
end;

procedure Ttxcjfrm.BtexitClick(Sender: TObject);
begin
 self.Close ;
end;

procedure Ttxcjfrm.FormCreate(Sender: TObject);//创建窗体
var i:integer;
begin
   mainfrm.StatusBar1.Panels.Items[1].Text:='您当前的操作为: '+'头像采集';
   image1.Picture.LoadFromFile(extractfilepath(application.ExeName)+'picture\photo\no.bmp');
   btquery.Enabled :=false;    //查询按钮不可用
   btprior.Enabled :=false;    //上一个按钮不可用
   btnext.Enabled :=false;     //下一个按钮不可用
   btrefresh.Enabled :=false;  //重拍按钮不可用
   btphoto.Enabled :=false;    //拍照按钮不可用
   cbxy.Items.Clear ; //初始化时使学院组合框清空
   with dm.adoinfo do
     begin
        close;
        sql.Clear ;
        sql.Add('select distinct yx from information');
        open;
     end;
   while not dm.adoinfo.Eof do  //加载学院名称到组合框中
      begin
        cbxy.Items.Add(dm.adoinfo.Fieldbyname('yx').AsString );
        dm.adoinfo.Next ;
      end;
   for i:=2003 to 2010 do
        cbnj.Items.Add(inttostr(i));
end;

procedure Ttxcjfrm.cbxyChange(Sender: TObject); //当组合框中显示的文本内容改变时发生
begin
    cbzy.Items.Clear ; //清空专业组合框中的内容
    cbbj.Items.Clear ; //清空班级组合框中的内容
end;

procedure Ttxcjfrm.cbzyDropDown(Sender: TObject);   //专业下拉框下拉时发生事件
begin
     cbzy.Items.Clear;
     if cbxy.Text <>'' then
      begin
        with dm.adoinfo do
           begin
              close;
              sql.Clear ;
              sql.Add('select distinct zymc from information where yx=:xy');
              parameters.ParamByName('xy').Value :=trim(cbxy.Text);
              open;
           end;
        while not dm.adoinfo.Eof  do
          begin
               cbzy.Items.Add(dm.adoinfo.fieldbyname('zymc').AsString);
               dm.adoinfo.Next ;
          end;
     end;
end;

procedure Ttxcjfrm.cbzyChange(Sender: TObject);  //专业下拉框中的文本内容改变时发生
begin
  cbbj.Items.Clear;  //清空班级下拉框中的内容
end;

procedure Ttxcjfrm.cbbjDropDown(Sender: TObject);  //班级下拉框下拉时发生事件
begin
   cbbj.Items.Clear ;
   if (cbxy.Text <>'') and (cbzy.Text <>'') and (cbnj.Text<>'') then
      begin
          with dm.adoinfo do
             begin
                close;
                sql.Clear;
                sql.Add('select distinct bhmc from information where yx=:xy and zymc=:zy and xh like '''+trim(cbnj.Text)+'%'' ');
                parameters.ParamByName('xy').Value :=trim(cbxy.Text );
                parameters.ParamByName('zy').Value :=trim(cbzy.Text );
                open;
             end;
          while not dm.adoinfo.Eof do
              begin
                 cbbj.Items.Add(dm.adoinfo.fieldbyname('bhmc').AsString );
                 dm.adoinfo.Next ;
              end;
      end;
end;

procedure Ttxcjfrm.BtqueryClick(Sender: TObject);//查询按钮事件
  var
     str:string;   //查询条件
begin
    str:='';
    if cbxy.Text <>''then
       str:='yx='''+trim(cbxy.Text)+'''';
    if cbzy.Text <>'' then
       str:=str+'and zymc='''+trim(cbzy.Text)+'''';
    if cbnj.Text <>'' then
       str:=str+'and xh like '''+trim(cbnj.Text)+'%''';
    if cbbj.Text <>'' then
       str:=str+'and bhmc='''+trim(cbbj.Text)+'''';
    with dm.adoinfoquery do
       begin
           close;
           sql.Clear;
           sql.Add('select xh,xm,yx,zymc,zyxh,bhmc,zydm,xz,sxh,ksh from information where '+str);
           open;
       end;
    dbxsxx.DataSource :=DM.DataSource1;
    if dm.adoinfoquery.RecordCount=0 then   //没有记录
        begin
          messagebox(handle,'当前没有你要查询的记录,请重新选择条件','系统提示',mb_iconwarning+mb_ok);
          label12.Caption :='';
          btquery.Enabled :=false;    //查询按钮不可用

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -