找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 956|回复: 1

[讨论]文字裁切双位元函数

[复制链接]
发表于 2007-10-12 20:34:55 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
[讨论]文字裁切双位元函数

或许已有高手编写过了,但因为没有找到过
所以编写了这支可以切断文字左边或右边的函数,
想请各位高手多多指导精简一下,
并看看是否还有其他要改进的地方.
谢谢~


(SETQ STR "一二三四五") ;字串
(SETQ STR_ST 3)  ;字串起始值 1...
(SETQ STR_LH 3)  ;字串切割位数 1...N / NIL
(SETQ DB_Byte T) ;双位元计算保留 T/NIL
(SETQ CP_LF T)   ;反转左切 T/NIL
(JTHWA-TRIM-STR STR STR_ST STR_LH DB_Byte CP_LF)

exp1:
(SETQ STR "1234567890")
(JTHWA-TRIM-STR STR 3 1 t t)
_$ "3"
(JTHWA-TRIM-STR STR 3 2 n t)
_$ "23"
(JTHWA-TRIM-STR STR 3 1 n n)
_$ "3"
(JTHWA-TRIM-STR STR 3 2 n n)
_$ "34"

exp2:
(SETQ STR "一二三四五")
(JTHWA-TRIM-STR STR 3 2 n n)
_$ "二"
(JTHWA-TRIM-STR STR 3 3 n n)
_$ "二?
(JTHWA-TRIM-STR STR 3 3 t n)
_$ "二三"
(JTHWA-TRIM-STR STR 4 3 t n)
_$ "二三"
(JTHWA-TRIM-STR STR 4 4 t n)
_$ "二三四"
(JTHWA-TRIM-STR STR 4 4 n t)
_$ "一二"
(JTHWA-TRIM-STR STR 4 3 n t)
_$ "@二"
(JTHWA-TRIM-STR STR 5 2 t t)
_$ "二三"  
(JTHWA-TRIM-STR STR 7 3 t t)
_$ "三四"


[PHP]


(DEFUN JTHWA-TRIM-STR (STR STR_ST STR_LH DB_Byte CP_LF / ANS I ST01
                           ST02 STAL STNNB STR_LH-BK STR_LH-FT STR_LH-K
                           STR_LH-ME STR_ST-BK STR_ST-FT STR_ST-ME
                           STR_STLH SUBNB-K TSTNB )             
  (SETQ STNNB NIL)
  (SETQ STAL (tc:getstrwid STR))
  (SETQ ST01 (CAR (tc:getstrwid STR)))
  (SETQ ST02 (CDR (tc:getstrwid STR)))
  (SETQ I -1)
  (REPEAT ST01
    (SETQ I (1+ I))
    (SETQ TSTNB (strlen (NTH I ST02)))
    (REPEAT TSTNB
      (SETQ STNNB (CONS I STNNB))
    )
  )
  (SETQ STNNB (reverse STNNB))
  (IF CP_LF
    ;; ======================处理左切字串
    (PROGN
      (SETQ STR_STLH (strlen STR))
      (SETQ SUBNB-K (1- STR_ST))
      (SETQ STR_ST-FT (IF (minusp (1+ SUBNB-K))
                        NIL
                        (NTH (1+ SUBNB-K) STNNB)
                      )
      )
      (SETQ STR_ST-ME (IF (minusp (NTH SUBNB-K STNNB))
                        NIL
                        (NTH SUBNB-K STNNB)
                      )
      )
      (SETQ STR_ST-BK (IF (minusp (1- SUBNB-K))
                        NIL
                        (NTH (1- SUBNB-K) STNNB)
                      )
      )
      (COND
        ((OR
           (= SUBNB-K 0)
           (minusp STR_ST)
           (< STR_ST STR_LH)
         )
          (PRINT "Runner Error")
          (SETQ ANS "")
        )
        (T
          (IF DB_Byte
            (PROGN
              (IF (= STR_LH NIL)
                (SETQ STR_LH (1- STR_ST))
              )
              (COND
                ((= STR_ST-ME STR_ST-FT)
                  (SETQ STR_ST (1+ STR_ST))
                  (SETQ STR_LH (1+ STR_LH))
                )
                ((= STR_ST-ME STR_ST-BK)
                  (SETQ STR_ST STR_ST)
                )
              )
              (IF STR_LH
                (PROGN
                  (SETQ STR_LH-K (- STR_ST STR_LH))
                  (SETQ STR_LH-FT (IF (minusp (1+ STR_LH-K))
                                    NIL
                                    (NTH (1+ STR_LH-K) STNNB)
                                  )
                  )
                  (SETQ STR_LH-ME (IF (minusp (NTH STR_LH-K STNNB))
                                    NIL
                                    (NTH STR_LH-K STNNB)
                                  )
                  )
                  (SETQ STR_LH-BK (IF (minusp (1- STR_LH-K))
                                    NIL
                                    (NTH (1- STR_LH-K) STNNB)
                                  )
                  )
                )
              )
              (IF STR_LH
                (PROGN
                  (COND
                    ((= STR_LH-ME STR_LH-FT)
                      (SETQ STR_LH STR_LH)
                    )
                    ((= STR_LH-ME STR_LH-BK)
                      (SETQ STR_LH (1+ STR_LH))
                    )
                  )
                  (SETQ ANS (SUBSTR STR (1+ (- STR_ST STR_LH)) STR_LH))
                )
                (SETQ ANS (SUBSTR STR 1 STR_ST))
              )
            )
            (PROGN
              (IF STR_LH
                (SETQ ANS (substr STR (SETQ STR_ST (- (1+ STR_ST)
                                                      STR_LH
                                                   )
                                      )
                                  (SETQ STR_LH STR_LH)
                          )
                )
                (SETQ ANS (substr STR 1 STR_ST))
              )
            )
          )
        )
      )
    )
    ;; ======================处理右切字串
    (PROGN
      (SETQ STR_STLH (strlen STR))
      (SETQ SUBNB-K (1- STR_ST))
      (SETQ STR_ST-FT (IF (minusp STR_ST)
                        NIL
                        (NTH STR_ST STNNB)
                      )
      )
      (SETQ STR_ST-ME (IF (minusp (NTH SUBNB-K STNNB))
                        NIL
                        (NTH SUBNB-K STNNB)
                      )
      )
      (SETQ STR_ST-BK (IF (minusp (1- SUBNB-K))
                        NIL
                        (NTH (1- SUBNB-K) STNNB)
                      )
      )
      (COND
        ((OR
           (= SUBNB-K 0)
           (minusp STR_ST)
           (> SUBNB-K STR_STLH)
         )
          (PRINT "Runner Error")
          (SETQ ANS "")
        )
        (T
          (IF DB_Byte
            (PROGN
              (COND
                ((= STR_ST-ME STR_ST-FT)
                  (SETQ STR_ST STR_ST)
                )
                ((= STR_ST-ME STR_ST-BK)
                  (SETQ STR_ST (1- STR_ST))
                  (SETQ STR_LH (IF (= STR_LH NIL)
                                 (SETQ STR_LH NIL)
                                 (1+ STR_LH)
                               )
                  )
                )
              )
              (IF (= STR_LH NIL)
                (SETQ STR_LH NIL)
                (IF STR_LH
                  (PROGN
                    (SETQ STR_LH-K (- (+ STR_ST STR_LH) 2))
                    (SETQ STR_LH-FT (IF (minusp (1+ STR_LH-K))
                                      NIL
                                      (NTH (1+ STR_LH-K) STNNB)
                                    )
                    )
                    (SETQ STR_LH-ME (IF (minusp (NTH STR_LH-K STNNB))
                                      NIL
                                      (NTH STR_LH-K STNNB)
                                    )
                    )
                    (SETQ STR_LH-BK (IF (minusp (1- STR_LH-K))
                                      NIL
                                      (NTH (1- STR_LH-K) STNNB)
                                    )
                    )
                  )
                )
              )
              (IF STR_LH
                (PROGN
                  (COND
                    ((= STR_LH-ME STR_LH-FT)
                      (SETQ STR_LH (1+ STR_LH))
                    )
                    ((= STR_LH-ME STR_LH-BK)
                      (SETQ STR_LH STR_LH)
                    )
                  )
                  (SETQ ANS (SUBSTR STR STR_ST STR_LH))
                )
                (SETQ ANS (SUBSTR STR STR_ST))
              )
            )
            (PROGN
              (IF STR_LH
                (SETQ ANS (substr STR STR_ST STR_LH))
                (SETQ ANS (substr STR STR_ST))
              )
            )
          )
        )
      )
    )
  )
  (PRINT ANS)
  (prin1)
)

tc:getstrwid 函数
引用来源: http://www.mjtd.com/bbs/dispbbs. ... ID=50326&page=1
BY xxsheng
(defun tc:getstrwid(str / m n a c)
  (setq m 0)
  (setq n 0)
  (while (< m (strlen str))
    (if (> (vl-string-elt str m) 128)
      (progn
        (setq n(1+ n))
    (setq a (substr str (1+ m) 2))
    (setq m(+ 2 m))
      )
      (progn
    (setq n(1+ n))
    (setq a (substr str (1+ m) 1))
    (setq m(1+ m))
      )
    )
    (setq c(cons a c))
  )
  (setq c(reverse c))
  (cons n c)
)
[/PHP]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2007-10-12 22:58:39 | 显示全部楼层
把 Substr 搞这么复杂!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-22 12:08 , Processed in 0.205706 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表