求小写转大写程序

Question

求小写转大写程序，我自己做了一个，老是处理不好‘0’的问题，因为急用，恳请大家帮帮忙，注意不是金额的小写转大写，室数字的，后面2位小数点

Answer 1

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
function Num2BCNum(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); (* 将数字转成阿拉伯数字字符串 *)
  if sArabic[1] = '-' then
  begin
    bMinus := True;
    sArabic := Copy(sArabic, 2, 254);
  end
  else
  bMinus := 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 := '';
    (* 以下的 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;
  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;  (* 其它例外状况的处理 *)
  if Length(Result) = 0 then Result := '零';
  if Copy(Result, 1, 2) = '点' then Result := '零' + Result;  (* 是否为负数 *)
  if bMinus then Result := '负' + Result;
end;function GetToday: string;
var
  wYear, wMonth, wDay: Word;
  sYear, sMonth, sDay: string[2];
begin
  DecodeDate(Now, wYear, wMonth, wDay);
  wYear  := wYear - 1911;
  sYear  := Copy(IntToStr(wYear + 1000), 3, 2);
  sMonth := Copy(IntToStr(wMonth + 100), 2, 2);
  sDay   := Copy(IntToStr(wDay + 100), 2, 2);
  Result := sYear + DateSeparator + sMonth + DateSeparator + sDay;
end;{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit2.text:= '大写 : '+Num2BCNum (strtocurr(Edit1.text))+'元整';
end;end.

Answer 2

上面的太复杂了，没必要那么复杂
这个是金额转换，我的原创
稍微改一下就可以了：function NumToChar(const n: Real): string;   //可以到万亿，并且可以随便扩大范围，只要改变cunit数组的内容
const cnum:  array[0..9]  of string = ('零','壹','贰','叁','肆','伍','陆','柒','捌','玖');
      cunit: array[0..14] of string = ('万','仟','佰','拾','亿','仟','佰','拾','万','仟','佰','拾','元','角','分');
var
  i : Integer;
  snum : string;
begin
  result := '';
  snum := format('%15d',[round(n * 100)]);
  for i:= 0 to high(cunit) do
    if snum[i+1] <> ' ' then
      result := result + cnum[strtoint(snum[i+1])] + cunit[i];
  //去掉多余的零
  Result := StringReplace(Result, '零元', '元', [rfReplaceAll]);
  Result := StringReplace(Result, '零拾', '零', [rfReplaceAll]);
  Result := StringReplace(Result, '零佰', '零', [rfReplaceAll]);
  Result := StringReplace(Result, '零仟', '零', [rfReplaceAll]);
  Result := StringReplace(Result, '零万', '万', [rfReplaceAll]);
  Result := StringReplace(Result, '零亿', '亿', [rfReplaceAll]);
  Result := StringReplace(Result, '亿万', '亿', [rfReplaceAll]);
  Result := StringReplace(Result, '零零零', '零', [rfReplaceAll]);
  Result := StringReplace(Result, '零零', '零', [rfReplaceAll]);
  Result := StringReplace(Result, '零万', '万', [rfReplaceAll]);
  Result := StringReplace(Result, '零亿', '亿', [rfReplaceAll]);
  Result := StringReplace(Result, '亿万', '亿', [rfReplaceAll]);
  Result := StringReplace(Result, '零元', '元', [rfReplaceAll]);
  if pos('零分',result)=0 then Result := StringReplace(Result, '零角', '零', [rfReplaceAll])
  else Result := StringReplace(Result, '零角', '整', [rfReplaceAll]);
  Result := StringReplace(Result, '零分', '', [rfReplaceAll]);
end;

Answer 3

FUNCTION chineseje(Aje:Currency):string;
var
   s_1,s_2:widestring;
   s_5:char;
   s_4:string;
   i:integer;
   mm:string;
   s_6,s_7:widestring;
begin
   s_4:=format('%10d',[trunc(aje*100)]);
   s_1:='零壹贰叁肆伍陆柒捌玖';
   s_2:='仟佰拾万仟佰拾元角分';
   s_5:='0';
   i:=1;
   mm:='';
   WHILE i<=10 do
   begin
     s_5:=s_4[i];
     IF s_5<>' ' then
     begin
         s_6:=s_1[ord(s_5)-ORD('0')+1];
         s_7:=s_2[i];
         IF (s_5='0') AND (i<>4) AND (i<>8)  then
           s_7:='';
         IF (copy(s_4,i,2)='00') OR ( (s_5='0') AND (i in [4,8,10])) then
           s_6:='';
         mm:=mm+s_6+s_7;
         IF (s_4[i]='0') AND ((s_4[i+1]<>'0') AND (i in [4,8])) then
           mm:=mm+s_1[1];
     END;
     inc(i);
   END ;
   IF s_5='0' then
     mm:=mm+'整';
   result:=mm;
end;

Answer 4

delphi里封装了小写转换成大写的函数呀，你为什么还要自己写呀

Answer 5

我这个最简单>>>>>>>>>>>>>>>>>>
function tform1.convert(money:real):string ;
var
   smallmode:string;
   bigchar,powerchar:string[2];
   power,dotpos,i:integer;
begin
   power:=-2;
   smallmode:=formatfloat('0.00',money); //formatfloat()指定浮点数格式
   dotpos:=system.pos('.',smallmode);   //pos()在字符串中搜索子串
   for i:=length(smallmode) downto 1 do
   begin
      if i=dotpos then continue;
      case strtoint(copy(smallmode,i,1))of
         1:bigchar:='壹';
         2:bigchar:='贰';
         3:bigchar:='叁';
         4:bigchar:='肆';
         5:bigchar:='伍';
         6:bigchar:='陆';
         7:bigchar:='柒';
         8:bigchar:='捌';
         9:bigchar:='玖';
         0:bigchar:='零';
      end;      case power of
         -3:powerchar:='厘';
         -2:powerchar:='分';
         -1:powerchar:='角';
         0:powerchar:='元';         1,5,9:powerchar:='拾';
         2,6,10:powerchar:='佰';
         3,7,11:powerchar:='仟';
         4,12:powerchar:='万';
         8:powerchar:='亿';
      end;
     inc(power);
     result:=bigchar+powerchar+result;
   end;
end;

Answer 6

http://218.56.11.178:8018/Filedown.aspx?FID=227