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 + -
显示快捷键?