vlisp如何打开多重选择文件对话框

路边

hao

wangph

我用了(vl-registry-write "HKEY_CLASSES_ROOT\\LICENSES\\4d553650-6abe-11cf-8adb-00aa00c00905"
"" "gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj")并注册了RegSvr32 comdlg32.ocx，

(VLAX-CREATE-OBJECT "MSCOMDLG.COMMONDIALOG")还是成功不了，请高手指点如何做呢？龙大哥是怎么解决的呢？

狂刀无痕

d

wangph

这2个文件我电脑上是有的，并且我也注册了，(VLAX-CREATE-OBJECT "MSCOMDLG.COMMONDIALOG")还是成功不了。

wangph

当装过VB6后就可以了，请问龙斑主是如何解决的，你的程序加载后就能用。

wangph

我再顶，看有没有人能解决。

ayunger

;;; 修改依据: xiaomu 2005-10-12

;;;****************************************************************************
;;; No.5-3    Windows多文件选择(适用于CADR15以上) 函数                        
;;; 说明: 本函数使用MsComDlg.Commondialog对象(Comdlg.OCX)                     
;;; 调用: (ayGetMultFiles "多选文件" "图形文件(*.dwg)|*.dwg|所有(*.*)|*.*" "")
;;; 返回: ("C:\\DWG" "7b.dwg" "7c.dwg" "1.Dwg")                               
;;;****************************************************************************
(if (/= (vl-registry-read "HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905")
      "gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj")
   (vl-registry-write "HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905" ""
               "gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj")
);end_if
(defun ayGetMultFiles (strTitle strFilter strInitDir / Maxfiles Flags WinDlg mFiles Catchit)
  (vl-load-com)
  (setq WinDlg (vlax-create-object "MSComDlg.CommonDialog"))
 (if (not WinDlg)
  (progn;then
   (princ "\n【错误】系统中未安装通用控件Comdlg.OCX, 请安装后再运行!")
   (setq mFiles nil)
  );end_progn then
  
  (progn;else
   (setq Maxfiles 32767)
   (setq Flags (+ 4 512 524288 1048576 1024))
   (vlax-put-property WinDlg 'CancelError :vlax-true)
    (vlax-put-property WinDlg 'MaxFileSize Maxfiles)
    (vlax-put-property WinDlg 'Flags Flags)
    (vlax-put-property WinDlg 'DialogTitle strTitle)
    (vlax-put-property WinDlg 'Filter strFilter)
    (vlax-put-property WinDlg 'InitDir strInitDir)
   (setq Catchit nil)
   (setq Catchit (vl-catch-all-apply '(lambda ()
                     (vlax-invoke-method WinDlg 'ShowOpen)
                     (setq mFiles (vlax-get WinDlg 'Filename)))))
    (vlax-release-object WinDlg)
   (if (not (vl-catch-all-error-p Catchit));处理"取消"错误.
    (ayFSTR->LST mFiles)
    nil;else
   );end_if
  );end_progn
 );end_if
);end_defun

;;;************************************************
;;; No.5-3-1 处理Windows多文件选择返回值 函数     
;;; 说明: 将"C:\\DWG1\0001.dwg\0002.dwg" 处理成:  
;;;        ("C:\\DWG1" "1.dwg" "2.dwg") 表形式.   
;;;************************************************
(Defun ayFSTR->LST (xMFileStr / mFileList k)
 (if (= xMFileStr "")
   (setq mFileList nil);then
  (progn
   (if (vl-string-position (ascii "\000") xMFileStr)
     (progn
       (while (vl-string-position (ascii "\000") xMFileStr)
      (setq k (vl-string-position (ascii "\000") xMFileStr))
      (setq mFileList (append mFileList (list (substr xMFileStr 1 k))))
      (setq xMFileStr (substr xMFileStr (+ k 2) (- (strlen xMFileStr) k 1)))
       );end_while
       (setq mFileList (append mFileList (list (vl-string-left-trim "\\" xMFileStr))))
     );end_progn then
     (progn
       (setq mFileList (vl-filename-directory xMFileStr))
       (setq mFileList (list mFileList (vl-string-left-trim "\\" (vl-string-subst "" mFileList xMFileStr))))
     );end_progn else
   );end_if
   mFileList
  );end_progn
 );end_if
);end_defun

;| 参考依据: Ayungerstudio 动态库Ayunger.Dll for VB6.0 2003.10.16
'******************************************************************
'       打开文件，返回文件名。
'------------------------------------------------------------------
'   1.入口参数: ObjCommonDialog --- MS Common Dialog 打开文件控件。
'               FileFilter  --- 打开文件类型过滤字符串。
'   2.出口信息: 返回打开文件的文件名。若无打开文件，则返回空。
'******************************************************************
Public Function getOpenFileName(ByRef ObjCommonDialog As Object, _
                                Optional ByVal FileFilter As String = "纯文本文件(*.Txt)|*.Txt|所有文件(*.*)|*.*", _
                                Optional ByVal MsgTitle As String) As String
   
    On Error GoTo ErrOpenHandle:
   
    If MsgTitle = "" Then MsgTitle = "打开文档"
   
    With ObjCommonDialog
        .CancelError = True
        .DialogTitle = MsgTitle
        .FilterIndex = 1
        .Filter = FileFilter
        .FileName = ""
        .ShowOpen
        getOpenFileName = .FileName
    End With
   
    Exit Function
   
ErrOpenHandle:
    getOpenFileName = ""

End Function
|;

wangph

楼上的与xiaomu的差不多，ayFSTR->LST 函数是有问题的，当选择不在根目录下的单个文件时，返回值中文件名前多了“\\”。对于返回值的处理，龙龙仔班主有不同的处理方法，我试过了，比较好用，但他没有给出源码。

ayunger

非常感谢wangph楼主，已经修正了ayFSTR->LST 函数错误,同时改正和ayGetMultFiles函数!

【第 47 楼 文件已经重新更新 2208-11-07】

;;;************************************************
;;; No.5-3-1 处理Windows多文件选择返回值 函数     
;;; 说明: 将"C:\\DWG1\0001.dwg\0002.dwg" 处理成:  
;;;        ("C:\\DWG1" "1.dwg" "2.dwg") 表形式.   
;;;************************************************
(Defun ayFSTR->LST (xMFileStr / mFileList k)
 (if (= xMFileStr "")
   (setq mFileList nil);then
  (progn
   (if (vl-string-position (ascii "\000") xMFileStr)
     (progn
       (while (vl-string-position (ascii "\000") xMFileStr)
      (setq k (vl-string-position (ascii "\000") xMFileStr))
      (setq mFileList (append mFileList (list (substr xMFileStr 1 k))))
      (setq xMFileStr (substr xMFileStr (+ k 2) (- (strlen xMFileStr) k 1)))
       );end_while
       (setq mFileList (append mFileList (list (vl-string-left-trim "\\" xMFileStr))))
     );end_progn then
     (progn
       (setq mFileList (vl-filename-directory xMFileStr))
       (setq mFileList (list mFileList (vl-string-left-trim "\\" (vl-string-subst "" mFileList xMFileStr))))
     );end_progn else
   );end_if
   mFileList
  );end_progn
 );end_if
);end_defun

jxphklibin

非常好的函数，受益匪浅啊！！！