类模块基础

Private Declare Function mdlDialog_fileOpen Lib "stdmdlbltin.dll" (ByVal _

fileName As String, ByVal rFileH As Long, ByVal _

resourceId As Long, ByVal suggestedFileName As String, _

ByVal filterString As String, ByVal defaultDirectory As String, _

ByVal titleString As String) As Long

Private Declare Function mdlDialog_fileCreate Lib _

"stdmdlbltin.dll" (ByVal _

fileName As String, ByVal rFileH As Long, _

ByVal resourceId As Long, _

ByVal suggestedFileName As String, _

ByVal filterString As String, _

ByVal defaultDirectory As String, _

ByVal titleString As String) As Long

Private pFilePath As String

Private pFileName As String

Private pDefFilePath As String

Private pDefFileName As String

Private pFileNameSelected As String

Private pRetVal As Long

Private pFileExts() As String

Property Get SelectedPath() As String

SelectedPath = pFilePath

End Property

Property Get SelectedFile() As String

SelectedFile = pFileName

End Property

Property Get OpenSuccess() As Boolean

Select Case pRetVal

Case 1 ‘取消

OpenSuccess = False

Case 0 ‘打开

OpenSuccess = True

End Select

End Property

Sub OpenDialog()

Dim tmpFilter As String

pRetVal = 1

tmpFilter = "*." & Join(GetExts, "; *.")

pFileNameSelected = Space(255)

pRetVal = mdlDialog_fileOpen(pFileNameSelected, 0, 0, _

pDefFileName, tmpFilter, pDefFilePath, "Open File")

Select Case pRetVal

Case 1 ‘取消

Case 0 ‘打开

Dim tmpFile As String

Dim xSplit As Variant

tmpFile = Left(pFileNameSelected, InStr(1, _

pFileNameSelected, Chr(0)) - 1)

xSplit = Split(tmpFile, "\")

pFileName = xSplit(UBound(xSplit))

xSplit(UBound(xSplit)) = ""

pFilePath = Join(xSplit, "\")

End Select

End Sub

Property Get DefaultFile() As String

DefaultFile = pDefFileName

End Property

Property Let DefaultFile(strFilIn As String)

pDefFileName = strFileIn

End Property

Property Get DefaultPath() As String

DefaultPath = pDefFilePath

End Property

Property Let DefaultPath(strPathIN As String)

On Error GoTo errhnd

If Dir(strPathIN, vbDirectory) <> "" Then

pDefFilePath = strPathIN

End If

Exit Property

errhnd:

Select Case Err.Number

Case 52 ‘错误文件名或文件号

Err.Clear

End Select

End Property

Property Get ExtCount() As Long

ExtCount = UBound(pFileExts)

End Property

Property Get GetExts() As String()

If UBound(pFileExts) = 0 Then

Exit Property

End If

Dim tmpGetExts() As String

ReDim tmpGetExts(UBound(pFileExts) - 1) As String

Dim I As Long

For I = 1 To UBound(pFileExts)

tmpGetExts(I - 1) = pFileExts(I)

Next I

GetExts = tmpGetExts

End Property

Private Sub Class_Initialize()

ReDim pFileExts(0)

End Sub

Public Sub AddFileExt(FileExt As String)

Dim I As Long

Dim tmpFileExt As String

tmpFileExt = LCase(Replace(FileExt, ".", ""))

For I = 1 To UBound(pFileExts)

If tmpFileExt = pFileExts(I) Then

Exit Sub

End If

Next I

ReDim Preserve pFileExts(UBound(pFileExts) + 1)

pFileExts(UBound(pFileExts)) = tmpFileExt

End Sub

Sub CreateDialog()

Dim tmpFilter As String

pRetVal = 1

tmpFilter = "*." & Join(GetExts, "; *.")

pFileNameSelected = Space(255)

pRetVal = mdlDialog_fileCreate(pFileNameSelected, 0, 0, _

pDefFileName, tmpFilter, pDefFilePath, "Create File")

Select Case pRetVal

Case 1 ‘取消

Case 0 ‘打开

Dim tmpFile As String

Dim xSplit As Variant

tmpFile = Left(pFileNameSelected, InStr(1, _

pFileNameSelected, Chr(0) - 1))

xSplit = Split(tmpFile, "\")

pFileName = xSplit(UBound(xSplit))

xSplit(UBound(xSplit)) = ""

pFliePath = Join(xSplit, "\")

End Select

End Sub

Sub TestShowDialogA()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "dgn"

MyUSD.DefaultPath = "c:\"

MyUSD.DefaultFile = "temp.dgn"

MyUSD.OpenDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox MyUSD.SelectedPath & MyUSD.SelectedFile

End Select

End Sub

Sub TestShowDialogB()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "dgn"

MyUSD.AddFileExt "dwg"

MyUSD.AddFileExt "dxf"

MyUSD.DefaultFile = "c:\MicroStation VBA"

MyUSD.DefaultFile = "test.dgn"

MyUSD.OpenDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox MyUSD.SelectedPath & MyUSD.SelectedFile

End Select

End Sub

Sub TestShowDialogC()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "dgn"

MyUSD.DefaultFile = "c:\"

MyUSD.DefaultFile = "test.dgn"

MyUSD.CreateDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox MyUSD.SelectedPath & MyUSD.SelectedFile

End Select

End Sub

Sub TestShowDialogD()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "ILoveyou"

MyUSD.AddFileExt " LOVEYOU"

MyUSD.AddFileExt "Forever"

MyUSD.DefaultPath = "c:\MicroStation VBA"

MyUSD.DefaultFile = "test.dgn"

MyUSD.CreateDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox MyUSD.SelectedPath & MyUSD.SelectedFile

End Select

End Sub

Sub TestShowDialogE()

Dim MyUSD As New clsUSataionDialog

MyUSD.AddFileExt "loveyou"

MyUSD.DefaultPath = "c:\"

MyUSD.DefaultFile = "test.dgn"

MyUSD.OpenDialog

Select Case MyUSD.OpenSuccess

Case True

MsgBox "Open " & MyUSD.SelectedPath & _

MyUSD.SelectedFile

Case False

If MsgBox("Create a new file?", vbYesNo) = vbYes Then

MyUSD.CreateDialog

If MyUSD.OpenSuccess = True Then

MsgBox "Create" & MyUSD.SelectedPath & _

MyUSD.SelectedFile

End If

End If

End Select

End Sub