unitfrmmain.pas

《Delphi实用程序100例》配套书源码盘

unit unitFrmMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// Num2CNum  将阿拉伯数字转成中文数字字串

function Num2CNum(dblArabic: double): string;
const
  _ChineseNumeric = '零壹贰叁肆伍陆柒捌玖';

var
  sArabic: string;
  sIntArabic: string;
  iPosOfDecimalPoint: integer;
  i: integer;
  iDigit: integer;
  iSection: integer;
  sSectionArabic: string;
  sSection: string;
  bInZero: boolean;
  bMinus: boolean;

  (* 将字串反向, 例如: 传入 '1234', 传回 '4321' *)
  function ConvertStr(const sBeConvert: string): string;
  var
    x: integer;
  begin
    Result := '';
    for x := Length(sBeConvert) downto 1 do
      AppendStr(Result, sBeConvert[x]);
  end; { of ConvertStr }
begin
  Result := '';
  bInZero := True;
  sArabic := FloatToStr(dblArabic); (* 将数字转成阿拉伯数字字串 *)
{$IFDEF __Debug}
  ShowMessage('FloatToStr(dblArabic): ' + sArabic);
{$ENDIF}
  if sArabic[1] = '-' then
    begin
      bMinus := True;
      sArabic := Copy(sArabic, 2, 254);
    end
  else
    bMinus := False;
  iPosOfDecimalPoint := Pos('.', sArabic); (* 取得小数点的位置 *)
{$IFDEF __Debug}
  ShowMessage('Pos(''.'', sArabic) ' + IntToStr(iPosOfDecimalPoint));
{$ENDIF}

  (* 先处理整数的部分 *)
  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 := '';
      (* 以下的 i 控制: 个十百千位四个位数 *)
      for i := 1 to Length(sSectionArabic) do
        begin
          iDigit := Ord(sSectionArabic[i]) - 48;
          if iDigit = 0 then
            begin
              (* 1. 避免 '零' 的重覆出现 *)
              (* 2. 个位数的 0 不必转成 '零' *)
              if (not bInZero) and (i <> 1) then sSection := '零' + sSection;
              bInZero := True;
            end
          else
            begin
              case i of
                2: sSection := '拾' + sSection;
                3: sSection := '佰' + sSection;
                4: sSection := '仟' + sSection;
              end;
              sSection := Copy(_ChineseNumeric, 2 * iDigit + 1, 2) +
                sSection;
              bInZero := False;
            end;
        end;

      (* 加上该小节的位数 *)
      if Length(sSection) = 0 then
        begin
          if (Length(Result) > 0) and (Copy(Result, 1, 2) <> '零') then
            Result := '零' + Result;
        end
      else
        begin
          case iSection of
            0: Result := sSection;
            1: Result := sSection + '万' + Result;
            2: Result := sSection + '亿' + Result;
            3: Result := sSection + '兆' + Result;
          end;
        end;
{$IFDEF __Debug}
      ShowMessage('sSection: ' + sSection);
      ShowMessage('Result: ' + Result);
{$ENDIF}
    end;

  (* 处理小数点右边的部分 *)
  if iPosOfDecimalPoint > 0 then
    begin
      AppendStr(Result, '点');
      for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
        begin
          iDigit := Ord(sArabic[i]) - 48;
          AppendStr(Result, Copy(_ChineseNumeric, 2 * iDigit + 1, 2));
        end;
    end;

{$IFDEF __Debug}
  ShowMessage('Result before 其他例外处理: ' + Result);
{$ENDIF}
  (* 其他例外状况的处理 *)
  if Length(Result) = 0 then Result := '零';
  if Copy(Result, 1, 4) = '一十' then Result := Copy(Result, 3, 254);
  if Copy(Result, 1, 2) = '点' then Result := '零' + Result;

  (* 是否为负数 *)
  if bMinus then Result := '负' + Result;
{$IFDEF __Debug}
  ShowMessage('Result before Exit: ' + Result);
{$ENDIF}
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := Num2CNum(StrToFloat(Edit1.Text));

end;

end.