【轉】Delphi貨幣類型轉中文大寫金額

unit TU2.Helper.Currency;
 
interface
 
function CurrencyToChineseCapitalCharacter(const AValue: Currency; const ADecimals: Cardinal=4): string;
function CurrencyToString(const AValue: Currency; const ADecimals: Cardinal=4): string;
 
implementation
 
uses System.SysUtils, System.Math;
 
function CurrencyRound(var U: UInt64; const ADecimals: Cardinal): Integer; inline;
var
  W: UInt64;
begin//Bankers-rounding
  Result := 4-ADecimals;
  if Result<0 then
    Result := 0
  else if Result>0 then
  begin
    case Result of
      1:begin   //li
        DivMod(U, 10, U, W);
        if (W > 5) or ((W = 5) and Odd(U)) then
          Inc(U);
      end;
      2:begin  //fen
        DivMod(U, 100, U, W);
        if (W > 50) or ((W = 50) and Odd(U)) then
          Inc(U);
      end;
      3:begin  //jiao
        DivMod(U, 1000, U, W);
        if (W > 500) or ((W = 500) and Odd(U)) then
          Inc(U);
      end;
      4:begin  //yuan
        DivMod(U, 10000, U, W);
        if (W > 5000) or ((W = 5000) and Odd(U)) then
          Inc(U);
      end;
    end;
  end;
end;
 
function CurrencyToChineseCapitalCharacter(const AValue: Currency; const ADecimals: Cardinal=4): string;
const//Currency: [-922337203685477.5807, 922337203685477.5807]
  CCCNegative = '負';
  CCCZheng = '整';
  CCCNumbers: array[0..9] of Char = ('零','壹','貳','叄','肆','伍','陸','柒','捌','玖');
  CCCUnits: array[0..18] of Char = ('毫', '厘', '分', '角', '元','拾','佰','仟','萬',
                                     '拾','佰','仟','億','拾','佰','仟','萬','兆','拾');
var
  U, W: UInt64;
  Digits, Idx, ZeroFlag: Integer;
  Negative: Boolean;
  Buff: array[0..38] of Char;
begin
  U := PUInt64(@AValue)^;
  if U <> 0 then
  begin
    Negative := (U and $8000000000000000) <> 0;
    if Negative then
      U := not U + 1;
    Digits := CurrencyRound(U, ADecimals);
    if U<>0 then
    begin
      //Try skip trailing zero
      repeat
        DivMod(U, 10, U, W);
        Inc(Digits);
      until W<>0;
      Dec(Digits);
      Idx := 38;
      if Digits>=3 then
      begin
        Buff[Idx] := CCCZheng;
        Dec(Idx);
        if Digits>4 then
        begin
          Buff[Idx] := CCCUnits[4];
          Dec(Idx);
          if Digits>17 then
          begin
            Buff[Idx] := CCCUnits[17];
            Dec(Idx);
          end else if Digits>12 then
          begin
            Buff[Idx] := CCCUnits[12];
            Dec(Idx);
          end else if Digits>8 then
          begin
            Buff[Idx] := CCCUnits[8];
            Dec(Idx);
          end;
        end;
      end;
      Buff[Idx] := CCCUnits[Digits];
      Dec(Idx);
      Buff[Idx] := CCCNumbers[W];
      Dec(Idx);
      //Do Split
      ZeroFlag := 0;
      while U<>0 do
      begin
        Inc(Digits);
        DivMod(U, 10, U, W);
        if Digits in [4,8,12,17] then
        begin
          if ZeroFlag>0 then
          begin
            Buff[Idx] := CCCNumbers[0];
            Dec(Idx);
          end else if (ZeroFlag<0) and (Digits>8) then
            Inc(Idx);
          Buff[Idx] := CCCUnits[Digits];
          Dec(Idx);
          if W<>0 then
          begin
            Buff[Idx] := CCCNumbers[W];
            Dec(Idx);
            ZeroFlag := 0;
          end else
            ZeroFlag := -1;
        end else begin
          if W<>0 then
          begin
            if ZeroFlag>0 then
            begin
              Buff[Idx] := CCCNumbers[0];
              Dec(Idx);
            end;
            Buff[Idx] := CCCUnits[Digits];
            Dec(Idx);
            Buff[Idx] := CCCNumbers[W];
            Dec(Idx);
            ZeroFlag := 0;
          end else begin
            if ZeroFlag=0 then
              ZeroFlag := 1;
          end;
        end;
      end;
 
      if Negative then
        Buff[Idx] := CCCNegative
      else Inc(Idx);
 
      //Copy Result
      Digits := 38+1-idx;
      SetLength(Result, Digits);
      Move(Buff[idx], PChar(Result)^, Digits * SizeOf(WideChar));
      Exit;
    end;
  end;
  Result := CCCNumbers[0]+CCCUnits[4]+CCCZheng;
end;
 
function CurrencyToString(const AValue: Currency; const ADecimals: Cardinal=4): string;
const
  NegativeChar = '-';
  DecimalDotChar = '.';
var
  U: UInt64;
  Digits: Integer;
  Negative: Boolean;
begin
  U := PUInt64(@AValue)^;
  Negative := (U and $8000000000000000) <> 0;
  if Negative then
    U := not U + 1;
  Digits := CurrencyRound(U, ADecimals);
  Result := UIntToStr(U);
  if Digits<4 then
    Result := Result.Insert(Result.Length+Digits-4, DecimalDotChar);
  if Negative then
    Result := NegativeChar + Result;
end;
 
end.

在Delphi中，為了實現貨幣數值運算中的嚴格精度要求，內部把貨幣類型數據當作一個放大10000倍的64位整數來處理。這樣根據64位整數的范圍，可以得出貨幣類型Currency的范圍是 [-922337203685477.5807; 922337203685477.5807]。
貨幣類型一個最常見的應用場景是金額大寫轉換，網上都是一些先將貨幣轉字符串后再對字符串處理的代碼，而且有些方法在有些情況下不滿足金額大寫規范，這里給出一個直接轉換的方法。

附: 金額大寫規范
一、人民幣大寫金額數字到“元”為止的，在“元”之后，應寫“整”(或“正”)字；在“角”之后，可以不寫“整”(或“正”)字；大寫金額數字有“分”的，“分”后面不寫“整”(或“正”)字。
二、阿拉伯數字小寫金額數字中有“0”時，人民幣大寫應按照漢語語言規律。舉例如下:
1. 阿拉伯金額數字中間有“0”時，人民幣大寫要寫“零”字。如￥1409.50，應寫成人民幣陸壹仟肆佰零玖元伍角。
2. 阿拉伯金額數字中間連續有幾個“0”時，人民幣大寫金額中間可以只寫一個“零”字。如￥6007.14，應寫成人民幣陸仟零柒元壹角肆分。
3. 阿拉伯金額數字萬位和元位是“0”；或者數字中間連續有幾個“0”，萬位（或元位）也是“0”，但千位（或角位）不是“0”時；中文大寫金額中可以只寫一個零字，也可以不寫“零”字。如￥1680.32，應寫成人民幣壹仟陸佰捌拾元零叄角貳分或者寫成人民幣壹仟陸佰捌拾元叄角貳分。又如￥107000.53，應寫成人民幣壹拾萬柒仟元零伍角叄分或者寫成人民幣壹拾萬零柒仟元伍角叄分。
4. 阿拉伯金額數字角位是“0”，而分位不是“0”時，中文大寫金額“元”后面應寫“零”字。如￥16409.02，應寫成人民幣壹萬陸仟肆佰零玖元零貳分，又如￥325.04.應寫成人民幣叄佰貳拾伍元零肆分。
————————————————
版權聲明：本文為CSDN博主「tht2009」的原創文章，遵循 CC 4.0 BY-SA 版權協議，轉載請附上原文出處鏈接及本聲明。
原文鏈接：https://blog.csdn.net/tht2009/article/details/73287225

以上為作者原文內容，我對CurrencyToChineseCapitalCharacter函數在Android及Windows10上做了測試，結果正常。Delphi 版本10.3.2.感謝作者的分享！這是一個最有效率的實現方法！