deity
尊榮會員
發表：90
回覆：876
積分：678
註冊：2003-05-09
發送簡訊給我
|
懷舊的人您好：
参考：
數字金額轉國字範例
http://delphi.ktop.com.tw/topic.php?topic_id=34738
里有
hagar前辈提供的链接
CT970126.ZIP
提供 BIG5 碼中文數字與阿拉伯數字互換等多個中文環境適用的函
數單元及範例 ( 附原始程式碼 )，作者:錢達智。
http://vcl.vclxx.org/DELPHI/D32FREE/CT970126.ZIP
ps上来，您试试看 ![]()
< class="code">
(* -------------------------------------------------- *)
(* BCNum2Num 将中文<<大写>>数字字串转成阿拉伯数字
(* 使用示例:
(* if BCNum2Num('壹仟参佰万零肆拾点壹零参', dblTest)
(* dblTest ==> 13000040.103
(*
(* 注意事项:
(* 1. 转换成功, 函数传回 True; 否则为 False
(* 2. 不支援 '肆万万' 等的说法, 必须为标准的记数方式
(*
(* Author: Wolfgang Chien
(* Date: 1996/08/04
(* Update Date:
(* -------------------------------------------------- *)
function BCNum2Num(sChineseNum: string; var dblArabic: double): boolean;
const
_ChineseNumeric = '拾佰仟万亿兆点零壹贰参肆伍陆柒捌玖';
var
i: integer;
iPos: integer;
dblBuffer: double;
sMultiChar: string;
iDigit: integer;
iRightOfDecimal: integer;
bMinus: boolean; (* 简单的十次方函数, 取 10^n, where n: byte and n >= 0 *)
function EasyPower10(iPower: byte): double;
var
i: integer;
begin
Result := 1;
try
for i := 1 to iPower do Result := Result * 10;
except
Result := 0;
end;
end;
begin
Result := False;
dblArabic := 0;
dblBuffer := 0;
iDigit := -1;
iRightOfDecimal := -1; if Copy(sChineseNum, 1, 2) = '负' then
begin
sChineseNum := Copy(sChineseNum, 3, 254);
bMinus := True;
end
else
bMinus := False; i := 1;
while i < Length(sChineseNum) do
begin
(* 如果不是中文字 ==> Fail *)
if sChineseNum[i] < #127 then Exit;
sMultiChar := Copy(sChineseNum, i, 2);
iPos := Pos(sMultiChar, _ChineseNumeric);
if iPos = 0 then Exit;
if (iDigit = -1) and (iPos > 13) then
iDigit := (iPos - 15) div 2;
case iPos of
1, 3, 5:
begin
(* 拾佰仟 *)
if iDigit = -1 then iDigit := 1;
dblBuffer := dblBuffer iDigit * EasyPower10((iPos 1) div 2);
iDigit := -1;
end;
7, 9, 11:
begin
(* 万亿兆 *)
if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer iDigit;
dblArabic := dblArabic dblBuffer * EasyPower10((iPos-5) div 2 * 4);
iDigit := -1;
dblBuffer := 0;
end;
13:
begin
(* 小数点 *)
if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer iDigit;
dblArabic := dblArabic dblBuffer;
dblBuffer := 0;
iDigit := -1;
iRightOfDecimal := 0;
end;
15: (* 零 *)
begin
if iRightOfDecimal > -1 then Inc(iRightOfDecimal);
iDigit := -1;
end;
else
begin
if iRightOfDecimal > -1 then
begin
(* 小数点右边的部分 *)
Inc(iRightOfDecimal);
try
dblArabic := dblArabic iDigit / EasyPower10(iRightOfDecimal);
except
Exit;
end;
iDigit := -1;
end;
end;
end; {$ifdef __Debug}
ShowMessage(IntToStr(i) 'th dblArabic: ' FloatToStr(dblArabic));
ShowMessage(IntToStr(i) 'th dblBuffer: ' FloatToStr(dblBuffer));
ShowMessage(IntToStr(i) 'th iDigit: ' IntToStr(iDigit));
{$endif} Inc(i, 2);
end; if (iDigit > 0) and (iDigit < 10) then
dblBuffer := dblBuffer iDigit;
if dblBuffer <> 0 then dblArabic := dblArabic dblBuffer;
if bMinus then
begin
{$ifdef __SafeMode}
sChineseNum := '负' sChineseNum;
{$endif}
dblArabic := dblArabic * -1;
end;
{$ifdef __SafeMode}
Result := sChineseNum = Num2BCNum(dblArabic);
{$else}
Result := True;
{$endif}
end;
使用：
procedure TForm1.Button1Click(Sender: TObject);
var
dblTest:double;
begin
if BCNum2Num('壹仟参佰万零肆拾点壹零参', dblTest) then
showmessage(currtostr(dbltest));
end;
具体可自己下载档案来查看 ~~~行径窄处，留一步与人行~~~ 發表人 - deity 於 2004/12/23 16:42:06
|
發表時間：2004-12-23 15:54:38
IP:211.78.xxx.xxx 未訂閱
