[TB-LISP函数]：TBC:Num->Hz 数字转化为汉字

tengteb

  ;数字转化为汉字。bCase：T--大写；bOne：T--保留首部的“一十”前的“一”
(defun TBC:Num->Hz (x bCase bOne / Split Join us ns v)
  (defun Split (x / Func lst)
    (defun Func (x)
      (setq lst (cons (fix (rem x 10)) lst))
      (and (< 9 x) (Func (/ x 10)))
    ) ;defun
    (Func x)
    (setq lst (TBC:Chunk (reverse lst) 8))
    (mapcar '(lambda (e) (TBC:Chunk e 4)) lst)
  ) ;defun
  (defun Join (lst / Unit Join1 Join4 Join8 i vs)
    (defun Unit (i / u)
      (cond
        ((>= i 8) (setq u (strcat (Unit (- i 8)) (nth 5 us))))
        ((> i 4) (setq u (strcat (nth (- i 4) us) (nth 4 us))))
        (T (setq u (nth i us)))
      ) ;cond
      u
    ) ;defun
    (defun Join1 (x / n)
      (setq n (nth x ns))
      (cond
        ((/= x 0) (setq vs (cons (strcat n (Unit i)) vs)))
        ((not vs)) ;后面全为0
        ((/= "零" (car vs)) (setq vs (cons n vs)))
      ) ;cond
      (setq i (1+ i))
    ) ;defun
    (defun Join4 (itm / i vs)
      (setq i 0)
      (mapcar 'Join1 itm)
      (TBC:Join vs "")
    ) ;defun
    (defun Join8 (itm / v vv)
      (setq v  (Join4 (cadr itm)) ;本段不足5位数时返回""
            vv (Join4 (car itm))
      )
      (and (/= v "") (/= v "零") (setq v (strcat v "万")))
      (and (/= vv "零") (setq v (strcat v vv)))
      (and
        (> i 0)
        (/= v "零")
        (setq v (strcat v "亿"))
      ) ;and
      (setq vs (cons v vs))
      (setq i (1+ i))
    ) ;defun
    (setq i 0)
    (mapcar 'Join8 lst)
    (TBC:Join vs "")
  ) ;defun
  (setq us (TBC:Split (TBC:IIf bCase " 拾 佰 仟" " 十 百 千") " ")
        ns (TBC:IIf bCase "壹贰叁肆伍陆柒捌玖" "一二三四五六七**")
        ns (TBC:Split (strcat "零" ns) 2)
        v  (Join (Split x))
  )
  (and
    (not bOne)
    (wcmatch v "一十*")
    (setq v (substr v 3 (strlen v)))
  ) ;and
  v
)

hh_lj007

谢谢分享源码