frm_autocollect.pas
来自「是一个用delphi设计的考勤系统」· PAS 代码 · 共 291 行
PAS
291 行
{
***************************************************************
* 说明:自动采集设置 *
* 时间:2003/03/04 *
* 作者:杨泉清 *
***************************************************************
}
unit Frm_AutoCollect;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ModalForm, DB, ADODB, ComCtrls, Grids, DBGrids, StdCtrls,
YLabelButton, ChangeImage, Menus, ExtCtrls;
type
TAutoCollect = class(TMyModalForm)
BtnNew: TChangeImg;
LbtnNew: TLabelB;
BtnEdit: TChangeImg;
LBtnEdit: TLabelB;
BtnDelete: TChangeImg;
LBtnDelete: TLabelB;
BtnRefresh: TChangeImg;
LBtnRefresh: TLabelB;
BtnHelp: TChangeImg;
LBtnHelp: TLabelB;
BtnFind: TChangeImg;
LBtnFind: TLabelB;
DBGrid1: TDBGrid;
StatusBar1: TStatusBar;
DataSource1: TDataSource;
ADOQry: TADOQuery;
GroupBox1: TGroupBox;
Label3: TLabel;
edtsj: TDateTimePicker;
cbczlx: TComboBox;
Label1: TLabel;
ADOExec: TADOQuery;
procedure BtnNewClick(Sender: TObject);
procedure BtnEditClick(Sender: TObject);
procedure BtnDeleteClick(Sender: TObject);
procedure BtnRefreshClick(Sender: TObject);
procedure BtnFindClick(Sender: TObject);
procedure BtnHelpClick(Sender: TObject);
procedure DBGrid1CellClick(Column: TColumn);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure EdtclbhKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
xh: integer;
procedure InitValue; //初始化窗体数据
procedure SetEditValue; //设置各显示框的数据值
function CheckValue: boolean; //检查各个输入框值的准确性
procedure ExecStore(optmode: integer); //执行存储过程
public
{ Public declarations }
end;
var
AutoCollect: TAutoCollect;
implementation
uses
DM_DataModal, Uglobal, UgeneralFunc;
{$R *.dfm}
procedure TAutoCollect.InitValue;
begin
cbczlx.ItemIndex := 0;
edtsj.SetFocus;
statusbar1.Panels[2].Text := 'Insert';
with AdoQry do
begin
sql.Clear;
sql.Add('select * from zx_d_zdcjsj');
open;
end;
end;
procedure TAutoCollect.SetEditValue;
begin
if AdoQry.RecordCount > 0 then
begin
cbczlx.ItemIndex := AdoQry.fieldbyname('czlx').AsInteger - 1;
Edtsj.DateTime := strtodatetime(AdoQry.fieldbyname('sj').asstring);
xh := AdoQry.fieldbyname('ID').AsInteger;
end;
end;
function TAutoCollect.CheckValue: boolean;
begin
result := false;
if cbczlx.Text = '' then
begin
statusbar1.Panels[1].Text := '执行类型不可为空值,请选择!';
cbczlx.SetFocus;
cbczlx.SelectAll;
exit;
end;
Result := true;
end;
procedure TAutoCollect.ExecStore(OptMode: integer);
var
Sqlstr: string;
begin
case Optmode of
1: Sqlstr := 'insert into zx_d_zdcjsj(sj,czlx) values(''' + formatdatetime('hh:mm:ss', edtsj.datetime) + ''',' + inttostr(cbczlx.ItemIndex + 1) + ')';
2: Sqlstr := 'delete from zx_d_zdcjsj where Id=' + inttostr(xh);
3: Sqlstr := 'update zx_d_zdcjsj set sj=''' + formatdatetime('hh:mm:ss', edtsj.datetime) + ''',czlx=' + inttostr(cbczlx.ItemIndex + 1) + ' where Id=' + inttostr(xh);
else
Sqlstr := '';
end;
with AdoExec do
begin
sql.Clear;
sql.Add(sqlstr);
try
ExecSql;
Statusbar1.Panels[1].Text := '系统自动执行信息设置成功';
InitValue;
except
Statusbar1.Panels[1].Text := '设置系统自动执行信息时出现意外!';
end;
end;
end;
procedure TAutoCollect.BtnNewClick(Sender: TObject);
begin
inherited;
if CheckValue then ExecStore(1);
end;
procedure TAutoCollect.BtnEditClick(Sender: TObject);
begin
inherited;
if CheckValue then ExecStore(3);
end;
procedure TAutoCollect.BtnDeleteClick(Sender: TObject);
var
msg: string;
begin
inherited;
msg := '请确认要删除该笔执行信息!';
if showmsg(msg, 0, 2) then
begin
ExecStore(2);
end
else
statusbar1.Panels[1].Text := '删除操作已取消!';
end;
procedure TAutoCollect.BtnRefreshClick(Sender: TObject);
begin
inherited;
InitValue;
statusbar1.Panels[1].Text := '';
end;
procedure TAutoCollect.BtnFindClick(Sender: TObject);
var
Sqlstr: string;
iRec: integer;
begin
inherited;
irec := 0;
Sqlstr := 'select * from zx_d_zdcjsj';
if (length(trim(formatdatetime('hh:mm:ss', Edtsj.DateTime))) > 0) then
begin
if irec < 1 then
begin
SqlStr := Sqlstr + ' where (sj like ''' + trim(formatdatetime('hh:mm:ss', Edtsj.DateTime)) + ''')';
inc(irec);
end
else begin
SqlStr := Sqlstr + ' and (sj like ''' + trim(formatdatetime('hh:mm:ss', Edtsj.DateTime)) + ''')';
inc(irec);
end;
end;
if (length(trim(cbczlx.Text)) > 0) then
begin
if irec < 1 then
begin
SqlStr := Sqlstr + ' where (czlx like ' + inttostr(cbczlx.ItemIndex + 1) + ')';
inc(irec);
end
else begin
SqlStr := Sqlstr + ' and (czlx like ' + inttostr(cbczlx.ItemIndex + 1) + ')';
inc(irec);
end;
end;
if irec = 0 then
begin
statusbar1.Panels[1].Text := '请输入查询条件,只能根据执行时间或执行类型进行查询!';
exit;
end;
with Adoqry do
begin
sql.Clear;
sql.Add(sqlstr);
open;
end;
if Adoqry.RecordCount > 0 then
begin
SetEditValue;
edtsj.SetFocus;
statusbar1.Panels[1].Text := '查找到' + inttostr(Adoqry.RecordCount) + '笔符合条件的记录!';
statusbar1.Panels[2].Text := 'Modify'
end
else begin
InitValue;
statusbar1.Panels[1].Text := '无符合条件的自动执行信息!';
end;
end;
procedure TAutoCollect.BtnHelpClick(Sender: TObject);
begin
inherited;
//帮助信息
HtmlHelp(Handle, gtSyscs.sHelpFileName, $0001, DWORD(PChar('Introduction.htm')));
end;
procedure TAutoCollect.DBGrid1CellClick(Column: TColumn);
begin
inherited;
SetEditValue;
Edtsj.SetFocus;
statusbar1.Panels[2].Text := 'Modify';
end;
procedure TAutoCollect.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := Cafree;
end;
procedure TAutoCollect.EdtclbhKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Sqlstr: string;
begin
inherited;
if key = 13 then
begin
if formatdatetime('hh:mm:ss', Edtsj.datetime) = '' then
begin
statusbar1.Panels[1].Text := '系统自动执行时间不可为空值,请输入!';
exit;
end;
SqlStr := 'select * from zx_d_zdcjsj where sj like ''' + formatdatetime('hh:mm:ss', Edtsj.datetime) + '''';
with Adoqry do
begin
sql.Clear;
sql.Add(sqlstr);
open;
end;
if Adoqry.RecordCount > 0 then
begin
SetEditValue;
statusbar1.Panels[1].Text := '查找到' + inttostr(Adoqry.RecordCount) + '笔符合条件的记录!';
statusbar1.Panels[2].Text := 'Modify'
end;
cbczlx.SetFocus;
cbczlx.SelectAll;
end;
end;
procedure TAutoCollect.FormShow(Sender: TObject);
var
Sqlstr: string;
begin
inherited;
InitValue;
end;
procedure TAutoCollect.FormDestroy(Sender: TObject);
begin
inherited;
AutoCollect := nil;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?