glovproc.pas

一个非常好的桑拿浴管理系统

    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;S_TYPE:String='S');
begin
  with SG.Canvas do
  begin
    //center
    if UpperCase(S_TYPE) = 'S' then
    begin

    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
    else if UpperCase(S_TYPE) = 'N' then  //数量
    begin
      if S_text <> '' then
        TextRect(S_Rect, (S_Rect.Left + S_Rect.Right - S_Rect.Left- textwidth(FormatFloat('0.00',StrToFloat(S_text)))),
                     (S_Rect.Top + (S_Rect.Bottom - S_Rect.Top- textheight(FormatFloat('0.00',StrToFloat(S_text)))) div 2), FormatFloat('0.00',StrToFloat(S_text)));
    end
    else if UpperCase(S_TYPE) = 'F' then  //金额
    begin
      if S_text <> '' then
        TextRect(S_Rect, (S_Rect.Left + S_Rect.Right - S_Rect.Left- textwidth(FormatFloat('0.000',StrToFloat(S_text)))),
                     (S_Rect.Top + (S_Rect.Bottom - S_Rect.Top- textheight(FormatFloat('0.000',StrToFloat(S_text)))) div 2), FormatFloat('0.000',StrToFloat(S_text)));

    end
  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_Cssz(ADOSvr:TADOConnection);
var
  AQrySvr : TADOQuery;
begin
  AQrySvr := TADOQuery.Create(nil);
  AQrySvr.Connection := ADOSvr;

  GSS_CGF := 'Y';      //采购复核与否
  GSS_CCK := '2';      //成药出库方向
  GSS_KCT := 'Y';      //库存调整
  GSS_RKF := 'Y';      //入库复核与否
  GSS_RKZ := '0';      //入库单张比数
  GSS_YTJ := '0';      //药品调价
  GSS_CKF := 'Y';      //出库复核与否
  GSS_YTF := 'Y';      //药房，药库退药复核与否
  GSS_GYT := 'Y';      //供应商退药复核与否
  GSS_CKZ := '0';      //出库单张比数
  GSS_CKFF := '2';     //出库方法

  try
    With AQrySvr do
    begin
      //查询是否已前参数设置
      Close;
      Sql.Clear;
      Sql.Add('SELECT FSETANM,FSETBNM,FSETCNM,FSETDNM,FSETENM,FSETEBZ,');
      SQL.Add('       FSETFNM,FSETGNM,FSETHNM,FSETINM,FSETJBZ,FSETKNM');
      sql.Add(' FROM TSYSCSSZ');
      SQL.Add(' WHERE (FSETSNO=1)');
      Open;
      if not isEmpty then
      begin
        GSS_CGF := FieldByName('FSETANM').AsString;       //采购复核与否
        GSS_CCK := FieldByName('FSETBNM').AsString;       //成药出库方向
        GSS_KCT := FieldByName('FSETCNM').AsString;       //库存调整
        GSS_RKF := FieldByName('FSETDNM').AsString;       //入库复核与否
        //当 GSS_RKZ ＝ ''时 为无限制显示
        GSS_RKZ := trim(FieldByName('FSETEBZ').AsString); //入库单张比数
        GSS_YTJ := FieldByName('FSETFNM').AsString;       //药品调价
        GSS_CKF := FieldByName('FSETGNM').AsString;       //出库复核与否
        GSS_YTF := FieldByName('FSETHNM').AsString;       //药房，药库退药复核与否
        GSS_GYT := FieldByName('FSETINM').AsString;       //供应商退药复核与否
        //当 GSS_CKZ ＝ ''时 为无限制显示
        GSS_CKZ := trim(FieldByName('FSETJBZ').AsString); //出库单张比数
        GSS_CKFF := FieldByName('FSETKNM').AsString;      //出库方法
      end;
    end;
  finally
    AQrySvr.Free;
  end;
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
    AQryGrp.Connection := ADOSvr;
    try
      // Clear menu bar state
      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');  // ,TSYSPHIF B,TSYSPKIF C
        SQL.Add(' WHERE (A.FHQXHNO = '''+GSS_HNO+''')');
        SQL.Add(' AND (A.FHQXMNM = ''门诊投退药'')');
        SQL.Add('   AND (A.FHQXWNO > ''HIS10000'')');
        SQL.Add('   AND (A.FHQXWNO < ''HIS50000'')');
        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;
  finally
    AQryGrp.Close;
    AQryGrp.Free;
  end;
end;

end.