文件管理模拟界面

yxpxa

2. 
   
3. (defun c:oui( / lastpx lastpy)
   
4. 
   
5.   (setq icoHy 50   ;;预设图片的高度，单位: 像素
   
6.         icoWx 70   ;;预设图片的宽度，单位: 像素
   
7.         distanceWx 15  ;;填充图片的水平间距
   
8.         distanceHy 25
   
9.         starWx 5  ;;起始x偏移量
   
10.         starHy 5
    
11.         pictureWx 534  ;;Pictue 控件宽度 ;;(dcl_Control_GetWidth oui_Form1_PictureBox1);
    
12.         pictureHy 380  
    
13.         nMax (fix (/ pictureWx (+ icoWx distanceWx))) ;; 水平方向的最大填充数量
    
14.         nMay (fix (/ pictureHy (+ icoHy distanceHy))))
    
15. 
    
16. (dcl_Project_Load "oui.odcl")
    
17. (dcl_Form_Show oui_Form1)
    
18. (dcl_Project_Unload "oui")
    
19. (princ)
    
20. )
    
21. 
    
22. ;;初始化
    
23. (defun c:oui_Form1_OnInitialize (/)
    
24.   (if filename-list (progn
    
25.       (dcl_Control_SetText oui_Form1_TextBox2 filename-path)
    
26.       (display_picture filename-list)
    
27.   ))
    
28. )
    
29. ;;关闭
    
30. (defun c:oui_Form1_TextButton1_OnClicked (/)(dcl_Form_Close oui_Form1))
    
31. 
    
32. ;;移动鼠标
    
33. (defun c:oui_Form1_PictureBox1_OnMouseMove (Flags X Y /)
    
34.   (setq n (length filename-list)
    
35.         m (car (Crect_tang n x y)))
    
36.   (if (and select-ed (/= m select-curl))(progn
    
37.     (setq select-curl m)
    
38.     (display_picture filename-list)
    
39.     (display_movepic x y 100 -2 -2)
    
40.     ))
    
41. )
    
42. 
    
43. ;;滚动鼠标
    
44. (defun c:oui_Form1_PictureBox1_OnMouseWheel (Flags ZDelta X Y /)
    
45.   (if (> ZDelta 0)(princ "向上↑滚动 ")(princ "向下↓滚动 "))
    
46. (princ)
    
47. )
    
48. 
    
49. ;;打开文件
    
50. (defun c:oui_Form1_TextButton2_OnClicked (/)
    
51. (if (nth xxxccc filename-list)
    
52.   (dcl_MessageBox (strcat "当前选择文件: " (nth xxxccc filename-list)) "提示" 2 2)
    
53.   (dcl_MessageBox "当前未选择文件" "提示" 2 2)
    
54. )
    
55. )
    
56. 
    
57. ;;按下鼠标
    
58. (defun c:oui_Form1_PictureBox1_OnMouseDown (Button Flags X Y /)
    
59.   (setq xxxx x yyyy y)
    
60. )
    
61. (defun c:oui_Form1_PictureBox1_OnClicked (/)
    
62. (setq xxxccc (display_movepic  xxxx yyyy 101 0 0)
    
63.        select-ed (not select-ed))
    
64. )
    
65. 
    
66. 
    
67. 
    
68. ;;单击浏览文件夹
    
69. (defun c:oui_Form1_TextButton3_OnClicked (/ ss fLt1 fLt2)
    
70. (setq ss (dcl_SelectFolder "选择文件夹"))
    
71. (if ss (progn (dcl_Control_SetText oui_Form1_TextBox2 ss)
    
72.    (setq fLt1(vl-directory-files ss "*.dwg")
    
73.          fLt2(vl-directory-files ss "*.txt")
    
74.          filename-list (append fLt1 fLt2)
    
75.          filename-path ss)
    
76.    (dcl_PictureBox_Clear oui_Form1_PictureBox1)
    
77.    (display_picture filename-list)
    
78. ))
    
79. )
    
80. 
    
81. ;;功能: 显示或位移一个新的图片
    
82. ;;参数: x y 图片的坐标  i 图片编号  dx dy 图片位移量
    
83. ;;返回: 鼠标所在图片的序号，没有选择则为 nil
    
84. (defun display_movepic(x y i dx dy / FL TL Lt Lxy n)
    
85.   (setq n (length filename-list))
    
86.   (display_picture filename-list)
    
87.   (setq Lt (Crect_tang n x y))
    
88.   (if (car Lt)(progn
    
89.       (setq Lxy (nth (car Lt) (cadr Lt))
    
90.          FL (list (+ dx (car(car Lxy)))(+ dy (cadr(car Lxy))) i)
    
91.          TL (list (car(car Lxy)) (+ (cadr (car Lxy)) icoHy 1) -3 20 (nth (car Lt) filename-list) 0))
    
92.       (dcl_PictureBox_PaintPicture oui_Form1_PictureBox1 (list FL))
    
93.       (dcl_PictureBox_DrawText oui_Form1_PictureBox1 (list TL))
    
94.   )) (car Lt)
    
95. )
    
96. 
    
97. ;;功能: 传入文件列表，显示图片及文件名
    
98. ;;参数: <Lt> 文件名称列表
    
99. ;;无返回值
    
100. (defun display_picture(Lt / m n xy)
     
101.    (setq Ln (length Lt) n 0
     
102.          fLLxy '() tLLxy '())
     
103.    (setq feLt (cadr (Crect_tang Ln nil nil)))
     
104.    (if (> Ln (* nMay nMax))(setq Ln (* nMay nMax))) ;;满屏显示
     
105.    (repeat Ln
     
106.      (setq tem (nth n feLt)
     
107.             fLLxy (cons (append (car tem) '(100)) fLLxy)
     
108.             tLLxy (cons (list (car(car tem)) (+ (cadr (car tem)) icoHy 1) -19 20 (nth n Lt) 0 nil) tLLxy)
     
109.             n (1+ n))
     
110.    )
     
111.    (dcl_PictureBox_PaintPicture oui_Form1_PictureBox1 fLLxy)
     
112.    (dcl_PictureBox_DrawText oui_Form1_PictureBox1 (reverse tLLxy))
     
113. )
     
114. 
     
115. ;;功能: 创建 cn 个矩形，并判断 x,y 是否在矩形阵列内，
     
116. ;;返回: 如果 x,y 矩形中，返回 (m Tg)，Tg 为矩形阵列 m 为序列号
     
117. ;;      x,y 不在矩形内或 x,y 为 nil 时返回 (nil Tg)
     
118. (defun Crect_tang(cn x y / m n nm)
     
119. (setq n 0 RTang '())
     
120. (repeat nMay
     
121.     (setq nm (- cn (* n nMax))) ;;剩余填充数
     
122.     (if (>= nm nMax) (setq nm nMax))
     
123.     (setq m 0)
     
124.     (repeat nM
     
125.        (setq p1 (list (+ starWx (* m (+ icoWx distanceWx)))
     
126.                       (+ starHy (* n (+ icoHy distanceHy))))
     
127.              p2 (list (+ (car p1) icoWx) (+ (cadr p1) icoHy))
     
128.           RTang (cons (list p1 p2) RTang)
     
129.               m (1+ m))
     
130.     ) (setq n (1+ n))
     
131. )(setq RTang (reverse RTang));;矩形表生成
     
132. (setq n 0 nn nil)
     
133. (if (and x y)
     
134. (repeat (length RTang)
     
135.     (setq pt12 (nth n RTang)
     
136.            p1 (car pt12)
     
137.            p2 (cadr pt12)
     
138.            n (1+ n))
     
139.     (if (and (> x (car p1))(< x (car p2))(> y (cadr p1))(< y (cadr p2)))
     
140.        (setq nn (- n 1)))
     
141. )) (list nn RTang)
     
142. )
     
143. (princ)

<br /> (defun c:oui( / lastpx lastpy)<br /> <br />   (setq icoHy 50   ;;预设图片的高度，单位: 像素<br />         icoWx 70   ;;预设图片的宽度，单位: 像素<br />         distanceWx 15  ;;填充图片的水平间距<br />         distanceHy 25<br />         starWx 5  ;;起始x偏移量<br />         starHy 5<br />         pictureWx 534  ;;Pictue 控件宽度 ;;(dcl_Control_GetWidth oui_Form1_PictureBox1);<br />         pictureHy 380  <br />         nMax (fix (/ pictureWx (+ icoWx distanceWx))) ;; 水平方向的最大填充数量<br />         nMay (fix (/ pictureHy (+ icoHy distanceHy))))<br /> <br /> (dcl_Project_Load "oui.odcl")<br /> (dcl_Form_Show oui_Form1)<br /> (dcl_Project_Unload "oui")<br /> (princ) <br /> )<br /> <br /> ;;初始化<br /> (defun c:oui_Form1_OnInitialize (/)<br />   (if filename-list (progn<br />       (dcl_Control_SetText oui_Form1_TextBox2 filename-path)<br />       (display_picture filename-list)<br />   ))<br /> )<br /> ;;关闭<br /> (defun c:oui_Form1_TextButton1_OnClicked (/)(dcl_Form_Close oui_Form1))<br /> <br /> ;;移动鼠标<br /> (defun c:oui_Form1_PictureBox1_OnMouseMove (Flags X Y /)<br />   (setq n (length filename-list)<br />         m (car (Crect_tang n x y)))<br />   (if (and select-ed (/= m select-curl))(progn<br />     (setq select-curl m)<br />     (display_picture filename-list)<br />     (display_movepic x y 100 -2 -2)<br />     ))<br /> )<br /> <br /> ;;滚动鼠标<br /> (defun c:oui_Form1_PictureBox1_OnMouseWheel (Flags ZDelta X Y /)<br />   (if (> ZDelta 0)(princ "向上↑滚动 ")(princ "向下↓滚动 ")) <br /> (princ)<br /> )<br /> <br /> ;;打开文件<br /> (defun c:oui_Form1_TextButton2_OnClicked (/)<br /> (if (nth xxxccc filename-list)<br />   (dcl_MessageBox (strcat "当前选择文件: " (nth xxxccc filename-list)) "提示" 2 2)<br />   (dcl_MessageBox "当前未选择文件" "提示" 2 2)<br /> )<br /> )<br /> <br /> ;;按下鼠标<br /> (defun c:oui_Form1_PictureBox1_OnMouseDown (Button Flags X Y /)<br />   (setq xxxx x yyyy y)<br /> )<br /> (defun c:oui_Form1_PictureBox1_OnClicked (/)<br /> (setq xxxccc (display_movepic  xxxx yyyy 101 0 0)<br />        select-ed (not select-ed))<br /> )<br /> <br /> <br /> <br /> ;;单击浏览文件夹<br /> (defun c:oui_Form1_TextButton3_OnClicked (/ ss fLt1 fLt2)<br /> (setq ss (dcl_SelectFolder "选择文件夹"))<br /> (if ss (progn (dcl_Control_SetText oui_Form1_TextBox2 ss)<br />    (setq fLt1(vl-directory-files ss "*.dwg")<br />          fLt2(vl-directory-files ss "*.txt")<br />          filename-list (append fLt1 fLt2)<br />          filename-path ss)<br />    (dcl_PictureBox_Clear oui_Form1_PictureBox1)<br />    (display_picture filename-list)<br /> ))<br /> )<br /> <br /> ;;功能: 显示或位移一个新的图片<br /> ;;参数: x y 图片的坐标  i 图片编号  dx dy 图片位移量<br /> ;;返回: 鼠标所在图片的序号，没有选择则为 nil<br /> (defun display_movepic(x y i dx dy / FL TL Lt Lxy n)<br />   (setq n (length filename-list))<br />   (display_picture filename-list)<br />   (setq Lt (Crect_tang n x y))<br />   (if (car Lt)(progn<br />       (setq Lxy (nth (car Lt) (cadr Lt))<br />          FL (list (+ dx (car(car Lxy)))(+ dy (cadr(car Lxy))) i)<br />          TL (list (car(car Lxy)) (+ (cadr (car Lxy)) icoHy 1) -3 20 (nth (car Lt) filename-list) 0))<br />       (dcl_PictureBox_PaintPicture oui_Form1_PictureBox1 (list FL))<br />       (dcl_PictureBox_DrawText oui_Form1_PictureBox1 (list TL))<br />   )) (car Lt)<br /> )<br /> <br /> ;;功能: 传入文件列表，显示图片及文件名<br /> ;;参数: <Lt> 文件名称列表<br /> ;;无返回值<br /> (defun display_picture(Lt / m n xy)<br />    (setq Ln (length Lt) n 0 <br />          fLLxy '() tLLxy '())<br />    (setq feLt (cadr (Crect_tang Ln nil nil)))<br />    (if (> Ln (* nMay nMax))(setq Ln (* nMay nMax))) ;;满屏显示<br />    (repeat Ln<br />      (setq tem (nth n feLt)<br />             fLLxy (cons (append (car tem) '(100)) fLLxy)<br />             tLLxy (cons (list (car(car tem)) (+ (cadr (car tem)) icoHy 1) -19 20 (nth n Lt) 0 nil) tLLxy)<br />             n (1+ n))<br />    )<br />    (dcl_PictureBox_PaintPicture oui_Form1_PictureBox1 fLLxy)<br />    (dcl_PictureBox_DrawText oui_Form1_PictureBox1 (reverse tLLxy))<br /> )<br /> <br /> ;;功能: 创建 cn 个矩形，并判断 x,y 是否在矩形阵列内，<br /> ;;返回: 如果 x,y 矩形中，返回 (m Tg)，Tg 为矩形阵列 m 为序列号<br /> ;;      x,y 不在矩形内或 x,y 为 nil 时返回 (nil Tg)<br /> (defun Crect_tang(cn x y / m n nm)<br /> (setq n 0 RTang '())<br /> (repeat nMay<br />     (setq nm (- cn (* n nMax))) ;;剩余填充数<br />     (if (>= nm nMax) (setq nm nMax))<br />     (setq m 0)<br />     (repeat nM<br />        (setq p1 (list (+ starWx (* m (+ icoWx distanceWx)))<br />                       (+ starHy (* n (+ icoHy distanceHy))))<br />              p2 (list (+ (car p1) icoWx) (+ (cadr p1) icoHy))<br />           RTang (cons (list p1 p2) RTang)<br />               m (1+ m))<br />     ) (setq n (1+ n))<br /> )(setq RTang (reverse RTang));;矩形表生成<br /> (setq n 0 nn nil)<br /> (if (and x y)<br /> (repeat (length RTang)<br />     (setq pt12 (nth n RTang)<br />            p1 (car pt12)<br />            p2 (cadr pt12)<br />            n (1+ n))<br />     (if (and (> x (car p1))(< x (car p2))(> y (cadr p1))(< y (cadr p2)))<br />        (setq nn (- n 1)))<br /> )) (list nn RTang)<br /> )<br /> (princ)

odcl控件感觉还是不足，像这个文件管理界面，勉强做出来，但效果实在不咋地

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:oui.odcl 
下载次数:17  文件大小:3.09 KB 
下载权限: 不限 以上  [免费赚D豆]

eachy

术有专攻，这些不是cad要做的，用其它软件更好，e.g acdsee ..

XDSoft

确实，OPENDCL本身也是有局限的，但是在ACAD下面提供的一种对话框设计的选择，还是挺丰富的，较原来的DCL比。当然我们也希望ODCL开发团队能提供更多，更方便的控件来。

phoevana

这也可以，前来学习，:)