frm_k_qjdjpas.pas1

来自「是一个用delphi设计的考勤系统」· PAS1 代码 · 共 370 行

PAS1
370
字号
unit Frm_K_QjdjPas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ModalForm, Menus, StdCtrls, ExtCtrls, DB, DBTables, ComCtrls,
  Grids, DBGrids, Buttons, ChangeImage, YLabelButton,ADODB;

type
  TFrm_K_Qjdj = class(TMyModalForm)
    Panel3: TPanel;
    GroupBox4: TGroupBox;
    Label6: TLabel;
    Label2: TLabel;
    ksrq: TDateTimePicker;
    rbnsj1: TRadioButton;
    rbnsj2: TRadioButton;
    rbnsj3: TRadioButton;
    jsrq: TDateTimePicker;
    TV: TTreeView;
    GroupBox1: TGroupBox;
    Label11: TLabel;
    Label8: TLabel;
    Label4: TLabel;
    qqyy: TEdit;
    qqbh: TComboBox;
    yhbh: TEdit;
    Rg1: TRadioButton;
    Rg2: TRadioButton;
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    searchbox: TPanel;
    GroupBox3: TGroupBox;
    Label15: TLabel;
    dtp1: TDateTimePicker;
    dtp2: TDateTimePicker;
    Panel2: TPanel;
    Label13: TLabel;
    Label14: TLabel;
    Label17: TLabel;
    chk1: TCheckBox;
    Edit1: TEdit;
    chk3: TCheckBox;
    Edit2: TEdit;
    Chk2: TCheckBox;
    qqlb: TComboBox;
    bmmc: TEdit;
    D5_qqjl: TDataSource;
    Dyhxx: TDataSource;
    LbtnNew: TLabelB;
    BtnNew: TChangeImg;
    BtnDelete: TChangeImg;
    LBtnDelete: TLabelB;
    BtnFind: TChangeImg;
    LBtnFind: TLabelB;
    ChangeImg4: TChangeImg;
    LabelB5: TLabelB;
    BtnOk: TChangeImg;
    LBtnOk: TLabelB;
    BtnExit: TChangeImg;
    LBtnExit: TLabelB;
    Qyhxx: TADOQuery;
    Q5_qqjl: TADOQuery;
    pkq_A_qjdj: TADOStoredProc;
    procedure ChangeImg4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnNewClick(Sender: TObject);
    procedure BtnOkClick(Sender: TObject);
    procedure BtnFindClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure GroupBox4DblClick(Sender: TObject);
    procedure yhbhKeyPress(Sender: TObject; var Key: Char);
    procedure rbnsj1Click(Sender: TObject);
    procedure BtnDeleteClick(Sender: TObject);
    procedure GroupBox1DblClick(Sender: TObject);
    procedure TVClick(Sender: TObject);
    procedure yhbhEnter(Sender: TObject);
    procedure BtnExitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Frm_K_Qjdj: TFrm_K_Qjdj;

implementation

uses UGlobal, DM_DataModal;

{$R *.dfm}

procedure TFrm_K_Qjdj.ChangeImg4Click(Sender: TObject);
begin
  inherited;
  close;
end;

procedure TFrm_K_Qjdj.FormCreate(Sender: TObject);
begin
  inherited;
  ksrq.date := date;
  jsrq.Date := date;
  dtp1.date := Date - 5;
  dtp2.date := date;
  gtKqgl.LoadOrganTree(Winddata.AdoConn, TV, 4); //初始化用户信息
end;

procedure TFrm_K_Qjdj.BtnNewClick(Sender: TObject);
var
  sqltxt: string;
  arr: array[0..1] of string[50];
  sType, sParams: string; //a为机构,b为分机构,c为部门,d为个人考勤
  NodeValue, mesg: string; //节点关联的数值
  qqms: string;
  retmsg: string;
begin
// 个人请假处理
  if Rg2.Checked then
  begin
    if yhbh.text = '' then
    begin
      application.MessageBox('请输入用户编号!', '信息提示', mb_ok + mb_IconInformation);
      yhbh.setfocus;
      exit;
    end;
    if gtKqgl.ExistsUser(trim(yhbh.text), retmsg) <> 0 then
    begin
      application.MessageBox(PChar(retmsg), '信息提示', mb_ok + mb_IconInformation);
      exit;
    end;
    sType := 'e';
    sParams := trim(yhbh.text);
  end;
  if qqbh.text = '' then
  begin
    application.MessageBox('请选择缺勤类别!', '信息提示', mb_ok + mb_IconInformation);
    qqbh.SetFocus;
    exit;
  end;

//集体请假处理
  if Rg1.checked then
  begin
    try
      NodeValue := ptTreeNode(TV.Selected.data)^.nodeValue;
    except
      application.MessageBox('请选择部门!', '信息提示', mb_ok + mb_IconInformation);
      exit;
    end;
    sType := copy(NodeValue, 1, 1);
    sParams := copy(NodeValue, 2, length(NodeValue) - 1);
    mesg := '请确认您所选的部门:';
    if application.MessageBox(pchar(mesg + TV.Selected.text),
      '信息提示', mb_YesNo + mb_IconQuestion) = IdNo then exit;
  end;
  qqms := copy(trim(qqbh.text), 1, pos(':', trim(qqbh.text)) - 1);
  with pkq_A_qjdj do
  begin
    close;
    parameters.parambyname('@sType').Value := sType;
    parameters.parambyname('@Params').Value := sParams;
    parameters.parambyname('@ksrq').Value := datetostr(ksrq.date);
    parameters.parambyname('@jsrq').Value := datetostr(jsrq.date);
    parameters.parambyname('@qqbh').Value := qqms;
    if rbnsj1.Checked then parameters.parambyname('@sjlb').Value := '整天';
    if rbnsj2.Checked then parameters.parambyname('@sjlb').Value := '上午';
    if rbnsj3.Checked then parameters.parambyname('@sjlb').Value := '下午';
    parameters.parambyname('@qqyy').Value := trim(qqyy.text);
    execproc;
    retmsg:=parameters.parambyname('@retmsg').Value;
    if parameters.parambyname('@return_value').Value <> 0 then
      application.MessageBox(pchar(RetMsg), '信息提示', mb_ok + mb_IconInformation);
  end;
///////更新//////////////////////////////////////////////////////
  with Q5_qqjl do
  begin
    sql.clear;
    sql.add('select * from vkq_qjjl');
    if rg1.Checked then sql.add(' where bmbh=''' + sParams + '''');
    if rg2.Checked then sql.Add(' where yhbh=''' + trim(yhbh.text) + '''');
    sql.add(' and ksrq>=''' + datetostr(ksrq.date) + ''' and jsrq<=''' + datetostr(jsrq.date) + '''');
    sql.add(' order by yhbh,ksrq,jsrq');
    open;
  end;
/////////////////////////////////////////////////////////////
end;

procedure TFrm_K_Qjdj.BtnOkClick(Sender: TObject);
begin
  inherited;
  with Q5_qqjl do
  begin
    sql.clear;
    sql.add('select * from vkq_qjjl');
    sql.add(' where (ksrq>=''' + datetostr(dtp1.date) + '''');
    sql.add(' and ksrq<=''' + datetostr(dtp2.date) + ''')');
//    ***************缺勤情况***********************************************
    if (chk1.Checked) and (edit1.text <> '') then
      sql.add(' and yhbh=''' + trim(edit1.Text) + '''');
    if (chk2.Checked) and (edit2.text <> '') then
      sql.Add(' and yhxm like ''' + trim(edit2.text) + '%''');
    if (chk3.Checked) and (qqlb.text <> '') then
      sql.Add(' and qqmc like ''' + qqlb.text + '%''');
    sql.add('order by bmbh,yhbh');
    open;
  end;
  SearchBox.Visible := false;
end;

procedure TFrm_K_Qjdj.BtnFindClick(Sender: TObject);
begin
  inherited;
  SearchBox.Visible := true;
end;

procedure TFrm_K_Qjdj.FormShow(Sender: TObject);
var
  query: TADOQuery;
  qqms: string;
begin
///////////添加缺勤类别/////////////////////////////////////////
  query := TADOQuery.create(screen.activeform);
  query.Connection := WindData.AdoConn;
  try
    with query do
    begin
      sql.clear;
      sql.add('select qqbh,qqmc from kq_qqlb order by qqbh');
      open;
      first;
      if recordcount > 0 then
      begin
        qqbh.items.Clear;
        qqlb.items.clear;
        while not eof do
        begin
          qqms := fieldbyname('qqbh').asstring + ':' + fieldbyname('qqmc').asstring;
          qqbh.Items.Add(qqms);
          qqlb.Items.Add(fieldbyname('qqmc').asstring);
          next;
        end;
      end;
    end;
  finally
    query.Destroy;
  end;
///////////添加缺勤类别///////////////////////////////////////// 
end;

procedure TFrm_K_Qjdj.GroupBox4DblClick(Sender: TObject);
begin
  inherited;
  pkhxm.visible := true;
  if not Qyhxx.Active then Qyhxx.active := true;
end;

procedure TFrm_K_Qjdj.yhbhKeyPress(Sender: TObject; var Key: Char);
var
  retmsg: string;
begin
  if key = #13 then
  begin
    if gtKqgl.ExistsUser(trim(yhbh.text), retmsg) <> 0 then
    begin
      application.MessageBox(PChar(retmsg), '信息提示', mb_ok + mb_IconInformation);
      yhbh.SetFocus;
      exit;
    end;
    //xm.text := retmsg;
    with q5_qqjl do
    begin
      SQL.Clear;
      sql.Add('select * from vkq_qjjl where yhbh=''' + trim(yhbh.Text) + '''');
      sql.add(' and ksrq>=''' + datetostr(ksrq.date) + ''' and jsrq<=''' + datetostr(jsrq.date) + '''');
      sql.add(' order by yhbh,ksrq,jsrq');
      open;
    end;
  end;
end;

procedure TFrm_K_Qjdj.rbnsj1Click(Sender: TObject);
begin
  inherited;
  if rbnsj1.Checked then
    jsrq.Enabled := True
  else
    jsrq.Enabled := False;
end;

procedure TFrm_K_Qjdj.BtnDeleteClick(Sender: TObject);
var
  sSql: string;
  RetMsg:String;
  RetVal:Integer;
begin
  RetMsg:='';
  RetVal:=-1;
  with Q5_qqjl do
  begin
    if not eof then
    begin
      ssql := '是否删除此请假记录:' + #13 + '  用户编号:' + fieldbyname('yhbh').asstring;
      ssql := ssql + #13 + '    用户姓名:' + fieldbyname('yhxm').asstring;
      ssql := ssql + #13 + '   开始日期:' + fieldbyname('ksrq').asstring + '          ';
      ssql := ssql + #13 + '   结束日期:' + fieldbyname('jsrq').asstring;
      if (application.MessageBox(pchar(ssql), '系统提示', mb_okcancel + mb_iconwarning) = id_ok) then
      begin
        with pkq_a_qjdj do
        begin
          close;
          parameters.parambyname('@sType').Value := 'z';
          parameters.parambyname('@Params').Value := Q5_qqjl.fieldbyname('yhbh').asstring;
          parameters.parambyname('@ksrq').Value := Q5_qqjl.fieldbyname('ksrq').asstring;
          parameters.parambyname('@jsrq').Value := Q5_qqjl.fieldbyname('jsrq').asstring;
          parameters.parambyname('@qqbh').Value := Q5_qqjl.fieldbyname('qqbh').asstring;
          parameters.parambyname('@sjlb').Value := Q5_qqjl.fieldbyname('sjlb').asstring;
          execproc;
          RetVal:=parameters.parambyname('@return_value').Value;
          RetMsg:=parameters.ParamByName('@retmsg').Value;
          if  RetVal<> 0 then
            application.MessageBox(pchar(RetMsg), '信息提示', mb_ok + mb_IconInformation);
        end;
        sql.clear;
        sql.add('select * from vkq_qjjl');
        sql.add(' where yhbh=''' + trim(yhbh.text) + '''');
        open;
      end
      else
        exit;
    end
    else
      application.MessageBox('当前无可删除记录', '系统提示', mb_ok + mb_iconwarning);
  end;
end;

procedure TFrm_K_Qjdj.GroupBox1DblClick(Sender: TObject);
begin
  inherited;
  pkhxm.visible := true;
  if Qyhxx.Active then Qyhxx.active := false; Qyhxx.active := true;
end;

procedure TFrm_K_Qjdj.TVClick(Sender: TObject);
begin
  inherited;
  try
    if tv.Selected.Level > 2 then bmmc.text := TV.Selected.Text;
    rg1.checked := true;
  except
  end;
end;

procedure TFrm_K_Qjdj.yhbhEnter(Sender: TObject);
begin
  inherited;
  rg2.Checked := true;
end;

procedure TFrm_K_Qjdj.BtnExitClick(Sender: TObject);
begin
  inherited;
  SearchBox.Visible := false;
end;

end.

⌨️ 快捷键说明

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