publicfunction.pas
来自「pasa人力资源考勤管理系统」· PAS 代码 · 共 1,538 行 · 第 1/4 页
PAS
1,538 行
unit publicfunction;
interface
uses
Windows, Messages, SysUtils, Classes, AppEvnts, Db, DBTables, Graphics, Controls, Forms, Dialogs,
BdeUtils, Menus, Math, ADODB, ExtCtrls, StdCtrls, DBGrids, Registry, Dbctrls, Inifiles, ComCtrls;
type
Tdbgridsort=class
procedure sort(column:Tcolumn;DtSet:TCustomADODataSet;var f:string);overload;
end;
type
PUserRight=^UserRight;
UserRight=Record
no:string; //帐号
menuname:string; //菜单项名
formname:TForm; //窗体名
R_Add:boolean; //新增权限
R_Edit:boolean; //修改权限
R_Del:boolean; //删除权限
R_Print:boolean; //打印权限
end;
procedure dbgrid_keypress(sender:TObject;var key:char);
procedure GetWhere(xx_QyAw:TADODataset;var Select,where,OG:string);
procedure AnalyseSQLWhereOrderGroup(Old_SQL:String;var Str_Select,Str_Where,Str_OG:String);
function Gettablename(sql:string):string; //获得Select 语句中table的名字
function getdays(month,year:string):integer;
function hans1Dechans2Hour(hanss1,hanss2:string;sj:integer):Real;
Function FindField(Data:TDataset;Str:String):TField; //判断STR是否为Table中的一个栏位
function DateDec(rq:String;days:integer):String; //将字符串型日期加上days天 days可为正也可为负
function MonthDec(rq:string;inteval:integer):String; //将字符串型月份加上Inteval月 inteval可为正也可为负
function date1Decdate2Hour(date1,date2:string;sj:integer):Real;
function date1decdate2day(date1,date2:string):real; //计算两个日期之间的天数
function date1Decdate2Minute(date1,date2:string):Integer;
function booleantostr(b:boolean):string; //布尔型转化成字符型
function strtoboolean(s:string):boolean; //字符型转化成布尔型
function calcfixot(kind:string;workno:string):Real; //计算固定加班(每小时加班费)
function calcaddmoney(workno:string):Real; //计算员工的津贴(迟到扣津贴、请假扣津贴)
function calcjiangchengmoney(workno:string):Real;
function dayofmonthy(rq:string):string; //此日属于那个月
function copychar(ch:string;twice:integer):string; //将字串ch复制twice遍
function numstring(s:string):boolean; //判断此字串是否全为数字
procedure getdata(workno:string;rq:string); //获取考勤主档及异动档中的资料并合并
procedure getdata2; //获取考勤异动档中的资料并合并
procedure inscal; //计算保险金
procedure medcal; //汇总就诊金
procedure mealcal(monthy:string); //就餐汇总
function addpassword(p:string):string; //加密密码
function GetOSInfo(Var systemver:string):string; //用来获得系统版本
function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;lParam: LPARAM):LRESULT; //产生键盘Hook
function MouseHookHandler(iCode: Integer;wParam: WPARAM;lParam: LPARAM):LRESULT; //产生鼠标Hook
function EnableHotKeyHook: BOOL; //启动Hook
function DisableHotKeyHook: BOOL; //关闭Hook
procedure HotKeyHookExit; //退出Hook
procedure SetDBGridLength(Formname:String;GridName:TDBGrid;TableName:TCustomADODataSet);
procedure GetDBGridLength(Formname:String;GridName:TDBGrid);
procedure GetRight(Menuname:String;Formname:TForm); //获取当前使用者的权限资料
function IsRight(formname:TForm; dataset:TDataset):boolean; //判断使用者是否具有该权限
procedure getworker(w:string;var c,n,d,p,g,s:string); //当给它一个w-工号，它给出c-卡号，n-姓名,d-部门,p-职务,g-职等职级
procedure writeRecorder(aqy:Tadodataset;bn:boolean); //传回一条记录的内容，写入历史档案中
function isdate(fieldvalue:string):boolean; //判断字段值是否为日期型
function istime(fieldvalue:string):boolean;
function workistrue(workno:string):boolean; //判断工号是否存在
procedure findrecorder(ast:Tadodataset;aname,tname:string); //调用查找的共用窗体
function checkstr(s:string):boolean; //判断输入的字符是否是数字型
procedure getdbgridwidth(var dg:Tdbgrid;formname:string); //取出dbgrid栏位宽度
procedure setdbgridwidth(var dg:Tdbgrid;formname:string); //存入dbgrid栏位宽度
procedure returnzhi(fm:Tform;order:integer); //点击绿色lable，调出基本参数值
function showcombox(n:integer;s:string):string; //下拉combobox中的部门编号时，在另一框中显示部门名称
function TimeDec(Ts,Te:string):string; //时间差，Ts是开始时间，Te是结束时间（格式：hh:mm)
function TimeDec1(Ts,Te:string):string; //时间差，Ts是开始时间，Te是结束时间（格式：hh:mm)
function DecDate(Ds,De:string):integer; //年相减，Ds是开始日期，De是结束日期(格式：yyyy/mm/dd);
function GetGUID(var rg1,rg2,rg3,rg4,rg5:integer):String; //获得一个键值名
function Tax:string;
var
hNextHookProc: HHook;
procSaveExit: Pointer;
hMouseHookProc: HHook;
i,j:boolean;
implementation
uses datamol,main,canfind,jiben;
procedure Tdbgridsort.sort(column:Tcolumn;DtSet:TCustomADODataSet;var f:string);
begin
dtset.Sort :=column.Fieldname+' '+f;
if f='ASC' then
f:='DESC'
ELSE
f:='ASC';
end;
function istime(fieldvalue:string):boolean;
var
s,s1:string;
begin
if (length(fieldvalue)=5) then
begin
s:=copy(fieldvalue,1,2); // s是第一个/或-之后的字符
s1:=copy(fieldvalue,4,2); //求出第二个/或-位置
if (s>='24') or (s1>'59') then
istime:=false //年月日是否符合
else
istime:=true;
end
else
istime:=false;
end;
//---------------------------------------------
// function getdays(month,year:string):integer;
//用来获得某年某月共有多少天，其中区别闫年
//如： getdays('10','2000')
//返回：31
//---------------------------------------------
function getdays(month,year:string):integer;
var
mon:integer;
yea:integer;
begin
Result:=0;
try
mon:=strtoint(month);
yea:=strtoint(year);
case mon of
1,3,5,7,8,10,12:Result:=31;
4,6,9,11:Result:=30;
2: if (yea mod 400 = 0) or ((yea mod 4 = 0) and (yea mod 100 <> 0)) then
Result:=29
else
Result:=28;
end;
except
Application.MessageBox(Pchar(month+' '+year+'不是一个有效的日期类型类型值!'),'日期错误',mb_okcancel+mb_iconerror);
end;
end;
//----------------------------------------------------------------------------------
//procedure GetWhere(query1name:TADOQuery;Var Select,where,OG:String);
//用来获得Query的SQL.Text中的Where,Order by,Group by部分内容
//参数：query1name:Query的名,Select,where,OG:Select部分,Where部分,Order by,Group by部分
//----------------------------------------------------------------------------------
procedure GetWhere(xx_QyAw:TADODataset;var Select,where,OG:string);
var
hanFilter:string;
k,i:integer;
begin
if xx_QyAw.Filtered then
hanFilter:=xx_QyAw.Filter ;
if xx_QyAw is TADODataset then
AnalyseSQLWhereOrderGroup((xx_QyAw as TADODataset).commandtext,Select,Where,OG);
while Pos('(',hanFilter)>0 do
hanFilter[Pos('(',hanFilter)]:=' ';
while Pos(')',hanFilter)>0 do
hanFilter[Pos(')',hanFilter)]:=' ';
while Pos('*',hanFilter)>0 do
begin
k:=Pos('*',hanFilter);
hanFilter[k]:='%';
for i:=k downto 1 do
if hanFilter[i]='=' then break;
if i<2 then break;//退出while
delete(hanFilter,i,1);
insert(' Like ',hanFilter,i);
end;
if (hanFilter<>'') and (Where<>'') then
Where:=' '+Where +' and '+hanFilter
else if hanFilter<>'' then
Where :=' where '+hanFilter;
end;
procedure AnalyseSQLWhereOrderGroup(Old_SQL:String;var Str_Select,Str_Where,Str_OG:String);
var
i,i1,i2:integer;
begin
i:=POS(UpperCase('where'),UpperCase(Old_SQL));
i1:=POS(UpperCase('order by'),UpperCase(Old_SQL));
i2:=POS(UpperCase('group by'),UpperCase(Old_SQL));
if i<>0 then
begin
if i1<>0 then
begin
if i2<>0 then
begin
i2:= Min(i1,i2);
Str_Select := Copy(Old_SQL,1,i-1);//where 前的
Str_Where :=Copy(Old_SQL,i,i2-i);//where part
Str_OG :=Copy(Old_SQL,i2,Length(Old_SQL)-i2);//order or group part
end else
begin
Str_Select := Copy(Old_SQL,1,i-1);
Str_Where :=Copy(Old_SQL,i,i1-i);
Str_OG :=Copy(Old_SQL,i1,Length(Old_SQL)-i1);
end;
end else
if i2<>0 then
begin
Str_Select := Copy(Old_SQL,1,i-1);
Str_Where :=Copy(Old_SQL,i,i2-i);
Str_OG :=Copy(Old_SQL,i2,Length(Old_SQL)-i2);
end else
begin
Str_Select := Copy(Old_SQL,1,i-1);
Str_Where :=Copy(Old_SQL,i,Length(Old_SQL));
end;
end else
if i1<>0 then
begin
if i2<>0 then
begin
i2:= Min(i1,i2);
Str_Select := Copy(Old_SQL,1,i2-1);
Str_OG :=Copy(Old_SQL,i2,Length(Old_SQL)-i2);
end else
begin
Str_Select := Copy(Old_SQL,1,i1-1);
Str_OG :=Copy(Old_SQL,i1,Length(Old_SQL)-i1);
end;
end else
if i2<>0 then
begin
Str_Select := Copy(Old_SQL,1,i2-1);
Str_OG :=Copy(Old_SQL,i2,Length(Old_SQL)-i2);
end else
Str_Select:=Old_SQL;
end;
function hans1Dechans2Hour(hanss1,hanss2:string;sj:integer):Real;
var
hanInt:Real;
hanReal:Real;
hans1,hans2:TDatetime;
begin
Result:=0;
try
hans1:=strtodatetime(copy(hanss1,1,4)+dateseparator+copy(hanss1,5,2)+dateseparator+copy(hanss1,7,2)+' '+copy(hanss1,9,2)+timeseparator+copy(hanss1,11,2));
hans2:=strtodatetime(copy(hanss2,1,4)+dateseparator+copy(hanss2,5,2)+dateseparator+copy(hanss2,7,2)+' '+copy(hanss2,9,2)+timeseparator+copy(hanss2,11,2));
except
Application.Messagebox('你输入的日期格式有误,请重新输入.','日期错误',mb_okcancel+mb_iconerror);
exit;
end;
hanInt:=(hans2-hans1)*24*60+0.00005;
if hanInt>1440 then
hanInt:=hanInt-1440;
hanInt:=hanInt-sj;
hanReal:=hanInt/60;
hanInt:=Trunc(hanReal*2);
Result:=hanInt/2;
end;
function date1decdate2day(date1,date2:string):real; //计算两个日期之间的天数
var Qry1:TADOQuery;
begin
with datamod do
begin
Qry1:=TADOQuery.Create(application);
Qry1.connection:=Query1.connection;
Qry1.sql.text:='Select datediff(dd,'''+date1+''','''+date2+''') as day ';
Qry1.open;
Result:=Qry1.fieldbyname('day').asfloat;
Qry1.free;
end;
end;
function DayofMonthy(rq:string):string; //计算此日属于那月
var
month:string;
Qry1:TADOQuery;
begin
{ with datamod do
begin
Qry1:=TADOQuery.create(application);
Qry1.connection:=Query1.connection;
Qry1.sql.text:='Select * from sal02010';
Qry1.open;
if (qry1.fieldbyname('calcmoneysrq').value<qry1.fieldbyname('calcmoneyerq').value) then //若月结是在本月
month:=copy(rq,1,7) //26~25 28日
else
begin
if (qry1.fieldbyname('calcmoneymon').value='0') then //计前月
begin
if ((copy(rq,9,2)>=qry1.fieldbyname('calcmoneysrq').value) and (copy(rq,9,2)>qry1.fieldbyname('calcmoneyerq').value)) then //跨月结且算成前月的
month:=copy(rq,1,7)
else if ((copy(rq,9,2)<=qry1.fieldbyname('calcmoneyerq').value) and (copy(rq,9,2)<qry1.fieldbyname('calcmoneysrq').value)) then
month:=monthdec(rq,-1);
end
else if (adosalsetcalcmoneymon.value='2')then //计后月
begin
if ((copy(rq,9,2)>=qry1.fieldbyname('calcmoneysrq').value) and (copy(rq,9,2)>qry1.fieldbyname('calcmoneyerq').value)) then //跨月结且算成前月的
month:=monthdec(rq,1)
else if ((copy(rq,9,2)<=qry1.fieldbyname('calcmoneyerq').value) and (copy(rq,9,2)<qry1.fieldbyname('calcmoneysrq').value)) then
month:=copy(rq,1,7);
end;
end;
result:=month;
Qry1.free;
end; //with }
end; //计算此日属于那月
//在dbgrid中实现回车键
procedure dbgrid_keypress(sender:TObject;var key:char);
begin
if key=#13 then
begin
key:=#0;
with sender as twincontrol do
postmessage(handle,wm_keydown,VK_Tab,0);
end;
end;
function copychar(ch:string;twice:integer):string; //将字串ch复制twice遍
var
s:string;
i:integer;
begin
result:='';
s:='';
for i:=1 to twice do
s:=s+ch;
result:=s;
end;
//********************************************************//
//当给它一个工号时，它给出这个员工的信息c--卡号，n--姓名，//
//d--部门，p--职称，g--职等职级。 //
//********************************************************//
procedure getworker(w:string;var c,n,d,p,g,s:string);
begin
with datamod.adoquery1 do
begin
close;
sql.clear;
sql.add('select cardno,name,sexname,deptno,prof,gradename from per24010 where workno='''+w+''' and leave<>1 and stoppay<>1 ');
open;
if not eof then
begin
c:=fieldbyname('cardno').asstring;
n:=fieldbyname('name').asstring;
d:=fieldbyname('deptno').asstring;
p:=fieldbyname('prof').asstring;
g:=fieldbyname('gradename').asstring;
s:=fieldbyname('sexname').asstring;
end;
close;
end;
end;
//*****************************************************//
//判断字段值是否是日期型数据,fieldvalue如1999/10/21 //
function isdate(fieldvalue:string):boolean;
var i,j:integer;
s:string;
begin
if (length(fieldvalue)>=8) and (length(fieldvalue)<=10) then
begin
i:=pos(copy(fieldvalue,5,1),fieldvalue); //求出第一个/或-位置
s:=copy(fieldvalue,i+1,length(fieldvalue)-i); // s是第一个/或-之后的字符
j:=i+pos(copy(fieldvalue,5,1),s); //求出第二个/或-位置
if (copy(fieldvalue,1,4)<'1900') or (copy(fieldvalue,1,4)>'2099') or (copy(fieldvalue,i+1,j-i-1)<'01') or (copy(fieldvalue,i+1,j-i-1)>'12') or (copy(fieldvalue,j+1,length(fieldvalue)-j)<'01') or (copy(fieldvalue,j+1,length(fieldvalue)-j)>'31') then
isdate:=false //年月日是否符合
else
isdate:=true;
end
else
isdate:=false;
end;
//*************************************************************************************
//在存档时，判断工号存不存在
//*************************************************************************************
function workistrue(workno:string):boolean;
begin
with datamod.adoQuery1 do
begin
sql.Clear;
sql.Add ('select * from per24010 where workno='''+workno+''' and leave<>1 ');
open;
workistrue:=eof;
close;
end;
end;
//找出一个字段
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?