📄 user_func.pas
字号:
unit user_func;
interface
uses windows,messages,sysutils,classes,graphics,controls,forms,Dialogs,
stdctrls,buttons,Grids, DBGrids,dbtables,db,mask,dbctrls,Qrctrls,
ADODB,DBClient,MConnect,SConnect,IdGlobal,DBGridEh, DBGridEhImpExp,DBSumLst;
function right(procstr:string;icount:integer):string;
function leftstr(procstr:string;byseekstr:string;seekno:integer):string;
Function SfzToXb(id_no:String):String ; //从身份证中读取性别
Function SfzToRq(id_no:String) :string; //从身份证中读取生日
function showans(msgstr:string):boolean;
procedure showmsg(msgstr:string);
procedure keyshort(var Key: Word; Shift: TShiftState);
procedure find(grdlst:TcustomGrid);
procedure seek(grdlst:TDBGrid);
function DayofMonth(year,month:integer):integer; //取某月的最大天数
function monthfirstday(curdate:Tdatetime):string; //月第1天
function monthendday(curdate:Tdatetime):string; //月最后1天
function BOFM(date1:TDateTime):TDateTime; //月初
function EOFM(date1:TDateTime):TDateTime; //月末
function isdate(datestr:string):boolean;
function isnumeric(numstr:string):boolean;
function rounda(ireal:real;decs:integer):real;//四舍五入:1,待处理实数;2,保留小数位数;by bill liang
function TimeOfMonth(yyyymm:string):integer; //取某月的标准正班工时
function CheckfacUser(sys_id,user_no,fac_no: string):Boolean; //检查用户是否有某厂别使用权
function GetPYIndexChar( hzchar:string):char;
function SearchByPYIndexStr( SourceStrs:TStrings; PYIndexStr:string):string;
var pubcaption:string;
implementation
uses U_main,UDM;
function right(procstr:string;icount:integer):string;
var istrlen,istart:integer;
begin
istrlen := length(procstr) ;
istart := istrlen - icount+1 ;
result := copy(procstr,istart,icount) ;
end;
function leftstr(procstr:string;byseekstr:string;seekno:integer):string;
var i,icount,strlen,j,oldi:integer;
begin
j:= 0 ;
oldi := 0 ;
icount := length(procstr) ;
strlen := length(byseekstr) ;
for i:=1 to icount do begin
if copy(procstr,i,strlen) = byseekstr then begin
j := j +1 ;
if j = seekno then begin
result := copy(procstr,oldi+1,i-oldi-1) ;
exit;
end;
oldi := i ;
end
end;
result := '' ;
end ;
Function SfzToXb(id_no:String):String ;
var i:Integer;
begin
If Length(id_no) = 15 Then
begin
i := StrToInt(Right(id_no,1));
If i Mod 2 = 0 Then
SfzToXb := '女'
Else SfzToXb := '男' ;
end;
If Length(id_no) = 18 Then
begin
i := StrToInt(copy(id_no, 17, 1));
If i Mod 2 = 0 Then
SfzToXb := '女'
Else SfzToXb := '男';
end ;
end ;
Function SfzToRq(id_no:String) :string;
var strRq :String ;
begin
If Length(id_no) = 15 Then
SfzToRq := '19' + copy(id_no, 7, 2) + '-' + copy(id_no, 9, 2) + '-' + copy(id_no, 11, 2) ;
If Length(id_no) = 18 Then
SfzToRq := copy(id_no, 7, 4)+ '-' +copy(id_no, 11, 2) + '-' + copy(id_no, 13, 2) ;
end ;
function showans(msgstr:string):boolean;
var curform:tform;
begin
curform:= screen.ActiveForm ;
if messagebox(curform.handle,pchar(msgstr),'询问窗',MB_OKCANCEL+
MB_ICONQUESTION+MB_DEFBUTTON2)=IDOK
then result:= true else result := false ;
end;
procedure showmsg(msgstr:string);
var curform:Tform;
begin
curform:= screen.ActiveForm ;
messagebox(curform.handle,pchar(msgstr),'信息窗',MB_ICONINFORMATION);
end;
procedure keyshort( var Key: Word; Shift: TShiftState);
var curform:tform;
comname:string;
activecom:tbitbtn;
curcontrol:Twincontrol;
// activecom:tbitbtn;
begin
curform :=screen.ActiveForm ;
curcontrol := screen.ActiveControl ;
if (ssAlt in shift) and (key = vk_F7) then begin
if curcontrol is TDBGRID then
TDBGRID(curcontrol).readonly := false ;
exit;
end ;
case key of
vk_f3: comname :='bbnfind' ;
vk_f4: comname :='bbnfind' ;
vk_f9: comname :='bbnprt' ;
vk_f8: comname :='bbncpy' ;
vk_insert: comname :='bbnnew' ;
vk_delete: comname:='bbndel';
VK_BACK: comname:='bbnedt' ;
else
exit ;
end;
activecom:= tbitbtn(curform.FindComponent(comname));
if activecom = nil then exit;
if key = vk_f4 then activecom.tag := 1 ;
activecom.SetFocus();
PostMessage(activecom.Handle, WM_KEYDOWN, 13, 0);
end;
procedure find(grdlst:TcustomGrid);
var
ititle:string ;
curval:string;
curfld:string;
InputString: string;
isfound: Boolean;
idbdata: Tdbdataset ;
selfld:Tfield ;
begin
if grdlst is Tdbgrid then selfld := Tdbgrid(grdlst).SelectedField
else if grdlst is Tdbgrideh then
selfld := Tdbgrideh(grdlst).SelectedField
else exit ;
if selfld = nil then begin
showmsg('没有选择待搜寻的字段.');
exit ;
end;
ititle := selfld.DisplayLabel ;
curval := selfld.Text ;
curfld := selfld.FieldName ;
inputstring:=inputbox('搜寻'+ititle , ititle+'等於:',curval);
if grdlst is Tdbgrid then
idbdata := Tdbdataset(Tdbgrid(grdlst).DataSource.DataSet)
else
idbdata := Tdbdataset(Tdbgrideh(grdlst).datasource.dataset) ;
if idbdata.Eof and idbdata.Bof then exit ;
isfound := idbdata.Locate(curfld,inputstring,[loPartialKey]);
if isfound = true then begin
grdlst.SetFocus;
end
else grdlst.SetFocus;
end;
procedure seek(grdlst:TDBGrid);
var
ititle:string ;
curval:string;
curfld:string;
InputString: string;
idbdata: Tclientdataset ;
CurRec : TBookmark;
i,icount:integer;
filterstr,oldfilter:string;
oldfiltered :boolean ;
begin
if grdlst.SelectedField = nil then begin
showmsg('没有选择待搜寻的字段.');
exit ;
end;
ititle := grdlst.Columns.Items[grdlst.selectedindex].Title.Caption;
curval := grdlst.SelectedField.Text ;
curfld := grdlst.SelectedField.FieldName ;
inputstring:=inputbox('搜寻'+ititle , ititle+'等於:',curval);
if inputstring = curval then begin
grdlst.SetFocus ;
exit ;
end ;
idbdata := Tclientdataset(grdlst.DataSource.DataSet) ;
if idbdata.Eof and idbdata.Bof then exit ;
idbdata.Next ;
oldfilter := idbdata.filter ;
oldfiltered := idbdata.filtered ;
icount := idbdata.IndexFieldCount ;
for i:=1 to icount do begin
filterstr:= filterstr + 'and ( ' + idbdata.IndexFields[i-1].FieldName + ' >= ''' +
idbdata.fieldbyname(idbdata.IndexFields[i-1].FieldName).asstring + ''')'
end ;
if idbdata.FieldByName(curfld) is Tstringfield then
filterstr := filterstr + ' and (' + curfld + ' like ''' + inputstring + '%'') '
else
filterstr := filterstr + ' and (' + curfld + ' = ''' + inputstring + ''') ' ;
filterstr := trim(filterstr) ;
filterstr := copy(filterstr,4,length(filterstr)-3) ;
idbdata.Filter := filterstr ;
idbdata.Filtered := true ;
currec := idbdata.GetBookmark ;
grdlst.SetFocus;
idbdata.Filtered := oldfiltered ;
idbdata.Filter := oldfilter ;
idbdata.GotoBookmark(currec) ;
end;
function monthfirstday(curdate:Tdatetime):string;
begin
result:=FormatDatetime('yyyy-mm-dd',BOFM(curdate));
end;
function monthendday(curdate:Tdatetime):string;
begin
result:=FormatDatetime('yyyy-mm-dd',EOFM(curdate));
end;
function BOFM(Date1:TDateTime):TDateTime;
var Year1,Month1,Day1:word;
begin
DecodeDate(Date1, Year1, Month1, Day1);
Result := EncodeDate(Year1, Month1, 1);
end;
function EOFM(Date1:TDateTime):TDateTime;
var Year1,Month1,Day1:word;
begin
decodeDate(Date1, Year1, Month1, Day1);
Result := EncodeDate(Year1, Month1, DayOfMonth(Year1,Month1) );
end;
//月天数
function DayofMonth(year,month:integer):integer;
const
DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
Result := DaysInMonth[Month];
if (Month = 2) and IsLeapYear(Year) then Inc(Result);
end;
function TimeOfMonth(yyyymm:string):integer; //取某月的标准正班工时
var days:integer;
TodayDateTime:TDatetime;
begin
days :=0;
TodayDateTime := StrToDate(yyyymm+'-01');
while FormatDatetime('YYYY-MM',TodayDateTime)=yyyymm do
begin
if (DayOfWeek(TodayDateTime)<>1) and (DayOfWeek(TodayDateTime)<>7) then
Inc(days);
TodayDateTime :=TodayDateTime +1 ;
end ;
Result :=days * 8 ;
end;
function isdate(datestr:string):boolean;
var chgdate:Tdatetime;
begin
if trim(datestr) = '' then begin
result := true ;
exit ;
end ;
try
chgdate := strtodate(datestr) ;
result := true ;
except
result := false ;
end;
end;
Function isnumeric(numstr:string):boolean;
var iresult:integer ;
begin
if trim(numstr) = '' then begin
result := true ;
exit ;
end ;
try
iresult := strtoint(numstr) ;
result := true ;
except
result := false ;
end;
end ;
function CheckfacUser(sys_id,user_no,fac_no: string):Boolean; //检查用户是否有某厂别使用权
var sqlstr:string;
TempAdo : TAdoDataSet;
begin
Result:=False;
if f_Main.vadministrator='Y' then begin Result:=True; exit ; end ;
sqlstr :='select count(*) from user_fac where sys_id=''4'' and user_no='''+
f_Main.vuser_no+''' and fac_no='''+fac_no+'''';
TempAdo := TAdoDataSet.Create(nil);
try
TempAdo.Connection := DM.ADOConnection1 ;
TempAdo.CommandText := sqlstr;
TempAdo.prepared := True;
TempAdo.open;
TempAdo.First;
if TempAdo.fields[0].AsInteger <>0 then
Result :=true
else begin
Result :=false ;
Showmessage('对不起! 你未授权操作本厂别人事资料!');
end ;
TempAdo.close ;
finally
TempAdo.Free;
end;
end;
function rounda(ireal:real;decs:integer):real;
var formatstr:string;
i:integer;
begin
formatstr:='';
for i:=1 to decs do
formatstr:=formatstr+'0';
Result:=StrToFloat(FormatFloat('0.'+formatstr,ireal));
end;
// 获取指定汉字的拼音索引字母,如:“汉”的索引字母是“H”
function GetPYIndexChar( hzchar:string):char;
begin
case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
$B0A1..$B0C4 : result := 'A';
$B0C5..$B2C0 : result := 'B';
$B2C1..$B4ED : result := 'C';
$B4EE..$B6E9 : result := 'D';
$B6EA..$B7A1 : result := 'E';
$B7A2..$B8C0 : result := 'F';
$B8C1..$B9FD : result := 'G';
$B9FE..$BBF6 : result := 'H';
$BBF7..$BFA5 : result := 'J';
$BFA6..$C0AB : result := 'K';
$C0AC..$C2E7 : result := 'L';
$C2E8..$C4C2 : result := 'M';
$C4C3..$C5B5 : result := 'N';
$C5B6..$C5BD : result := 'O';
$C5BE..$C6D9 : result := 'P';
$C6DA..$C8BA : result := 'Q';
$C8BB..$C8F5 : result := 'R';
$C8F6..$CBF9 : result := 'S';
$CBFA..$CDD9 : result := 'T';
$CDDA..$CEF3 : result := 'W';
$CEF4..$D188 : result := 'X';
$D1B9..$D4D0 : result := 'Y';
$D4D1..$D7F9 : result := 'Z';
else
result := char(0);
end;
end;
// 在指定的字符串列表SourceStrs中检索符合拼音索引字符串
//PYIndexStr的所有字符串,并返回。
function SearchByPYIndexStr
( SourceStrs:TStrings;
PYIndexStr:string):string;
label NotFound;
var
i, j :integer;
hzchar :string;
begin
for i:=0 to SourceStrs.Count-1 do
begin
for j:=1 to Length(PYIndexStr) do
begin
hzchar:=SourceStrs[i][2*j-1]
+ SourceStrs[i][2*j];
if (PYIndexStr[j]<>'?') and
(UpperCase(PYIndexStr[j]) <>
GetPYIndexChar(hzchar)) then goto NotFound;
end;
if result='' then result := SourceStrs[i]
else result := result + Char
(13) + SourceStrs[i];
NotFound:
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -