delphi 金额大小写转换函数

{*------------------------------------------------
  金额大小写转换函数
  @author  王云盼
  @version V1506.01
　在delphi7测试OK
-------------------------------------------------}
unit UnTranRMB; //主要是考虑数字的小数部分，和大写金额的零
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
function TranRMB(const Value: string): string;     /// const 和 var 常量 变量 数字金额转换成大写金额
function TranNum(M: string):string;                /// 大写金额转换成数字金额  
 
implementation
 
{*------------------------------------------------
  判断是否有小数点, 切给出小数点出现的位置 和小数点的数目
  @param  S 字符串
  @param  Pos 小数点位置
  @param  Number 小数点个数
  @return Boolean
-------------------------------------------------}
function  IsPoint(S: string; var Pos: Integer; var Number: integer): Boolean;
var
  I: integer;
begin
  Result := False;
  Number := 0;
  for I := 1 to length(S)  do
  begin
    if S[I] = '.' then
    begin
      Pos := I;
      Number := Number + 1;
      Result := True;
    end;
  end;
end;
 
{*------------------------------------------------
  检测字符串是否合理，若小数点超过1个或者字符串开头是0
  @param  Value
  @return Boolean
-------------------------------------------------}
function ChickStr(Value: double): Boolean;
var
  J, K : Integer;
begin
  Result := False;
  if Value <= 0 then
    Result := True;
  if IsPoint(floatToStr(Value), J, K) = True then
    if K >= 2  then
      Result := True;
end;
 
{*------------------------------------------------
  转换小写函数
  @param
  @return
-------------------------------------------------}
function TranNum(M: string):string;
var
  N: Integer;
  S: string;
begin
  S := '.00';
  if Length(M) = 1 then
    Result := '￥' + M + S
  else Result := '￥' + M ;
end;
 
{*------------------------------------------------
  数字金额转换成大写金额
  @param
  @return
-------------------------------------------------}
function TranRMB(const Value: string): string;
var
  I, J, K, L, V,  Pos, LZPart, LXPart : integer;
  S1: string;
  IsZero: Boolean;
begin
  if  ((Value[1]='0') and (Value[2]<>'.')) or (Value[1]='.') then  /// 第一位不能为小数点
  begin
    ShowMessage('不符合要求');
    exit;
  end;
  //if  ChickStr(FloatToStr(S1)) = True then exit;  /// 判断是否可以转换
  L := length(Value);                 /// 初始化转换的数字长度
  Result := '人民币';              /// 初始化返回值
 
  /// 有小数情况
  if IsPoint(Value, Pos, J) = True then
  begin
    LXPart := L - Pos;               /// 小数部分长度
    LZPart := L - LXPart - 1;        /// 整数部分长度
    if StrToFloat(Value) = 0 then
    begin
      Result :=Result + '零元整';
      exit;
    end;
    for J := 1 to LZPart do          /// 当前位置
    begin
      K := StrToInt(Value[J]);       /// 当前位置的内容
      V := LZPart - J + 1;           /// 当前位置的权
      case K of                      /// 获取当前位置内容的大写值
        1: S1 := '壹';
        2: S1 := '贰';
        3: S1 := '叁';
        4: S1 := '肆';
        5: S1 := '伍';
        6: S1 := '陆';
        7: S1 := '柒';
        8: S1 := '捌';
        9: S1 := '玖';
        0: begin                          /// 有0的情况
            S1 := '零';
            if J < LZPart then            /// 如果不是最后一位，则判断低位是否也有0，有0不显示
            begin
              if (Value[J+1] = '') or (Value[J+1] = '0') then
              S1 := '';
            end;
            if J = LZPart then            /// 0在最后一位也不显示
              S1 := '';
           end;
        end;
      case V of                           /// 权的情况
        1:begin
            if K = 0 then
            begin
              if StrToFloat(Value) < 1 then
              begin
                S1 := '';
                Result := Result + S1;
              end
              else begin
              S1 := '';
              Result := Result + S1  + '元' ;
              end;
             end
          else
            Result := Result + S1 + '元';
          end;
        2:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '拾';
          end;
        3:begin
          if K = 0 then
             Result := Result + S1
          else
            Result := Result + S1 + '百' ;
          end;
        4:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '仟' ;
          end;
        5:begin
          if K = 0 then
            begin
               S1 := '';
               Result := Result + S1  + '万' ;
             end
          else
            Result := Result + S1 + '万';
          end;
        6:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '拾';
          end;
        7:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '百';
          end;
        8:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '仟';
          end;
        9:begin
          if K = 0 then
            begin
               S1 := '';
               Result := Result + S1  + '万' ;
             end
          else
            Result := Result + S1 + '亿';
          end;
        10:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '拾';
          end;
        11:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '百';
          end;
        12:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '仟';
          end;
        13:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '万';
          end;
        14:begin
          if K = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '兆';
          end;
      end;
    end;
     for I := 1 to LXPart do
     begin
        V := StrToInt(Value[I+Pos]) ;
        case V of
          1: S1 := '壹';
          2: S1 := '贰';
          3: S1 := '叁';
          4: S1 := '肆';
          5: S1 := '伍';
          6: S1 := '陆';
          7: S1 := '柒';
          8: S1 := '捌';
          9: S1 := '玖';
          0: begin
              S1 := '零';
              if I < L then   /// 如果不是最后一位
              begin
               if (Value[I+Pos+1] = '') or (Value[I+Pos+1] = '0') then
               begin
                 IsZero := True;
                 S1 := '';
               end;
              end;
              if I = L then
                S1 := '';
              end;
       end;
 
      case I of
        1: begin
             if V = 0 then
             begin
               Result := Result + S1  ;
             end
             else
               Result := Result + S1 + '角';
           end;
        2: begin
             if V = 0 then
             begin
               Result := Result + S1 ;
             end
             else
              Result := Result + S1 + '分';
             end;
        3: begin
            if V = 0 then
               begin
               Result := Result + S1 ;
             end
             else
              Result := Result + S1 + '厘';
             end;
        4: begin
             if V = 0 then
               begin
               Result := Result + S1 ;
             end
             else
               Result := Result + S1 + '毫';
             end;
      end;
     end;
     if S1 = ''  then Result := Result + '整';
  end
 
  /// 不是小数情况
  else begin
    for I := 1 to L do                  /// 当前位的位置
    begin
      V := StrToInt(Value[I]) ;    /// 当前位的内容
      K := L - I + 1;                   /// 当前位的权
      case V of
        1: S1 := '壹';
        2: S1 := '贰';
        3: S1 := '叁';
        4: S1 := '肆';
        5: S1 := '伍';
        6: S1 := '陆';
        7: S1 := '柒';
        8: S1 := '捌';
        9: S1 := '玖';
        0: begin
             S1 := '零';
             if I < L then   /// 如果不是最后一位
             begin           /// 判断下一位是不是0,低位0不显示
               if (Value[i+1] = '') or (Value[i+1] = '0') then
                 S1 := '';
             end;
             if I = L then
               S1 := '';
           end;
      end;
 
      case K of
         1:begin
            if V = 0 then          /// 当有零的情况
            Result := Result + S1 + '元整'
          else
            Result := Result + S1 + '元整';
          end;
        2:begin
          if V = 0 then
            Result := Result + S1
          else
            Result := Result + S1 + '拾';
          end;
        3:begin
          if V = 0 then
             Result := Result + S1
          else
            Result := Result + S1 + '百' ;
          end;
        4:begin
          if V = 0 then
             Result := Result + S1
          else
            Result := Result + S1 + '仟' ;
          end;
        5:begin
          if V = 0 then
             begin
               S1 := '';
               Result := Result + S1  + '万' ;
             end
          else
            Result := Result + S1 + '万';
          end;
        6:begin
          if V = 0 then
             Result := Result + S1
          else
            Result := Result + S1 + '拾';
          end;
        7:begin
          if V = 0 then
             Result := Result + S1
          else
            Result := Result + S1 + '百';
          end;
        8:begin
          if V = 0 then
             Result := Result + S1
          else
            Result := Result + S1 + '仟';
          end;
        9:begin
          if V = 0 then
             begin
               S1 := '';
               Result := Result + S1  + '亿' ;
             end
          else
            Result := Result + S1 + '亿';
          end;
        10:begin
           if V = 0 then
             Result := Result + S1
           else
             Result := Result + S1 + '拾';
           end;
        11:begin
           if V = 0 then
             Result := Result + S1
           else
             Result := Result + S1 + '百';
           end;
        12:begin
           if V = 0 then
             Result := Result + S1
           else
             Result := Result + S1 + '仟';
           end;
        13:begin
           if V = 0 then
             Result := Result + S1
           else
             Result := Result + S1 + '万';
           end;
        14:begin
           if V = 0 then
             Result := Result + S1
           else
             Result := Result + S1 + '兆';
           end;
      end;
    end;
  end;
end;
 
end.