在delphi中判断字符串是否数字，以及精度处理函数

// 判断是否是数值型   By yangxiao  2007.7.21
function isNumeric(strText: WideString): Boolean;
var
  s: string;
  i, l, p: Integer;
begin
  Result := False;
  l := Length(strText);
  if l = 0 then Exit;

  s := '';
  for i:=1 to l do
  begin
    case strText[i] of
      '0'..'9':
        s := s + strText[i];

      'E', 'e', '+', '-', '.':
      begin
        p := PosEx(strText[i], strText, i+1);
        if p = 0 then
        begin
          case strText[i] of
            'E', 'e':
              if (i=1) or (i=l) then Exit;

            '+', '-':
              if i > 1 then
                case strText[i-1] of
                  'E', 'e':
                    s := s + strText[i];
                else
                  Exit;
                end;
          end;
        end
        else
        begin
          case strText[p-1] of
            'E', 'e':
              s := s + strText[i];
          else
            Exit;
          end;
        end;
      end;
    else
      Exit;
    end;
  end;

  Result := True;
end;

{---------------------------------------- by YangXiao 2007.10.31-------------------------------
四舍六入五单双的修约准则：

  当有效位数后面的第一位数 ≤ 4 时，则舍去
  当有效位数后面的第一位数 ≥ 6 时，则进一
  当有效位数后面的第一位数 ＝ 5 时，而 5 后面的数全都为 0 时，5 前面为偶数则舍，5 前面为奇数则进
                                    若 5 后面的数不全都为 0 时，无论5前面是奇或是偶都进一

 例：x = 1.6451 保留 3 位有效位应该为：1.65
--------------------------------------- by YangXiao 2007.10.31--------------------------------}
function RoundToEx(AValue: string; const ADigit: TRoundToRange; strJDFL: string = '0'): string;
var
  i, p, n, lp, rp, srcLen, intLen, decLen: Integer;
  strValue, strInt, strDecimal, strSign, strScience, strResult: string;
begin
  if not isNumeric(AValue) then
  begin
    Result := AValue;
    Exit;
  end;

  // 第一位是小数点，自动在前加 0
  if AValue[1] = '.' then AValue := '0' + AValue;

  strSign := '';
  strScience := '';
  strValue := AValue;

  if StrToFloat(AValue) < 0 then
    strSign := '-';

  p := PosEx('E', AValue, 1);
  if p <= 0 then
    p := PosEx('e', AValue, 1);
  if p > 0 then
  begin
    strValue := Copy(AValue, 1, p-1);
    strScience := Copy(AValue, p, Length(AValue));
  end;

  if strValue[1] in ['+', '-'] then
    strValue := Copy(strValue, 2, Length(strValue));
  srcLen := Length(strValue);

  p := Pos('.', strValue);
  if p > 0 then
  begin
    strInt := Copy(strValue, 1, p-1);
    strDecimal := Copy(strValue, p+1, srcLen);
  end
  else
  begin
    strInt := strValue;
    strDecimal := '';
  end;

  for i:=1 to Length(strInt) do
    if strInt[i] <> '0' then
    begin
      strInt := Copy(strInt, i, Length(strInt));
      Break;
    end;

  // 整数部分是 0 的处理
  if StrToFloat(strInt) < 1 then
  begin
    if strDecimal <> '' then
    begin
      decLen := Length(strDecimal);

      n := 0;
      for i:=1 to decLen do
        if strDecimal[i] <> '0' then
          Break
        else
          Inc(n);

      n := n + ADigit + 1;
      if n < decLen then
      begin
        if strDecimal[n] = '5' then
        begin
          lp := n - 1;
          rp := n + 1;

          if strDecimal[rp] = '0' then
          begin
            p := 0;
            for i:=rp+1 to decLen do
              if strDecimal[i] <> '0' then
              begin
                p := 1;
                Break;
              end;

            if p = 0 then
            begin
              if strDecimal[lp] in ['0', '2', '4', '6', '8'] then
                strDecimal[n] := '4';
            end;
          end;
        end;
      end
      else if n = decLen then
      begin
        if strDecimal[n] = '5' then
        begin
          lp := n - 1;
          if strDecimal[lp] in ['0', '2', '4', '6', '8'] then
            strDecimal[n] := '4';
        end;
      end;
    end;

    strResult := RoundToFxIntO(strDecimal, strJDFL, ADigit);
    Result := strSign + strResult + strScience;
  end

  // 整数部分不是 0 的处理
  else
  begin
    intLen := Length(strInt);

    if strJDFL = '1' then
      if intLen > ADigit then
        n := ADigit + 1
      else
        n := ADigit + 2
    else
      n := intLen + ADigit + 2;

    if strValue[n] = '5' then
    begin
      lp := n - 1;
      if strValue[lp] = '.' then Dec(lp);

      rp := n + 1;
      if strValue[rp] = '.' then Inc(rp);

      p := 0;
      for i:=rp to srcLen do
        if strValue[i] <> '0' then
        begin
          p := 1;
          Break;
        end;

      if p = 0 then
      begin
        if strValue[lp] in ['0', '2', '4', '6', '8'] then
          strValue[n] := '4';
      end;
    end;

    strResult := RoundToFxIntX(strValue, strScience, strJDFL, ADigit);
    Result := strSign + strResult;
  end;
end;

function RoundToFxIntO(strDecimal, strDigitType: string; const iDigit: TRoundToRange): string;
var
  i, n, m, d, p, decLen, iLen: Integer;
  strInt, strFormat, strValue, strResult: string;
begin
  if isNumeric(strDecimal) then
  begin
    if StrToFloat(strDecimal) > 0 then
      decLen := Length(strDecimal)
    else
    begin
      strDecimal := '';
      decLen := 0;
    end;
  end
  else
  begin
    strDecimal := '';
    decLen := 0;
  end;

  // 如果小数部分是 0， 既全为 0
  if strDecimal = '' then
  begin
    d := iDigit;
    if strDigitType = '1' then    // 是有效数字
      d := iDigit - 1;

    strFormat := '0.';
    for i:=1 to d do
      strFormat := strFormat + '0';
    Result := strFormat;
  end
  else
  begin
    if strDigitType = '1' then
    begin
      // 得到有效数字前的 0 数
      n := 0;
      for i:=1 to decLen do
        if strDecimal[i] <> '0' then
          Break
        else
          Inc(n);
      m := n;   // 保留前 0 数

      n := n + iDigit;  // 得到定义的有效数字最后一位的下标和小数点后的总位数

      strFormat := '0.';
      for i:=1 to n do
        strFormat := strFormat + '0';
      strValue := '0.' + strDecimal;
      strResult := FormatFloat(strFormat, StrToFloat(strValue));

      p := Pos('.', strResult);
      strInt := Copy(strResult, 1, p-1);  // 得到修约后的结果中，整数的部分
      strDecimal := Copy(strResult, p+1, Length(strResult));  // 得到修约后的结果中，小数的部分
      iLen := Length(strDecimal); // 得到结果小数部分的长度

      // 得到结果的有效数字前的 0 数
      n := 0;
      for i:=1 to iLen do
        if strDecimal[i] <> '0' then
          Break
        else
          Inc(n);

      // 如果小数部分有进位， 或者整数部分有进位，去掉一个 0
      if (n < m) or (StrToInt(strInt)>0) then
      begin
        iLen := Length(strResult);
        strResult[iLen] := ' ';
        strResult := Trim(strResult);
      end;
    end
    else
    begin
      strFormat := '0.';
      for i:=1 to iDigit do
        strFormat := strFormat + '0';
      strValue := '0.' + strDecimal;  // 整数是 0，直接加“0.”还原数字
      strResult := FormatFloat(strFormat, StrToFloat(strValue));
    end;

    Result := strResult;
  end;
end;

 

function RoundToFxIntX(strValue, strScience, strDigitType: string;

                        const iDigit: TRoundToRange): string;
var
  i, p, intLen, iLen: Integer;
  strInt, strPower, strFormat, strResult: string;
begin
  // 如果精度要求是 0，按原数返回
  if iDigit = 0 then
  begin
    if strDigitType = '1' then
      Result := strValue + strScience
    else
      Result := FormatFloat('0', RoundTo(StrToFloat(strValue), 0)) + strScience;

    Exit;
  end;

  p := Pos('.', strValue);
  if p > 0 then
    strInt := Copy(strValue, 1, p-1)
  else
    strInt := strValue;
  intLen := Length(strInt);

  if strDigitType = '1' then
  begin
    if intLen > iDigit then
    begin
      strFormat := '0.';
      for i:=1 to iDigit-1 do
        strFormat := strFormat + '0';
      strFormat := strFormat + 'E+0';

      Result := FormatFloat(strFormat, StrToFloat(strValue));
    end
    else  // intLen <= iDigit
    begin
      strFormat := '0.';
      for i:=1 to iDigit-intLen do
        strFormat := strFormat + '0';
      strResult := FormatFloat(strFormat, StrToFloat(strValue));

      iLen := Length(strResult) - 1;    // 去掉小数点占的位数
      if iLen > iDigit then
      begin
        if strScience <> '' then
        begin
          strPower := Copy(strScience, 2, Length(strScience));

          strResult[2] := '.';
          strResult[3] := '0';

          i := StrToInt(strPower);
          i := i + 1;
          strPower := IntToStr(i);
          if i > 0 then
            strScience := 'E+' + strPower
          else
            strScience := 'E' + strPower;
        end;

        strResult[iLen+1] := ' ';
        if strResult[iLen] = '.' then
          strResult[iLen] := ' ';
        strResult := Trim(strResult);
      end;

      Result := strResult + strScience;
    end;
  end
  else
  begin
    strFormat := '0.';
    for i:=1 to iDigit do
      strFormat := strFormat + '0';
    strResult := FormatFloat(strFormat, StrToFloat(strValue));

    if strScience <> '' then
    begin
      strPower := Copy(strScience, 2, Length(strScience));

      p := Pos('.', strResult);
      iLen := Length(Copy(strResult, 1, p-1));

      if iLen > intLen then
      begin
        iLen := Length(strResult);

        strResult[2] := '.';
        strResult[3] := '0';

        i := StrToInt(strPower);
        i := i + 1;
        strPower := IntToStr(i);
        if i > 0 then
          strScience := 'E+' + strPower
        else
          strScience := 'E' + strPower;

        strResult[iLen] := ' ';
        strResult := Trim(strResult);
      end;
    end;

    Result := strResult + strScience;
  end;
end;