rm_utils.pas

这是一个功能强大

    '零', '壹', '贰', '叁', '肆', '伍', '陆', '柒', '捌', '玖', '拾', '佰', '仟',
    '万', '亿', '兆', '元', '角', '分', '厘', '点', '负', '整');

function RMCurrToBIGNum(Value: Currency): string;
var
  sArabic, sIntArabic: string;
  sSectionArabic, sSection: string;
  i, iDigit, iSection, iPosOfDecimalPoint: integer;
  bInZero, bMinus: boolean;
  lNeedAddZero: Boolean;

  function ConvertStr(const str: string): string; //将字串反向, 例如: 传入 '1234', 传回 '4321'
  var
    i: integer;
  begin
    Result := '';
    for i := Length(str) downto 1 do
      Result := Result + str[i];
  end;

begin
  Result := '';
  bInZero := True;
  sArabic := FloatToStr(Value); //将数字转成阿拉伯数字字串
  if sArabic[1] = '-' then
  begin
    bMinus := True;
    sArabic := Copy(sArabic, 2, 9999);
  end
  else
    bMinus := False;

  lNeedAddZero := False;
  iPosOfDecimalPoint := Pos('.', sArabic); //取得小数点的位置
  //先处理整数的部分
  if iPosOfDecimalPoint = 0 then
    sIntArabic := ConvertStr(sArabic)
  else
    sIntArabic := ConvertStr(Copy(sArabic, 1, iPosOfDecimalPoint - 1));

  //从个位数起以每四位数为一小节
  for iSection := 0 to ((Length(sIntArabic) - 1) div 4) do
  begin
    sSectionArabic := Copy(sIntArabic, iSection * 4 + 1, 4);
    sSection := '';
    for i := 1 to Length(sSectionArabic) do //以下的 i 控制: 个十百千位四个位数
    begin
      iDigit := Ord(sSectionArabic[i]) - 48;
      if iDigit = 0 then
      begin
        if (iSection = 0) and (i = 1) then
          lNeedAddZero := True;

        if (not bInZero) and (i <> 1) then
          sSection := _ChineseNumeric[0] + sSection;
        bInZero := True;
      end
      else
      begin
        case i of
          2: sSection := _ChineseNumeric[10] + sSection;
          3: sSection := _ChineseNumeric[11] + sSection;
          4: sSection := _ChineseNumeric[12] + sSection;
        end;
        sSection := _ChineseNumeric[iDigit] + sSection;
        bInZero := False;
      end;
    end;

    //加上该小节的位数
    if Length(sSection) = 0 then
    begin
      if (Length(Result) > 0) and (Copy(Result, 1, 2) <> _ChineseNumeric[0]) then
        Result := _ChineseNumeric[0] + Result;
    end
    else
    begin
      case iSection of
        0: Result := sSection + Result;
        1: Result := sSection + _ChineseNumeric[13] + Result;
        2: Result := sSection + _ChineseNumeric[14] + Result;
        3: Result := sSection + _ChineseNumeric[15] + Result;
      end;
    end;
  end;

  if Length(Result) > 0 then
    Result := Result + _ChineseNumeric[16];
  if iPosOfDecimalPoint > 0 then //处理小数部分
  begin
    if lNeedAddZero then // 需要加"零", 107000.53:壹拾万柒仟元零伍角叁分
      Result := Result + _ChineseNumeric[0];

    for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
    begin
      iDigit := Ord(sArabic[i]) - 48;
      if not ((iDigit = 0) and lNeedAddZero) then
        Result := Result + _ChineseNumeric[iDigit];
        
      case i - (iPosOfDecimalPoint + 1) of
        0:
          begin
            if iDigit > 0 then
              Result := Result + _ChineseNumeric[17];
          end;
        1: Result := Result + _ChineseNumeric[18];
        2: Result := Result + _ChineseNumeric[19];
      end;
    end;
  end;

  //其他例外状况的处理
  if Length(Result) = 0 then
    Result := _ChineseNumeric[0];
  //  if Copy(Result, 1, 4) = _ChineseNumeric[1] + _ChineseNumeric[10] then
  //    Result := Copy(Result, 3, 254);
  if Copy(Result, 1, 2) = _ChineseNumeric[20] then
    Result := _ChineseNumeric[0] + Result;

  if bMinus then
    Result := _ChineseNumeric[21] + Result;
  if ((Round(Value * 100)) div 1) mod 10 = 0 then
    Result := Result + _ChineseNumeric[22];
end;

function RMChineseNumber(const jnum: string): string;
var
  hjnum: real;
  Vstr, zzz, cc, cc1, Presult: string;
  xxbb: array[1..12] of string;
  uppna: array[0..9] of string;
  iCount, iZero {,vpoint}: integer;
begin
  hjnum := strtofloat(jnum);
  Result := '';
  presult := '';
  if hjnum < 0 then
  begin
    hjnum := -hjnum;
    Result := '负';
  end;

  xxbb[1] := '亿';
  xxbb[2] := '千';
  xxbb[3] := '百';
  xxbb[4] := '十';
  xxbb[5] := '万';
  xxbb[6] := '千';
  xxbb[7] := '百';
  xxbb[8] := '十';
  xxbb[9] := '一';
  xxbb[10] := '.';
  xxbb[11] := '';
  xxbb[12] := '';

  uppna[0] := '零';
  uppna[1] := '一';
  uppna[2] := '二';
  uppna[3] := '三';
  uppna[4] := '四';
  uppna[5] := '五';
  uppna[6] := '六';
  uppna[7] := '七';
  uppna[8] := '八';
  uppna[9] := '九';

  Str(hjnum: 12: 2, Vstr);
  cc := '';
  cc1 := '';
  zzz := '';

  iZero := 0;
  //  vPoint:=0;
  for iCount := 1 to 10 do
  begin
    cc := Vstr[iCount];
    if cc <> ' ' then
    begin
      zzz := xxbb[iCount];
      if cc = '0' then
      begin
        if iZero < 1 then //*对“零”进行判断*//
          cc := '零'
        else
          cc := '';
        if iCount = 5 then //*对万位“零”的处理*//
          if copy(Result, length(Result) - 1, 2) = '零' then
            Result := copy(Result, 1, length(Result) - 2) + xxbb[iCount] + '零'
          else
            Result := Result + xxbb[iCount];
        cc1 := cc;
        zzz := '';
        iZero := iZero + 1;
      end
      else
      begin
        if cc = '.' then
        begin
          cc := '';
          if (cc1 = '') or (cc1 = '零') then
          begin
            Presult := copy(Result, 1, Length(Result) - 2);
            Result := Presult;
            iZero := 15;
          end;
          zzz := '';
        end
        else
        begin
          iZero := 0;
          cc := uppna[StrToInt(cc)];
        end
      end;
      Result := Result + (cc + zzz)
    end;
  end;

  if Vstr[11] = '0' then //*对小数点后两位进行处理*//
  begin
    if Vstr[12] <> '0' then
    begin
      cc := '点';
      Result := Result + cc;
      cc := uppna[StrToInt(Vstr[12])];
      Result := Result + (uppna[0] + cc + xxbb[12]);
    end
  end
  else
  begin
    if iZero = 15 then
    begin
      cc := '点';
      Result := Result + cc;
    end;
    cc := uppna[StrToInt(Vstr[11])];
    Result := Result + (cc + xxbb[11]);
    if Vstr[12] <> '0' then
    begin
      cc := uppna[StrToInt(Vstr[12])];
      Result := Result + (cc + xxbb[12]);
    end;
  end;

  if Copy(Result, 1, 4) = '一十' then
    Delete(Result, 1, 2);
end;

function RMSmallToBig(curs: string): string;
var
  Small, Big: string;
  wei: string[2];
  i: integer;
begin
  small := trim(curs);
  Big := '';
  for i := 1 to length(Small) do
  begin
    case strtoint(small[i]) of {位置上的数转换成大写}
      1: wei := '壹';
      2: wei := '贰';
      3: wei := '叁';
      4: wei := '肆';
      5: wei := '伍';
      6: wei := '陆';
      7: wei := '柒';
      8: wei := '捌';
      9: wei := '玖';
      0: wei := '零';
    end;

    Big := Big + wei; {组合成大写}
  end;

  Result := Big;
end;

procedure RMSetFontSize(aComboBox: TComboBox; aFontHeight, aFontSize: integer);
var
  i: integer;
begin
  for i := Low(RMDefaultFontSize) to High(RMDefaultFontSize) do
  begin
    if RMDefaultFontSize[i] = aFontHeight then
    begin
      if RMIsChineseGB then
        aComboBox.Text := RMDefaultFontSizeStr[i]
      else
        aComboBox.Text := RMDefaultFontSizeStr[i + 13];

      Exit;
    end;
  end;

  aComboBox.Text := IntToStr(aFontSize);
end;

procedure RMSetFontSize1(aListBox: TListBox; aFontSize: integer);
var
  i: integer;
begin
  for i := Low(RMDefaultFontSize) to High(RMDefaultFontSize) do
  begin
    if RMDefaultFontSize[i] = aFontSize then
    begin
      if RMIsChineseGB then
        aListBox.ItemIndex := i
      else
        aListBox.ItemIndex := i + 13;

      Break;
    end;
  end;
end;

function RMGetFontSize(aComboBox: TComboBox): integer;
begin
  if aComboBox.ItemIndex >= 0 then
  begin
    if aComboBox.ItemIndex <= High(RMDefaultFontSize) then
      Result := RMDefaultFontSize[aComboBox.ItemIndex]
    else
      Result := StrToInt(aComboBox.Text);
  end
  else
  begin
    try
      Result := StrToInt(aComboBox.Text);
    except
      Result := 0;
    end;
  end;
end;

function RMGetFontSize1(aIndex: Integer; aText: string): integer;
begin
  if aIndex >= 0 then
  begin
    if aIndex <= High(RMDefaultFontSize) then
      Result := RMDefaultFontSize[aIndex]
    else
      Result := StrToInt(aText);
  end
  else
  begin
    try
      Result := StrToInt(aText);
    except
      Result := 0;
    end;
  end;
end;

function RMCreateBitmap(const ResName: string): TBitmap;
begin
  Result := TBitmap.Create;
  Result.Handle := LoadBitmap(HInstance, PChar(ResName));
end;

procedure RMSetStrProp(aObject: TObject; const aPropName: string; ID: Integer);
var
  lStr: string;
  lPropInfo: PPropInfo;
begin
  lStr := RMLoadStr(ID);
  if lStr <> '' then
  begin
    lPropInfo := GetPropInfo(aObject.ClassInfo, aPropName);
    if lPropInfo <> nil then
      SetStrProp(aObject, lPropInfo, lStr);
  end;
end;

function RMGetPropValue(aReport: TRMReport; const aObjectName, aPropName: string): Variant;
var
  pi: PPropInfo;
  lObject: TObject;
begin
  Result := varEmpty;
  if aReport <> nil then
    lObject := RMFindComponent(aReport.Owner, aObjectName)
  else
    lObject := RMFindComponent(nil, aObjectName);

  if lObject <> nil then
  begin
    pi := GetPropInfo(lObject.ClassInfo, aPropName);
    if pi <> nil then
    begin
      case pi.PropType^.Kind of
        tkString, tkLString, tkWString:
          Result := GetStrProp(lObject, pi);
        tkInteger, tkEnumeration:
          Result := GetOrdProp(lObject, pi);
        tkFloat:
          Result := GetFloatProp(lObject, pi);
      end;
    end;
  end;
end;

function RMRound(x: Extended; dicNum: Integer): Extended; //四舍五入
var
  tmp: string;
  i: Integer;
begin
  if dicNum = 0 then
  begin
    Result := Round(x);
    Exit;
  end;

  tmp := '#.';
  for i := 1 to dicNum do
    tmp := tmp + '0';
  Result := StrToFloat(FormatFloat(tmp, x));
end;

function RMMakeFileName(AFileName, AFileExtension: string; ANumber: Integer): string;
var
  FileName: string;
begin
  FileName := ChangeFileExt(ExtractFileName(AFileName), '');
  Result := Format('%s%.4d.%s', [FileName, ANumber, AFileExtension]);
end;

function RMAppendTrailingBackslash(const S: string): string;
begin
  Result := S;
  if not IsPathDelimiter(Result, Length(Result)) then
    Result := Result + '\';
end;

function RMColorBGRToRGB(AColor: TColor): string;
begin
  Result := IntToHex(ColorToRGB(AColor), 6);
  Result := Copy(Result, 5, 2) + Copy(Result, 3, 2) + Copy(Result, 1, 2);
end;

function RMMakeImgFileName(AFileName, AFileExtension: string; ANumber: Integer): string;
var
  FileName: string;
begin
  FileName := ChangeFileExt(ExtractFileName(AFileName), '');
  Result := Format('%s_I%.4d.%s', [FileName, ANumber, AFileExtension]);
end;

procedure RMSetControlsEnable(AControl: TWinControl; AState: Boolean);
const
  StateColor: array[Boolean] of TColor = (clInactiveBorder, clWindow);
var
  I: Integer;
begin
  with AControl do
    for I := 0 to ControlCount - 1 do
    begin
      if ((Controls[I] is TWinControl) and
        (TWinControl(Controls[I]).ControlCount > 0)) then
        RMSetControlsEnable(TWinControl(Controls[I]), AState);
      if (Controls[I] is TCustomEdit) then
        THackWinControl(Controls[I]).Color := StateColor[AState]
      else if (Controls[I] is TCustomComboBox) then
        THackWinControl(Controls[I]).Color := StateColor[AState];
      Controls[I].Enabled := AState;
    end;
end;

procedure RMSaveFormPosition(aParentKey: string; aForm: TForm);
var
  Ini: TRegIniFile;
  Name: string;
begin
  Ini := TRegIniFile.Create(RMRegRootKey + aParentKey);
  Name := rsForm + aForm.ClassName;
  Ini.WriteInteger(Name, rsX, aForm.Left);
  Ini.WriteInteger(Name, rsY, aForm.Top);
  Ini.WriteInteger(Name, rsWidth, aForm.Width);
  Ini.WriteInteger(Name, rsHeight, aForm.Height);
  Ini.WriteBool(Name, rsMaximized, aForm.WindowState = wsMaximized);
  Ini.Free;
end;

procedure RMRestoreFormPosition(aParentKey: string; aForm: TForm);