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;   //科室名称
  GSS_cS  : String;     //采购单参数
  GSS_CGF : String;     //采购复核与否
  GSS_CCK : String;     //成药出库方向
  GSS_KCT : String;     //库存调整
  GSS_RKF : String;     //入库复核与否
  GSS_RKZ : String;     //入库单张比数
  GSS_YTJ : String;     //药品调价
  GSS_CKF : String;     //出库复核与否
  GSS_YTF : String;     //药房，药库退药复核与否
  GSS_GYT : String;     //供应商退药复核与否
  GSS_CKZ : String;     //出库单张比数
  GSS_CKFF : 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;S_TYPE:String='S');
  //计算天数
  function FRL_BtweenDate(Dt1,Dt2 : TDate):Integer;
  //判断是否月底
  function FRL_EndMonth(var month: TDate): Boolean;
  //参数设置
  Procedure GRL_Cssz(ADOSvr:TADOConnection);
  //判断浮点数
  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)+'日';
        8: Result := FormatDateTime('yymmdd',TMD_ServerTime);
      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,和结束的col
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);