類模塊基礎

附帶東野圭吾小說集（txt文件）http://pan.baidu.com/s/1slMSFxj

類模塊有多種用途，主要用於以下幾個方面：

1.封裝相似功能到單個對象中

2.建立帶有屬性、方法和事件的對象

3.特為自定義集合建立類模塊

封裝相似功能：

以一個名為clsUStationDialog的類開始。

使用這個類能做些什麼：

顯示打開MicroStation DGN文件的FileOpen對話框

顯示打開Microsoft Excel文件的FileOpen對話框

顯示打開ASCII.txt文件的FileOpen對話框

顯示打開用戶指定擴展名的FileOpen對話框

文件名需要的屬性

僅路徑需要的屬性

路徑/文件名需要的屬性

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

測試代碼1：

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

測試截圖：

測試代碼2：

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

測試截圖2：

測試代碼3：

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

測試截圖3：

測試代碼4：

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

測試截圖4：

測試代碼5：

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

測試截圖5：