filedialog.bas

OpenPlayer代码

Attribute VB_Name = "FileDialog"
'==============================================
'这是显示文件对话框的模块,Copy来的
'==============================================
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ?1996-2000 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_FILEMUSTEXIST As Long = &H1000           '文件必须存在
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_LONGNAMES As Long = &H200000
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOREADONLYRETURN As Long = &H8000
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_READONLY As Long = &H1
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHAREWARN As Long = 0
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHOWHELP As Long = &H10
Public Const OFS_MAXPATHNAME As Long = 260

'OFS_FILE_OPEN_FLAGS and OFS_FILE_SAVE_FLAGS below
'are mine to save long statements; they're not
'a standard Win32 type.
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
             Or OFN_LONGNAMES _
             Or OFN_FILEMUSTEXIST _
             Or OFN_NODEREFERENCELINKS

Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
             Or OFN_LONGNAMES _
             Or OFN_OVERWRITEPROMPT _
             Or OFN_HIDEREADONLY

Public Type OPENFILENAME
  nStructSize       As Long
  hwndOwner         As Long
  hInstance         As Long
  sFilter           As String
  sCustomFilter     As String
  nMaxCustFilter    As Long
  nFilterIndex      As Long
  sFile             As String
  nMaxFile          As Long
  sFileTitle        As String
  nMaxTitle         As Long
  sInitialDir       As String
  sDialogTitle      As String
  flags             As Long
  nFileOffset       As Integer
  nFileExtension    As Integer
  sDefFileExt       As String
  nCustData         As Long
  fnHook            As Long
  sTemplateName     As String
End Type

Public OFN As OPENFILENAME

Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" _
   (pOpenfilename As OPENFILENAME) As Long

Public Declare Function GetSaveFileName Lib "comdlg32.dll" _
   Alias "GetSaveFileNameA" _
  (pOpenfilename As OPENFILENAME) As Long

'new additions to original code
'supporting the Hook method
Public Const WM_INITDIALOG = &H110
Private Const SW_SHOWNORMAL = 1

Public Function OFNHookProc(ByVal hwnd As Long, _
                            ByVal uMsg As Long, _
                            ByVal wParam As Long, _
                            ByVal lParam As Long) As Long
 

End Function
'--end block--'
   
 '==============================================
 '打开文件对话框,单选
 '用法:
 'Dim   FileName as String
 'FileName = ShowSaveDialog(Me, "程序文件(对*.exe的说明)", "*.exe", "选择文件(标题)...", "?", TextPath.Text)
 '返回选中的文件名,取消返回空值""
 '==============================================
 Function ShowOpenDialog(Owner As Object, FileType As String, Ext As String, Title As String, strInitDir As String, strInitFile As String) As String
     '文件类型
     '格式如下
     ' sFilters = "Visual Basic Forms" & vbNullChar & "*.frm" & vbNullChar & _
                 "Visual Basic Modules" & vbNullChar & "*.bas" & vbNullChar & _
                 "Visual Basic Projects" & vbNullChar & "*.vbp" & vbNullChar & _
                 "Text Files" & vbNullChar & "*.txt" & vbNullChar & _
                 "All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar
    
     '填充结构
    With OFN
        .nStructSize = Len(OFN)
        .hwndOwner = Owner.hwnd
        .sFilter = FileType & vbNullChar & Ext    ' "Flash Movie|*.swf,*.spl" & vbNullChar & "*.swf;*.spl"
        .nFilterIndex = 2
        
        If strInitFile = "" Then
          .sFile = "" & Space$(1024) & vbNullChar & vbNullChar
        Else
             .sFile = strInitFile
        End If
        
        .nMaxFile = Len(.sFile)
            
        .sDefFileExt = "swf" & vbNullChar & vbNullChar
        .sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
        .nMaxTitle = Len(OFN.sFileTitle)
        .sInitialDir = strInitDir
        
        .sDialogTitle = Title
        .flags = OFS_FILE_OPEN_FLAGS Or _
                         OFN_ENABLEHOOK
                        'or OFN_ALLOWMULTISELECT _  多选
                        'or OFN_EXPLORER
        ' .fnHook = FARPROC(AddressOf OFNHookProc)  '回调程序

   End With
   
   If GetOpenFileName(OFN) Then
        ShowOpenDialog = OFN.sFile
   Else
        ShowOpenDialog = ""
   End If
  
End Function

'==============================================
'保存文件对话框,单选
'用法:
'Dim   FileName as String
'Filename = ShowSaveDialog(Play, "Flash Movie", "*.swf", "保存文件...", "swf", Play.ShockwaveFlash1.Movie)
'返回选中的文件名,取消返回空值""
Function ShowSaveDialog(Owner As Object, FileType As String, Ext As String, Title As String, DefFileExt As String, strFile As String) As String

    '填充结构
    With OFN
         .nStructSize = Len(OFN)
         .hwndOwner = Owner.hwnd
         .sFilter = FileType & vbNullChar & Ext '"Flash Movie|*.swf,*.spl" & vbNullChar & "*.swf;*.spl"
         .nFilterIndex = 2
         .sFile = strFile & Space$(1024) & vbNullChar & vbNullChar
         .nMaxFile = Len(.sFile)
         .sDefFileExt = DefFileExt & vbNullChar & vbNullChar
         .sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
         .nMaxTitle = Len(OFN.sFileTitle)
        
         .sDialogTitle = Title
         .flags = OFS_FILE_SAVE_FLAGS Or _
                      OFN_ENABLEHOOK
                     'or OFN_ALLOWMULTISELECT _  多选
                     'or OFN_EXPLORER
        ' .fnHook = FARPROC(AddressOf OFNHookProc)
   End With
   
   If GetSaveFileName(OFN) Then
        ShowSaveDialog = OFN.sFile
   Else
        ShowSaveDialog = ""
   End If
End Function

'==============================================
'多选文件对话框,
'无返回值,直接添加到播放列表框中草药
'==============================================
Public Function getMulitSelectFiles(Owner As Object, FileType As String, Ext As String, Title As String) As Variant
     Dim pos As Long
     Dim buff As String
     Dim sLongname As String
     Dim strFileName As String
     Dim strBaseName As String
     Dim myCounter As Integer
     
    '填充结构
     With OFN
         .nStructSize = Len(OFN)
         .hwndOwner = Owner.hwnd
         .sFilter = FileType & vbNullChar & Ext
         .nFilterIndex = 2
         .sFile = "" & Space$(1024) & vbNullChar & vbNullChar
         .nMaxFile = Len(.sFile)
         .sDefFileExt = "bas" & vbNullChar & vbNullChar
         .sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
         .nMaxTitle = Len(OFN.sFileTitle)
        
         .sDialogTitle = Title
         .flags = OFS_FILE_OPEN_FLAGS Or _
                      OFN_ENABLEHOOK Or _
                      OFN_ALLOWMULTISELECT
                      ' OFN_EXPLORER Or
        ' .fnHook = FARPROC(AddressOf OFNHookProc)
    End With
    
   If GetOpenFileName(OFN) Then
      buff = Trim$(Left$(OFN.sFile, Len(OFN.sFile) - 2))
      Do While Len(buff) > 3
         myCounter = myCounter + 1
         If myCounter < 2 Then
             strBaseName = StripDelimitedItem(buff, vbNullChar)
         Else
           strFileName = StripDelimitedItem(buff, vbNullChar)
           ControlForm.List(0).AddItem "[" & ControlForm.List(0).ListCount + 1 & "]" & strFileName
           ControlForm.List(1).AddItem strBaseName & "\" & strFileName
         End If
      Loop
      If myCounter = 1 Then
         ControlForm.List(0).AddItem "[" & ControlForm.List(0).ListCount + 1 & "]" & Mid(strBaseName, InStrRev(strBaseName, "\") + 1)
         ControlForm.List(1).AddItem strBaseName
      End If
  End If
End Function

'不知道干嘛的:(
Private Function StripDelimitedItem(startStrg As String, delimiter As String) As String
  'take a string separated by nulls,
  'split off 1 item, and shorten the string
  'so the next item is ready for removal.
   Dim pos As Long
   
   pos = InStr(1, startStrg, delimiter)
   
   If pos Then
      StripDelimitedItem = Mid$(startStrg, 1, pos - 1)
      startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
   End If
   
End Function