＃＃＃＃＃＃任意钱数转换大写，开来帮忙啊！！￥￥￥￥￥￥

Question

例如：对于任意小写钱数
  123.12 转为：    零亿零万零仟壹佰贰拾叁元壹角贰分
  2632315.47转为： 零亿贰佰陆拾叁万贰仟叁佰壹拾伍元肆角柒分
  12632315.47转为：零亿壹仟贰佰陆拾叁万贰仟叁佰壹拾伍元肆角柒分
  0.00转为：       零亿零万零仟零佰零拾零元零角零分
 然后将单位：“亿”“万”“仟”“佰”“拾”“元”“角”“分”，前面的大写汉字依次放入到一个长度为8的数组当中，请问这两步操作用函数怎么实现啊！
  请高手们出手帮忙啊，着急啊！！！高分酬谢！！！

Answer 1

逐位比较
IF NUM=1 THEN A[I]='壹'

Answer 2

function Changdx(mmje: Double): String;
const s1: String = '零壹贰叁肆伍陆柒捌玖';
s2: String = '分角元拾佰仟万拾佰仟亿拾佰仟万';
var s, dx: String;
i, Len: Integer;
function StrTran(const S, S1, S2: String): String;
begin Result := StringReplace(S, S1, S2, [rfReplaceAll]);
end;
begin
if mmje < 0 then begin
dx := '负';
mmje := -mmje;
end;
s := Format('%.0f', [mmje*100]);
Len := Length(s);
for i := 1 to Len do
dx := dx + Copy(s1, (Ord(s[i]) - Ord('0'))*2 + 1, 2) + Copy(s2,(Len - i)*2 + 1, 2);
//Ord(s)->Ord(s[i])
dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零仟', '零'), '零佰', '零'), '零拾', '零'), '零角', '零'), '零分', '整');
dx := StrTran(StrTran(StrTran(StrTran(StrTran(dx, '零零', '零'), '零零', '零'), '零亿', '亿'), '零万', '万'), '零元', '元');
if dx = '整' then
Result := '零元整'
else
Result := StrTran(StrTran(dx, '亿万', '亿'), '零整', '整');
end;
procedure TForm1.Button1Click(Sender: TObject);   //测试代码
begin
ShowMessage(Changdx(StrToFloatDef(Edit1.Text, 0)));
end;

Answer 3

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  procedure StrCopyEx(Des:Pchar;Src:ShortString;StartPos:integer;Len:integer);
  function GetFirstNoZeroLen(s:ShortString;StartPos:integer):integer;
  function FloatToPStr(F:Double;Num:Integer):ShortString;
  function ConvertRMB(RMB:double):ShortString;
implementation{$R *.dfm}
procedure StrCopyEx(Des:Pchar;Src:ShortString;StartPos:integer;Len:integer);
var
 i:integer;
begin
  for i:=0 to Len-1 do
  begin
    Des[i]:=Src[StartPos+i+1];
  end;
  Des[Len]:=#0;
end;
{**************************************************************************
                  获取指定位置到第一个非零字符的长度
              输入：
                     s---所在字符串
                     StartPos---开始的位置
              返回：从s[i]到第一个不是'0'的长度
              说明：由DecStrToPst调用              
**************************************************************************}
function GetFirstNoZeroLen(s:ShortString;StartPos:integer):integer;
var
 i,L:integer;
begin
  L:=strlen(Pchar(String(s)));
  Result:=0;
  for i:=StartPos to L do
  begin
    if s[i]<>'0' then begin Result:=i-StartPos; exit;end;
  end;
end;
//------------------------------------------------------------------------------
function DecStrToPStr(DecString:ShortString):ShortString;
const
  HZStr:array[0..10] of String[2]=(('零'),('壹'),('贰'),('叁'),('肆'),('伍'),('陆'),
                                  ('柒'),('捌'),('玖'),('拾'));  sUnitB:Array[1..14] Of String[4]=((''),('拾'),('佰'),('仟'),('万'),('十万'),('百万'),
                                  ('千万'),('亿'),('十亿'),('百亿'),('千亿'),('兆'),
                                  ('十兆') );
  sUnit:Array[1..4] Of String[2]=((''),('万'),('亿'),('兆'));
  sUnitEx:Array[1..14] Of String[4]=((''),(''),(''),(''),('万'),('十'),('百'),
                                  ('千'),('亿'),('十'),('百'),('千'),('兆'),
                                  ('十') );
  sUnitEx1:Array[1..14] Of String[4]=((''),(''),(''),(''),('万'),('万'),('万'),
                                  ('万'),('亿'),('亿'),('亿'),('亿'),('兆'),
                                  ('兆') );
var
  tempStr,TmpDecStr:ShortString;
  tempstr1:array[0..4] of char;
  L,i:integer;
  TAMA:boolean;
  sPartSum,sFirstPartNum:integer;
begin
  if DecString='' then exit;
  TmpDecStr:=IntToStr(StrToInt64(DecString));
  L:=strlen(Pchar(String(TmpDecStr)));
  tempStr:='';
  TAMA:=TRUE;
  if L <= 4 then
  begin
    for i:=1 to L do
    if TmpDecStr[i]<>'0' then
    begin
     if (L-i+1)<5 then
       tempstr:=tempstr+HZStr[ord(TmpDecStr[i])-48]+sUnitB[L-i+1]
     else tempstr:=tempstr+HZStr[ord(TmpDecStr[i])-48]+sUnitEx[L-i+1];
     TAMA:=true;
    end else
    begin
      if ((L-i+1>1) and TAMA and (GetFirstNoZeroLen(TmpDecStr,i)>0)) then
      begin
       tempstr:=tempstr+sUnitEx1[L-i+1]+HZStr[ord(TmpDecStr[i])-48];
       TAMA:=false;
      end;//END IF
    end;//END ELSE
    if ((DecString[1]='0') and (GetFirstNoZeroLen(DecString,1)<>0)) then Result:='零'+tempStr
    else Result:=tempStr;
    exit;
  end;  if L mod 4<>0 then  sPartSum:=(L Div 4)+1
  else sPartSum:=(L Div 4);
  sFirstPartNum:=L Mod 4;
  if sFirstPartNum=0 then sFirstPartNum:=4;
  for i:=0 to sPartSum-1 do
  begin
    if i>0 then StrCopyEx(tempStr1,Pchar(String(TmpDecStr)),4*(i-1)+sFirstPartNum,4)
    else strcopyEx(tempStr1,Pchar(string(TmpDecStr)),0,sFirstPartNum);
    tempstr:=TempStr+DecStrToPStr(tempstr1)+sUnit[sPartSum-i];
  end;
  Result:=tempStr;
end;
//------------------------------------------------------------------------------
function FloatToPStr(F:Double;Num:Integer):ShortString;
CONST
  HZStr:array[0..10] of String[2]=(('零'),('壹'),('贰'),('叁'),('肆'),('伍'),('陆'),
                                  ('柒'),('捌'),('玖'),('拾'));
  sExtendUnit:Array[1..2] of String[2]=(('角'),('分'));
var
  sTemp,sExtendPart:ShortString;
  iStrLen,iDotPosition:integer;
  i:integer;
  DecPartIsNull:Boolean;
begin
  sTemp:=FloatToStr(F);
  iStrLen:=strlen(Pchar(String(sTemp)));
  iDotPosition:=Pos('.',sTemp);
  if iDotPosition>0 then //分离小数点前后数,并对正数部分转换
  begin
    sExtendPart:=strpos(pchar(String(sTemp)),'.')+1;
    sExtendPart[Num+1]:=#0;
    Delete(sTemp,iDotPosition,iStrLen-iDotPosition+1);
  end;
  DecPartIsNull:=False;
  if sTemp<>'' then
  begin
    sTemp:=DecStrToPStr(sTemp);
    if sTemp<>'' then
    begin
        if iDotPosition>0 then
             sTemp:=sTemp+'元'
         else sTemp:=sTemp+'元整';    end else DecPartIsNull:=True;  end else DecPartIsNull:=True;  if iDotPosition>0 then  //处理小数部分的转换
  begin
    for i:=1 to StrLen(Pchar(String(sExtendPart))) do
    begin
      if sExtendPart[i]<>'0' then
        sTemp:=sTemp+HZStr[ord(sExtendPart[i])-48]+sExtendUnit[i]
      else  if not DecPartIsNull then
       sTemp:=sTemp+HZStr[ord(sExtendPart[i])-48]
    end;
  end;
  Result:=sTemp;
end;
//------------------------------------------------------------------------------
function ConvertRMB(RMB:double):ShortString;
begin
   result := '';
  if RMB = 0 then begin result := '零元整';exit;end;   //为零处理
  if RMB>99999999999999 then begin         //最大值处理
    result:='';exit;
  end;
  if RMB<0 then begin Result:='负';RMB:= RMB * -1; end;  //负数处理
   Result:=Result+FloatToPStr(RMB,2); //Abs :绝对值函数
end;procedure TForm1.Button1Click(Sender: TObject);
begin
if Edit1.Text='' then
begin
application.MessageBox('不能为空值','提示',64);
exit;
end else
showmessage(ConvertRMB(strtofloat(edit1.Text)));
end;procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (key in ['0'..'9',#8,'.']) then key:=#0;
end;end.

Answer 4

将转换好的大写金额单位：“兆”“亿”“万”“仟”“佰”“拾”“元”“角”“分”前面的具体大写数字分别取出来放到一个数组之中：
-----------------------------------
function SaveYuan(tmps :String):TStrings;
var
  s :String;
  sa :TStrings;
  i,j :Integer;
begin
  s := '亿万仟佰拾元角分';
  sa := TStringList.Create;
  i := 1;
  while i<>Length(s)+1 do
  begin
    j := Pos(s[i],tmps);
    sa.Add(copy(tmps,0,j-1));
    tmps := copy(tmps,j+2,Length(tmps)-j+1);
    i := i+2;
  end;
  result := sa;
end;测试：
procedure TForm1.Button1Click(Sender: TObject);
var
  tmps :String;
begin
  tmps := '零亿壹仟贰佰陆拾叁万贰仟叁佰壹拾伍元肆角柒分';
  ListBox1.Items :=  SaveYuan(tmps);
end;