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