glovproc.pas

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

    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 >= ''HIS71000'')');
        SQL.Add('   AND (A.FHQXWNO < ''HIS71901'')');
        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.