⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 user_func.pas

📁 小银行系统
💻 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 + -