回望南山
记忆痕迹可以鲜明, 回望往事如数家珍——
posts - 177,  comments - 54,  trackbacks - 0

Right, are you ready to create your own file list box? OK here we go. First I'll give you a wee peek at what our dialog will look like :

AfraLisp File Dialog 

Looks good hey!
To run this function you must pass it two arguments :

  • A string containing a directory path.

  • A list of file types.

Syntax : (fileselect [directory file_ types])

Example : (fileselect "d:/drawings" '("*.dwg" "*.lsp" "*.dvb"))

Return : A list of selected files.

Oh, by the way, you CAN select multiple files.


The first thing we need to do is write a bit of DCL to create our File Dialog. Copy and paste this into Notepad and save it as "AfraFiles.dcl". 

    FILES : dialog {
            label="AfraLisp File Dialog";
            : text {
            key="CDIR";
            }
            : row {
            : list_box {
            key="DIR";
            label="Select Directory :";
            width=25;
            fixed_width_font = true;
            }
            : list_box {
            key="FIL";
            label="Select Files :";
            width = 30;
            tabs = "20 31 40";
            multiple_select = true;
            fixed_width_font = true;
            }
            }
            : row {
            : text {
            key="DIRS";
            }
            : text {
            key="FILS";
            }
            }
            : popup_list {
            key="EXT";
            label="Select File Type :";
            fixed_width_font = true;
            }
            ok_cancel;
            } 

And now the AutoLISP Coding. Save this as AfraFile.lsp :

 
;CODING STARTS HERE
;;Syntax : (fileselect "d:/drawings" '("*.dwg" "*.lsp" "*.dvb"))


(defun FileSelect (Dir Pat)
(setq DH (load_dialog "afrafiles"))
  (if (and DH (new_dialog "FILES" DH))
    (progn
      (setq iExt 0)
      (Refresh_Display)
      (start_list "EXT")
      (mapcar 'add_list Pat)
      (end_list)
      ;
      (action_tile "DIR" "(new_dir $value)")
      (action_tile "EXT" "(new_mask $value)")
      (action_tile "FIL" "(picked $value)")
      ;
      (if (= (start_dialog) 0)
(setq File_List nil)
      )
      (unload_dialog DH)
    )
  )
  File_List
)
;------------------------------------------------
(defun Refresh_Display ()
  (start_list "FIL")
  (end_list)
  (set_tile "CDIR" "Working...")
  (setq FL (VL-Directory-Files
             ;Dir Pat 1)
             Dir (nth iExt Pat) 1)
DR (VL-Directory-Files
     Dir nil -1)
FL (VL-Sort FL 'str_compare)
DR (VL-Sort DR 'str_compare)
)
  (start_list "DIR")
  (mapcar 'add_list DR)
  (end_list)
  (start_list "FIL")
  (if Show_the_details
    (mapcar
      '(lambda (F)
(setq Dt (VL-File-SysTime
    (strcat Dir F))
       F1 (if Dt
    (strcat
      F
      "\t"
      (itoa_f (nth 1 Dt) 2)
      "/"
      (itoa_f (nth 3 Dt) 2)
      "/"
      (itoa_f (nth 0 Dt) 4)
      "\t"
      (itoa_f (nth 4 Dt) 2)
      ":"
      (itoa_f (nth 5 Dt) 2)
      ":"
      (itoa_f (nth 6 Dt) 2)
      )
    (strcat F "\t\t")
  )
       Sz (VL-File-Size (strcat Dir F))
       F1 (strcat
    F1
    "\t"
    (rtos Sz 2 0))
       )
     (add_list F1))
  FL)
    (mapcar 'add_list FL)
  )
  (end_list)
  (set_tile "DIRS"
    (strcat
      "Directories = "
      (itoa (length DR))))
  (set_tile "FILS"
    (strcat
      "Files = "
      (itoa (length FL))))
  (set_tile "CDIR" Dir)
  )

(defun New_Dir (Pth)
  (setq Pth (nth (atoi Pth) DR))
  (cond
    ((= Pth ".")
     nil
     )
    ((= Pth "..") ;;back up a directory
     ;;remove directory name up one
     (setq L (1- (strlen Dir))
   Dir (substr Dir 1 L)
   )
     (while (/= (substr Dir L 1) "/")
       (setq L (1- L)))
     (setq Dir (substr Dir 1 L))
    )
    ('T
     (setq Dir (strcat Dir Pth "/"))
     )
  )
  (Refresh_Display)
)
;------------------------------------------------
;; Call back function to handle new file mask
;; selection by the user.
;;

(defun New_Mask (II)
  (setq iExt (atoi II))
  (Refresh_Display)
)
;
;------------------------------------------------
;; Call back function for saving the selected
;; file list in the variable FILE_LIST.
;;

(defun Picked (val / V)
  (setq val (read (strcat "(" Val ")"))
File_List
(mapcar '(lambda (V)
    (strcat
      Dir
      (nth V FL)))
Val)
)
)
;;-----------------------------------------------
;; Convert integer to padded ASCII string 
;;

(defun Itoa_F (I Digs)
  (setq I (itoa I))
  (while (< (strlen I) Digs)
    (setq I (strcat "0" I)))
  I
  )
;;-----------------------------------------------
(defun Str_Compare (T1 T2)
  (< (strcase T1)
     (strcase T2)))

(princ)
;;-----------------------------------------------
;CODING ENDS HERE

I just like to thank Bill Kramer from whom I "stole" a lot of this coding from.
(Shush, don't say anything as he doesn't know yet!!!)


I can just hear you now. "But Kenny, why do we have to copy and paste the coding? Can't you give us a nice little Zip file to download like you normally do?"
Oh all right then, just click here. Now please stop whining!!!

     

posted on 2008-04-05 16:57 深藏记忆 阅读(203) 评论(0)  编辑  收藏 所属分类: 转载Vlisp

飘过是缘,相识最真

订阅到抓虾
google reader
gougou


点击这里给我发消息


<2008年4月>
303112345
6789101112
13141516171819
20212223242526
27282930123
45678910

常用链接

留言簿(5)

随笔分类

随笔档案

文章分类

文章档案

相册

收藏夹

八面来息

天天充电

同行者

积分与排名

  • 积分 - 58597
  • 排名 - 61

最新评论

阅读排行榜

评论排行榜