glovproc.pas

自创的彼此交流账目软件

unit Glovproc;

interface

uses
  Windows, Grids, Messages, SysUtils, Dialogs,forms,Controls,dbtables,classes,
  Db,ComCtrls,ToolWin,ADOdb,IniFiles,StdCtrls,Menus;

var
  GSS_USR : String;    //操作员代码
  GSS_UNM : String;    //操作员名称
  GSS_HNO : String;    //员工代码
  GSS_DPTID : String;  //科室代码(药房,药库内部用)
  GSS_DPT : String;    //科室代码(科室信息里的)
  GSS_DPTNM : String;  //科室名称

  //求SerVer日期
  Function FRL_ServerTime(LX:Integer;ADOSvr:TADOConnection): String;

  //日期有效期判断
  Procedure GRL_ChkDate(Date : String);
  //字符串转换日期型
  Function FRL_StrToDate(Date : String):TDate;
   //日期型转换 字符串
  Function FRL_DateToStr(lx : integer; Dt : TDate):String;
  ////把YYYYMMDD型改成所需的字符串日期
  Function FRL_StrToStrA(lx : integer; Dt : String):String;
  //把字符串日期改成 YYYYMMDD型
  Function FRL_StrToStrB(Dt : String):String;
  //流水号补零
  Function FRL_LiuShui(LiuShui : integer; len : Integer):String;
  //把小写金额转换为大写金额。
  function FRL_ConvToBig(arg: Double): String;
  //删除一行
  procedure GRL_DeleteOneRow(SG: TStringGrid; ARow,EndCol: Integer);
  //增加一行
  procedure GRL_InSertOneRow(SG: TStringGrid; ARow: Integer);
  //删除不加隐含列的数据  StingGrid
  procedure GRL_SGClear(SG: TStringGrid;StartCol,EndCol,StartRow,EndRow:Integer);
  //删除加隐含列的数据    StingGrid
  procedure GRL_ClearStrGrid(SG: TStringGrid; StartCol: Integer=0;StartRow: Integer=0);
  //标题对齐
  procedure GRL_SGAlign(SG:TStringGrid;S_Rect: TRect;s_Align,S_text:String);
  //计算天数
  function FRL_BtweenDate(Dt1,Dt2 : TDate):Integer;
  //判断是否月底
  function FRL_EndMonth(var month: TDate): Boolean;
  //判断浮点数
  procedure GRL_SetFloat(var Key:Char;Str:String);
  //判断整数
  procedure GRL_SetInt(var Key:Char;Str:String);
  //判断电话号码
  procedure GRL_SetPhone(var Key:Char;Str:String);
  //控制ComboBox的Backspace键
  Procedure GRL_ControlCombo(Combo:TObject;var Key:Char);
  // 判断子工具栏状态
  Procedure GRL_SubMenuState(ADOSvr:TADOConnection;var MainMenu1: TMainMenu );


implementation
//求SerVer日期
Function FRL_ServerTime(LX : Integer; ADOSvr:TADOConnection): String;
var
  TMD_ServerTime : Tdatetime;
  AqrySvr:TADOQuery;
    
  //SystmeTime : TSystmeTime;
begin
 AqrySvr := TADOQuery.Create(nil);
 AqrySvr.Connection := ADOSvr;
 try

    with AqrySvr do
    begin
      Close;
      SQL.Clear;
      SQL.Add(' SELECT GETDATE() DATETIME ');
      Open;
      TMD_ServerTime:=FieldByName('DATETIME').AsDateTime;

      Case lx of
        1: Result:=FormatDateTime('yyyymmdd',TMD_ServerTime);
        2: Result:=FormatDateTime('hhnnss',TMD_ServerTime);
        3: Result:=FormatDateTime('yyyy-mm-dd',TMD_ServerTime);
        4: Result:=FormatDateTime('hh:nn:ss',TMD_ServerTime);
        5: Result:=FormatDateTime('yyyy-mm-dd hh:nn:ss',TMD_ServerTime);
        6: Result:=FormatDateTime('yyyymmddhhnnss',TMD_ServerTime);
        7: Result := Copy(FormatDateTime('yyyymmdd',TMD_ServerTime),1,4)+'年'+Copy(FormatDateTime('yyyymmdd',TMD_ServerTime),5,2)+'月'+Copy(FormatDateTime('yyyymmdd',TMD_ServerTime),7,2)+'日';
      end;
      Free;
    end;
  except
    Application.MessageBox('系统出错！','提示',Mb_OK+MB_IconInformation);
    Result := '';
    AqrySvr.Free;
  end;
end;
//日期有效判断
Procedure GRL_ChkDate(Date : String);
begin
  try
    StrToDate(Copy(Date,1,4)+'-'+Copy(Date,5,2)+'-'+Copy(Date,7,2));
  except
    Application.MessageBox('不是有效日期！','提示',MB_OK+MB_IconInformation);
    Exit
  end;
end;
//字符串转换日期型
Function FRL_StrToDate(Date : String):TDate;
var
  TMD_Dt : TDate;
begin
  try
    TMD_Dt := StrToDate(Copy(Date,1,4)+'-'+Copy(Date,5,2)+'-'+Copy(Date,7,2));
    Result := TMD_Dt;
  except
    Application.MessageBox('不是有效日期！','提示',MB_OK+MB_IconInformation);
    Result := StrToDate('1000-01-01') ;
  end;
end;
//日期型转换 字符串
Function FRL_DateToStr(lx : integer; Dt : TDate):String;
begin
  Case lx of
    1 : Result := FormatDateTime('yyyymmdd',Dt);
    2 : Result := FormatDateTime('yyyy-mm-dd',Dt);
    3 : Result := Copy(FormatDateTime('yyyymmdd',Dt),1,4)+'/'+Copy(FormatDateTime('yyyymmdd',Dt),5,2)+'/'+Copy(FormatDateTime('yyyymmdd',Dt),7,2);
    4 : Result := Copy(FormatDateTime('yyyymmdd',Dt),1,4)+'年'+Copy(FormatDateTime('yyyymmdd',Dt),5,2)+'月'+Copy(FormatDateTime('yyyymmdd',Dt),7,2)+'日';
  end;
end;

//把YYYYMMDD型改成所需的字符串日期
Function FRL_StrToStrA(lx : integer; Dt : String):String;
var
  TMD_DT : TDate;
begin
  try
    TMD_DT := FRL_StrToDate(Dt) ;
    if TMD_DT <> StrToDate('1000-01-01') THEN
      Case lx of
        1 : Result := FormatDateTime('yyyy-mm-dd',TMD_DT);
        2 : Result := Copy(FormatDateTime('yyyymmdd',TMD_DT),1,4)+'/'+Copy(FormatDateTime('yyyymmdd',TMD_DT),5,2)+'/'+Copy(FormatDateTime('yyyymmdd',TMD_DT),7,2);
        3 : Result := Copy(FormatDateTime('yyyymmdd',TMD_DT),1,4)+'年'+Copy(FormatDateTime('yyyymmdd',TMD_DT),5,2)+'月'+Copy(FormatDateTime('yyyymmdd',TMD_DT),7,2)+'日';
      end;
  except
    Result := '';
  end;
end;

//把字符串日期改成 YYYYMMDD型
Function FRL_StrToStrB(Dt : String):String;
begin
  //showmessage(inttostr(length(dt)));
  if (length(Dt)=10)and((Copy(Dt,5,1)='-')or(Copy(Dt,5,1)='/')or(Copy(Dt,5,1)='年')) then
    Result := Copy(Dt,1,4)+Copy(Dt,6,2)+Copy(Dt,9,2)
  else if (length(Dt)=14) and (Copy(Dt,5,2)='年') then
    Result := Copy(Dt,1,4)+Copy(Dt,7,2)+Copy(Dt,11,2)
  else
  Result := '';
end;

//流水号补零
Function FRL_LiuShui(LiuShui : integer; len : Integer):String;
var
  I : Integer;
  TMS_Ls : String;
begin
  TMS_Ls := IntToStr(LiuShui);
  if length(TMS_Ls) < len then
  begin
    for I := length(IntToStr(LiuShui))+1 to len do
    begin
      TMS_Ls := '0' + TMS_Ls;
    end ;
  end
  else if Length(TMS_Ls) > len then
    TMS_Ls := '';
  Result := TMS_Ls;
end;

function FRL_ConvToBig(arg: Double): String;
var   //把小写合计转换为大写合计。
  D,U,sWitch,strD,strU: String; //大写数字，钱的单位，
  small,big,I1,F1: String;   //   整数，小数
  Len,i,iWitch,decPos: Integer;
  IsZero,IsMinus: Boolean;
  ary: array[1..10] of String;
begin
  IsMinus := False;
  if arg < 0 then
  begin
    IsMinus := True;
    arg := (-1) * arg;
  end;
  small := FloatToStrF(arg,ffFixed, 10,2);

  D := '零壹贰叁肆伍陆柒捌玖';
  U := '分角元拾佰仟万拾佰仟';

  decPos := Pos('.',small);
  I1 := copy(small,1,decPos-1);
  F1 := copy(small,decPos+1,2);
  small := concat(i1,F1) ;

  Len := Length(small);

  IsZero := False;
  For i := len downTo 1 do
  Begin
    sWitch := copy(small,i,1);    //该位数的数据值
    If ((i = len) or (i = len- 2) or (i = len- 6)) And (sWitch = '0') Then Iszero := True;
    If sWitch <> '0' Then IsZero := False;

    If IsZero Then ary[i] := 'Z'//当该位数零时返回Z
    Else ary[i] := sWitch;
  End;

  For i := 1 To Len Do
  Begin
    sWitch := ary[i];

    strU := copy(U,(len - i)*2+1,2);
    If (sWitch = 'Z') And ((i = decPos-5) or (i=decPos-1) or (i=decPos+2)) Then
    Begin   //Add Unit
      big := big + strU;
      Continue;
    End
    Else If sWitch = 'Z' Then  //Not Add Digit And Unit
      Continue;

    iWitch := StrToInt(sWitch);

    strD := copy(D,2*iWitch+1,2);

    If IsZero And (sWitch ='0') Then Continue;
    If sWitch = '0' Then
    Begin
      IsZero := True;
      big := big + strD ;
      Continue;
    End
    Else
      IsZero := False;

    big := big + strD + strU;
  End;

  If ary[len] = 'Z' Then big := big + '整';

  if arg = 0 then   //判断钱的数字是0时返回空值
    big := '';
      
  if Not IsMinus then
    Result := big
  else
    Result := '负' + big;

end;
//删除一行
//                       StringGrid         要删除的Row
procedure GRL_DeleteOneRow(SG: TStringGrid; ARow,EndCol: Integer);
var
  j :Integer;
begin
  ARow := SG.Row ;
  with SG do
  begin
    While ARow <= RowCount - 1 do
    begin
      if RowCount = 2 then
      begin
        for j := 0 to EndCol do
          Cells[j,1] := '';
        Exit;
      end
      else
        for j := 0 to EndCol do      // ColCount - 1
          Cells[j,ARow] := Cells[j,ARow+1];
        inc(ARow);
    end;
    if RowCount > 2 then
    RowCount := RowCount - 1;
  end;
end;

//增加一行
procedure GRL_InSertOneRow(SG: TStringGrid; ARow: Integer);
var
  I,j :Integer;
begin
  ARow := SG.Row ;
  SG.RowCount := SG.RowCount + 1;
  with SG do
  begin
    for i := RowCount downto Row do
      for j := 0 to ColCount - 1 do
        Cells [J,I+2] := Cells [J,I+1];
    for j := 0 to ColCount - 1 do
        Cells[j,ARow+1] := '';
    Row := ARow + 1;
    setfocus;
  end;
end;
//删除不加隐含列的数据
procedure GRL_SGClear(SG: TStringGrid;StartCol,EndCol,StartRow,EndRow:Integer);
var
  i,j: Integer;
begin
  with SG do
  begin
    for i := StartCol to EndCol do
      for j := StartRow to EndRow do
        Cells[i,j] := '';
    RowCount := 2;
  end;
end;
//删除加隐含列的数据
procedure GRL_ClearStrGrid(SG: TStringGrid; StartCol: Integer=0;StartRow: Integer=0);
var
  TMI_col,TMI_row : Integer;
begin
  with SG do
  begin
    for TMI_row := StartRow to RowCount-1 do
      for TMI_col := StartCol to ColCount-1 do
        Cells[TMI_col,TMI_row] := '';
    RowCount := 2;
  end;
end;
//标题对齐                StringGrid                   排列方式
procedure GRL_SGAlign(SG:TStringGrid;S_Rect: TRect;s_Align,S_text:String);
begin
  with SG.Canvas do
  begin
    //center
    if S_Align = 'c' then
      TextRect(S_Rect, (S_Rect.Left + (S_Rect.Right - S_Rect.Left- textwidth(S_text)) div 2),
                      (S_Rect.Top + (S_Rect.Bottom - S_Rect.Top- textheight(S_text)) div 2), S_text);
    //Left
    if S_Align = 'l' then
      TextRect(S_Rect, (S_Rect.Left + 1),(S_Rect.Top +
                      (S_Rect.Bottom - S_Rect.Top- textheight(S_text)) div 2), S_text);
    //Right
    if S_Align = 'r' then
      TextRect(S_Rect, (S_Rect.Left + S_Rect.Right - S_Rect.Left- textwidth(S_text)),
                      (S_Rect.Top + (S_Rect.Bottom - S_Rect.Top- textheight(S_text)) div 2), S_text);
  end;
end;

//计算天数
function FRL_BtweenDate(Dt1,Dt2 : TDate):Integer;
begin
  if (FRL_DateToStr(1, Dt1)='10000101')or (FRL_DateToStr(1, Dt2)='10000101') then
    Result := 0
  else
    Result := Trunc((Dt2-Dt1));
end;

//判断是否月底
function FRL_EndMonth(var month: TDate): Boolean;
var
  TMD_Month: TDate;
begin
   // 如果(当前日期+1)的年  跟 当前日期的年不同，肯定月底（其实年底，12月的底）
   //   如果（当前日期+1）的年根当前日期的年相同，但是月不同，则月底。
   // 复杂一点要判断闰年闰月等，比较麻烦。
   //简单一点就是：比如日期Date，将Date+1，再检测其月份是否有变化，

    result := false;
    TMD_Month := month + 1;
    if FormatDateTime('mm',TMD_Month) <> FormatDateTime('mm',month) then
        result := true;
end;

//判断浮点数
procedure GRL_SetFloat(var Key:Char;Str:String);
  //Member Function
  function LFRL_IsNumVal(StrVal: String): boolean;
  var
    I, TMI_DecimalCount: Integer;
    TMB_InvalChar: Boolean;
  begin
    TMB_InvalChar := False;
    TMI_DecimalCount := 0;
    for I := 1 to Length (StrVal) do
    begin
      if (StrVal [I] < '0') or (StrVal [I] > '9') then
      begin
        if StrVal [I] = '.' then
          TMI_DecimalCount := TMI_DecimalCount + 1
        else if  Not (( I = 1 ) and  ( StrVal[I]= '-' )) then
          TMB_InvalChar := True;

      end;
    end;
    if (TMB_InvalChar) or (TMI_DecimalCount > 1) then
      Result := False
    else
      Result := True;
  end;
begin
  if (Key=Chr(VK_Return))or(Key=Chr(Vk_Back))then Exit;
  Str := Str + String(Key);
  if not LFRL_IsNumVal(Str) then
  begin
    Key := #0;
    MessageBeep(0);
  end;
end;

//判断整数
procedure GRL_SetInt(var Key:Char;Str:String);
VAr
  I : Integer;
begin
  if (Key=Chr(VK_Return))or(Key=Chr(Vk_Back))then Exit;
  Str := Str + String(Key);
  for I := 1 to Length (Str) do
  if (Str[I] < '0') or (Str[I] > '9') then
  begin
    Key := #0;
    MessageBeep(0);
  end;

end;

//判断电话号码
procedure GRL_SetPhone(var Key:Char;Str:String);
VAr
  I : Integer;
begin
  if (Key=Chr(VK_Return))or(Key=Chr(Vk_Back))then Exit;
  Str := Str + String(Key);
  for I := 1 to Length (Str) do
  if not((Str[I] >= '0') and (Str[I] <= '9')or (Str[i]='-')) then
  begin
    Key := #0;
    MessageBeep(0);
  end;
end;

//控制ComboBox的Backspace键
Procedure GRL_ControlCombo(Combo : TObject;var Key:Char);
begin
  if Combo is TComboBox then
    if Key = #8 then
      Key := #0;
end;

// 判断子工具栏状态
Procedure GRL_SubMenuState( ADOSvr:TADOConnection;var MainMenu1: TMainMenu);
var
  i,j: integer;
  AQryGrp: TADOQuery;
begin
  AQryGrp := TADOQuery.Create(Application);
  try  // finnally
    AQryGrp.Connection := AdoSvr;
    try // except
      for i := 1 to Mainmenu1.Items.Count - 2 do
        for j := 0 to MainMenu1.Items[i].Count - 1 do
          Mainmenu1.Items[i].Items[j].Enabled := False;

      with AQryGrp do
      begin
        // Setting menu bar state
        Close;
        SQL.Clear ;
        SQL.Add('SELECT A.FHQXWNO');                     //窗口代码
        SQL.Add('  FROM TSYSPHQX A');                    //权限管理
        SQL.Add(' WHERE (A.FHQXHNO = '''+GSS_HNO+''')'); //员工编号
        SQL.Add('   AND (A.FHQXMNM = ''基础设置'')');//模块名称
        SQL.Add('   AND (A.FHQXWNO > ''HIS51000'')');
        SQL.Add('   AND (A.FHQXWNO < ''HIS52000'')');
        SQL.Add(' ORDER BY A.FHQXWNO');
        Open;

        while not Eof do
        begin
          for i := 0 to MainMenu1.Items.Count - 1 do
            for j := 0 to MainMenu1.Items[i].Count - 1 do
            begin
              if StrToInt(Copy(FieldByName('FHQXWNO').AsString,4,5)) = MainMenu1.Items[i].Items[j].Tag then
                MainMenu1.Items[i].Items[j].Enabled := True;
            end;
          Next;
        end;
      end ;
    except
      Application.MessageBox('查询出错!','信息',mb_OK+mb_IconInformation);
    end;
   // free query object
  finally
    AQryGrp.Close;
    AQryGrp.Free;
  end;
end;

end.