📄 utxcj.pas
字号:
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 + -