[原创]阿拉伯数字与中国的大小写数字"沟通"的终结者

淮上

水平高低有别是正常的。

发帖子既要谦虚、又要不卑不亢，高手别鄙视新手，新手也别谄媚高手。

尊重别人是起码的做人修养，也是论坛和谐的关键所在。

建议楼主删除不当言论！

TANER

冤怨相报何时了！阿弥陀佛！

qcw911

狂刀无痕 发表于 2009-7-30 23:01
是拍马最多还是论文最多，请说清楚

肯定是马屁啦

Gu_xl

大家不要在这吵吵闹闹啦！这是学习交流的地方！我发个相同功能源码上来，供大家交流学习！不知道liminnet 的程序思路是否相同呢！

2. 
   
3. ;;;(gxl-num->Big n b) 数字小写变大写，参数：n 数字或数字字符串 b T为中文大写 nil 中文小写
   
4. (defun gxl-num->Big (n b / numlst numlst1 dimzin rtn1 rtn2 strnum1 strnumlst1 strnum2 strnumlst2 m flag zero)
   
5.   (if b
   
6.   (setq numlst '(("0" . "零") ("1" . "壹")("2" . "贰")("3" . "叁")("4" . "肆")("5" . "伍")("6" . "陆")("7" . "柒")("8" . "捌")("9" . "玖"))
   
7.         numlst1 '("" "拾" "佰" "仟" "万" "拾" "佰" "仟" "亿" "拾" "佰" "仟" "万" "拾" "佰" "仟")
   
8.         )
   
9.     (setq numlst '(("0" . "〇") ("1" . "一")("2" . "二")("3" . "三")("4" . "四")("5" . "五")("6" . "六")("7" . "七")("8" . "八")("9" . "九"))
   
10.         numlst1 '("" "十" "百" "千" "万" "十" "百" "千" "亿" "十" "百" "千" "万" "十" "百" "千")
    
11.         )
    
12.     )
    
13.   ;;;将n转为字串
    
14.   (if (= 'INT (type n))
    
15.     (setq n (itoa n))
    
16.     (if (= 'REAL (type n))
    
17.       (setq n (rtos n 2 6))
    
18.       (if (= 'STR (type n))
    
19.       (progn
    
20.       (setq n (atof n))
    
21.       (if (equal n (fix n))
    
22.         (setq n (rtos n 2 0))
    
23.         (setq n (rtos n 2 6))
    
24.         )
    
25.       )
    
26.       )
    
27.     )
    
28.     )
    
29.   ;;;如果包含小数位数，将字串分为 strnum1 strnum2
    
30. (setq k (VL-STRING-SEARCH "." n))
    
31.   (if k (setq strnum1 (substr n 1 k)
    
32.               strnum2 (substr n (+ k 2))
    
33.               )
    
34.     (setq strnum1 n strnum2 nil)
    
35.     )
    
36.   ;;;将strnum1 分解为表，顺序倒置
    
37.   (setq m 1)
    
38. (repeat (strlen strnum1)
    
39.    (setq strnumlst1 (cons (substr strnum1 m 1)strnumlst1)
    
40.          m (1+ m)
    
41.          )
    
42.    )
    
43.     ;;;将strnum2 分解为表，顺序不变
    
44.    (setq m 1)
    
45.   (if strnum2
    
46.     (progn
    
47. (repeat (strlen strnum2)
    
48.    (setq strnumlst2 (cons (substr strnum2 m 1) strnumlst2)
    
49.          m (1+ m)
    
50.          )
    
51.    )
    
52.    (setq strnum2 (apply 'strcat  strnumlst2))
    
53.   (setq strnum2 (itoa (atoi strnum2))
    
54.         strnumlst2 nil
    
55.         m 1)
    
56. (repeat (strlen strnum2)
    
57.    (setq strnumlst2 (cons (substr strnum2 m 1) strnumlst2)
    
58.          m (1+ m)
    
59.          )
    
60.    )
    
61. )
    
62.     )
    
63.   ;;;将strnumlst1转为大写
    
64.   (setq m 0 )
    
65.   (repeat (length strnumlst1)
    
66.     (setq rtn1 (cons (strcat (cdr (assoc (nth m strnumlst1) numlst)) (nth m  numlst1)) rtn1))
    
67.     (setq m (1+ m))
    
68.    
    
69.     )
    
70.   (setq m 0
    
71.         strnum1 "")
    
72.   (repeat (length rtn1)
    
73.     (if b
    
74.     (setq flag (WCMATCH  (nth m rtn1) "零*"))
    
75.       (setq flag (WCMATCH  (nth m rtn1) "〇*"))
    
76.       )
    
77.     (if (not flag)
    
78.       (setq strnum1 (strcat strnum1 (nth m rtn1)))
    
79.       (if (not zero)
    
80.       (setq strnum1 (if b (strcat strnum1 "零")(strcat strnum1 "〇"))
    
81.             zero t
    
82.             )
    
83.         )
    
84.        
    
85.       )
    
86.     (setq m (1+ m))
    
87.     )
    
88.     ;;;将strnumlst2转为大写
    
89.   (if strnumlst2
    
90.     (setq strnum2 (apply ' strcat (mapcar '(lambda (x) (cdr (assoc x numlst))) strnumlst2)))
    
91.     )
    
92.   ;;;输出结果
    
93.   (if strnumlst2
    
94.   (strcat strnum1 "." strnum2)
    
95.     strnum1
    
96.     )
    
97.   )
    

<br /> ;;;(gxl-num->Big n b) 数字小写变大写，参数：n 数字或数字字符串 b T为中文大写 nil 中文小写<br /> (defun gxl-num->Big (n b / numlst numlst1 dimzin rtn1 rtn2 strnum1 strnumlst1 strnum2 strnumlst2 m flag zero)<br />   (if b<br />   (setq numlst '(("0" . "零") ("1" . "壹")("2" . "贰")("3" . "叁")("4" . "肆")("5" . "伍")("6" . "陆")("7" . "柒")("8" . "捌")("9" . "玖"))<br />         numlst1 '("" "拾" "佰" "仟" "万" "拾" "佰" "仟" "亿" "拾" "佰" "仟" "万" "拾" "佰" "仟")<br />         )<br />     (setq numlst '(("0" . "〇") ("1" . "一")("2" . "二")("3" . "三")("4" . "四")("5" . "五")("6" . "六")("7" . "七")("8" . "八")("9" . "九"))<br />         numlst1 '("" "十" "百" "千" "万" "十" "百" "千" "亿" "十" "百" "千" "万" "十" "百" "千")<br />         )<br />     )<br />   ;;;将n转为字串<br />   (if (= 'INT (type n))<br />     (setq n (itoa n))<br />     (if (= 'REAL (type n))<br />       (setq n (rtos n 2 6))<br />       (if (= 'STR (type n))<br />       (progn<br />       (setq n (atof n))<br />       (if (equal n (fix n))<br />         (setq n (rtos n 2 0))<br />         (setq n (rtos n 2 6))<br />         )<br />       )<br />       )<br />     )<br />     )<br />   ;;;如果包含小数位数，将字串分为 strnum1 strnum2<br /> (setq k (VL-STRING-SEARCH "." n))<br />   (if k (setq strnum1 (substr n 1 k)<br />               strnum2 (substr n (+ k 2))<br />               )<br />     (setq strnum1 n strnum2 nil)<br />     )<br />   ;;;将strnum1 分解为表，顺序倒置<br />   (setq m 1)<br /> (repeat (strlen strnum1)<br />    (setq strnumlst1 (cons (substr strnum1 m 1)strnumlst1)<br />          m (1+ m)<br />          )<br />    )<br />     ;;;将strnum2 分解为表，顺序不变<br />    (setq m 1)<br />   (if strnum2<br />     (progn<br /> (repeat (strlen strnum2)<br />    (setq strnumlst2 (cons (substr strnum2 m 1) strnumlst2)<br />          m (1+ m)<br />          )<br />    )<br />    (setq strnum2 (apply 'strcat  strnumlst2))<br />   (setq strnum2 (itoa (atoi strnum2))<br />         strnumlst2 nil<br />         m 1)<br /> (repeat (strlen strnum2)<br />    (setq strnumlst2 (cons (substr strnum2 m 1) strnumlst2)<br />          m (1+ m)<br />          )<br />    )<br /> )<br />     )<br />   ;;;将strnumlst1转为大写<br />   (setq m 0 )<br />   (repeat (length strnumlst1)<br />     (setq rtn1 (cons (strcat (cdr (assoc (nth m strnumlst1) numlst)) (nth m  numlst1)) rtn1))<br />     (setq m (1+ m))<br />     <br />     )<br />   (setq m 0<br />         strnum1 "")<br />   (repeat (length rtn1)<br />     (if b<br />     (setq flag (WCMATCH  (nth m rtn1) "零*"))<br />       (setq flag (WCMATCH  (nth m rtn1) "〇*"))<br />       )<br />     (if (not flag)<br />       (setq strnum1 (strcat strnum1 (nth m rtn1)))<br />       (if (not zero)<br />       (setq strnum1 (if b (strcat strnum1 "零")(strcat strnum1 "〇"))<br />             zero t<br />             )<br />         )<br />         <br />       )<br />     (setq m (1+ m))<br />     )<br />     ;;;将strnumlst2转为大写<br />   (if strnumlst2<br />     (setq strnum2 (apply ' strcat (mapcar '(lambda (x) (cdr (assoc x numlst))) strnumlst2)))<br />     )<br />   ;;;输出结果<br />   (if strnumlst2<br />   (strcat strnum1 "." strnum2)<br />     strnum1<br />     )<br />   )<br />

yoyoho

感谢Gu_xl 版主分享程序
学习了!