按照定长将字符串分割成表

xianaihua

如果从数据库中调用的长文本字符串，要在dcl对话框的列表框中显示，由于dcl列表框的局限（没有水平滑动条），会发现超出列表框范围的字符无法显示，为了解决这个问题，可以采用将长字符串按最大长度分割成表，这样可以解决这个问题。
以下是我编写的支持汉字的字符串定长分割成表的函数，希望朋友们指正！

2. ;;  按照一定的长度，将字符串进行分割成表（支持汉字双字节）
   
3. ;;  参数
   
4. ;;      str：要处理的字符串
   
5. ;;      MaxLen：分割成表的字符串最大长度
   
6. ;;  返回： 分割为字符串最大长度为MaxLen的表
   
7. (defun StrWrap (str MaxLen / alist pf strc strlist)
   
8.   (setq  alist (vl-string->list str)
   
9.   pf    0
   
10.   strc  ""
    
11.   )
    
12.   (while alist
    
13.     (if  (< pf MaxLen)
    
14.       (progn (setq pf (1+ pf))
    
15.        (if (< (car alist) 129)  ;car返回表中的第一个元素
    
16.          (setq strc  (strcat strc (chr (car alist)))
    
17.          alist (cdr alist)  ;返回去掉了第一个元素的表
    
18.          )
    
19.          (setq strc  (strcat strc (chr (car alist)) (chr (cadr alist)))
    
20.           ;cadr返回表的第二个元素
    
21.          alist (cddr alist)  ;cddr返回去掉了前两个元素的表
    
22.          )
    
23.        )
    
24.       )
    
25.       (progn
    
26.   (setq strlist (cons strc strlist)
    
27.         pf      0
    
28.         strc    ""
    
29.   )
    
30.       )
    
31.     )
    
32.     (if  (not alist)
    
33.       (setq strlist (cons strc strlist))
    
34.     )          ;将最后不够最大长度的字符串加进表中
    
35.   )
    
36.   (reverse strlist)
    
37. )

;;  按照一定的长度，将字符串进行分割成表（支持汉字双字节）<br /> ;;  参数<br /> ;;      str：要处理的字符串<br /> ;;      MaxLen：分割成表的字符串最大长度<br /> ;;  返回： 分割为字符串最大长度为MaxLen的表<br /> (defun StrWrap (str MaxLen / alist pf strc strlist)<br />   (setq  alist (vl-string->list str)<br />   pf    0<br />   strc  ""<br />   )<br />   (while alist<br />     (if  (< pf MaxLen)<br />       (progn (setq pf (1+ pf))<br />        (if (< (car alist) 129)  ;car返回表中的第一个元素<br />          (setq strc  (strcat strc (chr (car alist)))<br />          alist (cdr alist)  ;返回去掉了第一个元素的表<br />          )<br />          (setq strc  (strcat strc (chr (car alist)) (chr (cadr alist)))<br />           ;cadr返回表的第二个元素<br />          alist (cddr alist)  ;cddr返回去掉了前两个元素的表<br />          )<br />        )<br />       )<br />       (progn<br />   (setq strlist (cons strc strlist)<br />         pf      0<br />         strc    ""<br />   )<br />       )<br />     )<br />     (if  (not alist)<br />       (setq strlist (cons strc strlist))<br />     )          ;将最后不够最大长度的字符串加进表中<br />   )<br />   (reverse strlist)<br /> )

实例：(StrWrap "出席这次全会的有，中央委员199人，候补中央委员164人。中央纪律检查委员会常务委员会委员和有关方面负责同志列席了会议。党的十八大代表中部分基层同志和专家学者也列席了会议。" 10)结果：_$
STRWRAP
("出席这次全会的有，中" "央委员199人，候补" "中央委员164人。中" "央纪律检查委员会常务" "委员会委员和有关方面" "负责同志列席了会议。" "党的十八大代表中部分" "基层同志和专家学者也" "列席了会议。")
_$

xianaihua

我在我的尺寸公差查询中就采用这个函数来显示注解。

自贡黄明儒

xianaihua 发表于 2014-10-23 20:26
我在我的尺寸公差查询中就采用这个函数来显示注解。

说好的公差源码呢？

lucas_3333

热烈欢迎xianaihua大师重出江湖！ 希望看到您更多的杰作！

自贡黄明儒

昨天很奇怪,楼主出来了，高飞也出来了，飞诗也出来了。楼主只是画了一个烧饼。
都是难得出来一下的高手 呀

1. ;;文字按给定长度分段
   
2. ;;(MtextDivde (getpoint)  (getpoint) '("A" "B" "C" "D" "E" "F" "G") 3)=>
   
3. ;;(("A" "B" "C") ("D" "E" "F") ("G"))
   
4. (defun MtextDivde (p p1 L Textheigh / L1 LST SCOR STR1 STR2 W W0 X)
   
5.   (setq Lst L)
   
6.   (setq w (abs (- (car p) (car p1))))          ;方框宽度
   
7.   (setq w (abs (- w Textheigh Textheigh)))        ;左右间隙半个字高
   
8.   (while (setq L1 (car Lst))
   
9.     (setq Lst (cdr Lst))
   
10.     ;;(cond ((and scor (not str1)) (setq str1 (cons "    " str1))));加4个空格
    
11.     (setq str1 (cons L1 str1))
    
12.     (setq str2 (apply 'strcat str1))
    
13.     (setq W0 (abs (car (apply 'mapcar (cons '- (HH:String:Len "" str2 Textheigh 1))))))
    
14.     (cond ((> w0 w)
    
15.      (setq scor (cons str1 scor))
    
16.      (setq str1 nil)
    
17.     )
    
18.     )
    
19.   )
    
20.   (cond (str1 (setq scor (cons str1 scor))))
    
21.   (reverse (mapcar '(lambda (x) (reverse x)) scor))
    
22. )

;;文字按给定长度分段<br /> ;;(MtextDivde (getpoint)  (getpoint) '("A" "B" "C" "D" "E" "F" "G") 3)=><br /> ;;(("A" "B" "C") ("D" "E" "F") ("G"))<br /> (defun MtextDivde (p p1 L Textheigh / L1 LST SCOR STR1 STR2 W W0 X)<br />   (setq Lst L)<br />   (setq w (abs (- (car p) (car p1))))          ;方框宽度 <br />   (setq w (abs (- w Textheigh Textheigh)))        ;左右间隙半个字高<br />   (while (setq L1 (car Lst))<br />     (setq Lst (cdr Lst))<br />     ;;(cond ((and scor (not str1)) (setq str1 (cons "    " str1))));加4个空格<br />     (setq str1 (cons L1 str1))<br />     (setq str2 (apply 'strcat str1))<br />     (setq W0 (abs (car (apply 'mapcar (cons '- (HH:String:Len "" str2 Textheigh 1))))))<br />     (cond ((> w0 w)<br />      (setq scor (cons str1 scor))<br />      (setq str1 nil)<br />     )<br />     )<br />   )<br />   (cond (str1 (setq scor (cons str1 scor))))<br />   (reverse (mapcar '(lambda (x) (reverse x)) scor))<br /> )

xyp1964

建议使用paragraph的对话框属性

xianaihua

xyp1964 发表于 2014-10-24 14:31
建议使用paragraph的对话框属性

院长的看起来很整齐！

lucas_3333

xianaihua 发表于 2014-10-24 22:27
院长的看起来很整齐！

大师，放出编译版给我们用用也行啊

lucas_3333

大师，先感谢您了！同行的骄傲! 也代表同行感谢您了！

liuhaixin88

xianaihua 发表于 2014-10-23 20:26
我在我的尺寸公差查询中就采用这个函数来显示注解。

很给力，呵呵！谢谢同行前辈