标签： 编程

对象(Object)

对象代表应用程序中的元素，类似于汽车中的轮子、发动机等，抑或汽车本身。AutoCAD中有许多对象，例如：文档、模型空间、直线、图层、字典等。Excel中也有许多对象，例如：工作簿、工作表、单元格、图表、窗体，或是一份报告。程序中调用对象的任一方法或改变它的属性之前，必须先声明对象如，Dim oDraw As Object或Dim Workbooks As Object。

对象集合(Collection)

对象集合是一个包含几个相同性质的对象的集合。例如，在AutoCAD中的Documents 对象包含了所有已打开的Document（文档）对象，这当然指多文档环境(MDI)。在Excel中的Workbooks 对象包含了所有已打开的Workbook（工作簿）对象，Worksheets对象集合包含了某个工作簿中的所有工作表Worksheet。

集合中的项目可以通过索引号或名称来做识别。例如，Documents(1) 指的是索引号是1的文档对象。Workbooks(1) 指的是索引号是1的工作簿对象。需要注意的是AutoDesk是从0开始，而MicroSoft则是从1开始。

父对象与子对象(Parent Object And Subobject)

汽车可以包含轮子和发动机，这就是典型的父对象与子对象。

在AutoCAD中，文档对象可以包含直线对象、圆弧对象等。在Excel中，Worksheet对象可以包含单元格对象和图表对象等。

方法(Method)

方法指的是对象能执行的动作。例如，Add是下拉列表控件ComboBox对象的一个方法，因为它会增加一个新项目到下拉式列表框中。

下面的程序调用 Add 方法，增加一个新的项目到下拉列表控件“Combo1”项目中。

Sub AddEntry(newEntry as String) ‘ newEntry作为过程的参数被传入过程AddEntry

Combo1.Add newEntry ‘ newEntry作为一个项目增加到下拉列表框中

End Sub

某文档oDraw另存为AutoCAD 2000版，SaveAs就是文档的一个方法。oDraw.SaveAs sFullName, 12 ‘ac2000_dwg = 12, AutoCAD 2000 DWG (*.dwg)

如果对象共享共同的方法，则可以操作整个对象集合。例如，下列的过程会预览本工作簿所有的工作表。oWorkbook.Worksheets.PrintPreview

事件(Event)

事件是一个对象可以识别的动作，像单击鼠标或按某键等，在系统捕捉到对象的事件后，执行该事件对应的程序代码，从而实现相应控制。

不同的对象具有不同的事件。例如，文档拥有的事件：Activate、Deactivate、ObjectModified、Save等。工作簿拥有的事件：Open、Activate、BeforeClose、BeforePrint、BeforeSave、NewSheet、SheetChange等，工作表拥有的事件：SelectionChange、Change、Activate等。

在事件模块中写入需要的代码，当对象可识别的事件发生时，这些代码将被执行。

简要示例如下：

Private Sub oWorkbook_Open()

MsgBox “您打开了当前的工作簿！”

End Sub

属性(Property)

一个对象的属性定义了对象的特征，诸如大小、颜色或屏幕位置，或某一方面的行为，诸如对象是否激活或是否可见。可以通过修改对象的属性值来改变对象的特性。

若要设置属性值，则在对象的引用后面加上一个表达式，它是由属性名加上等号（＝） 以及属性值所组成的。

例如，oDraw(0).Name = “test11″设置了0号文档名为test11。下面的语句设置“test”工作表的名称而改变工作表的标签名称。oWorkbook.Worksheets(“test”).Name = “test11”

有些属性并不能设置，只能读取。通过检索每属性的帮助主题，可以看到是否可以设置此属性（读与写），或只能读取此属性（只读），还是只能写入此属性（只写）。

可以通过属性的返回值，来检索对象的信息。

Debug.Print oDraw(0).FullName

‘绑定 AutoCAD
Dim I As Integer, J As Integer
Dim oAutoCAD As Object
Call BindAutoCAD(True)

‘打开并绑定文件 D:/Test.dwg
Dim oDraw As Object ‘AutoCAD 多文档之一
Set oDraw = oAutoCAD.Application.Documents.Open(“D:/Test.dwg”)

‘spline 起止点切向
Dim StartTan(0 To 2) As Double
Dim EndTan(0 To 2) As Double
StartTan(0) = 0#
StartTan(1) = 0#
StartTan(2) = 0#
EndTan(0) = 0#
EndTan(1) = 0#
EndTan(2) = 0#
‘FitPoints 赋值
ReDim FitPoints(0 To 14) As Double ‘5 个拟合点
FitPoints(0) = 1
FitPoints(1) = 2
FitPoints(2) = 0
FitPoints(3) = 4
FitPoints(4) = 5
FitPoints(5) = 0
FitPoints(6) = 7
FitPoints(7) = 8
FitPoints(8) = 0
FitPoints(9) = 12
FitPoints(10) = 2
FitPoints(11) = 0
FitPoints(12) = 19
FitPoints(13) = -4
FitPoints(14) = 0
‘creates a spline Object in model space
Set oSpline = oDraw.ModelSpace.AddSpline(FitPoints, StartTan, EndTan)
oSpline.Color = 1 ‘Red

‘ 利用初始化文件读写信息
lRet = WriteIniFile(“General”, “Name”, “wyrcad”, “D:\Test.ini”)
lRet = WriteIniFile(“General”, “Age”, “36”, “D:\Test.ini”)
sRet = ReadIniFile(“General”, “Name”, “D:\Test.ini”)
Debug.Print sRet
sRet = ReadIniFile(“General”, “Age”, “D:\Test.ini”)
Debug.Print sRet

‘ 利用注册表读写信息
Call SaveString(HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Name”, “wyrcad”, “General”, “D:\Test.ini”)
Call SaveString(HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Age”, “36”, “General”, “D:\Test.ini”)
sRet = GetString(HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Name”, “General”, “D:\Test.ini”)
Debug.Print sRet
sRet = GetString(HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Age”, “General”, “D:\Test.ini”)
Debug.Print sRet

‘ 删除注册表或初始化文件信息
DelSetting HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Name”, “General”, “D:\Test.ini”
DelSetting HKEY_CURRENT_USER, “Software\Yager\WCAD”, “Age”, “General”, “D:\Test.ini”

Public Function GetExeVersion(ByVal sFullName As String) As String ‘获取可执行文件版本号
Dim FSO As Object
GetExeVersion = “”
If Not FileExist(sFullName) Then Exit Function
Set FSO = CreateObject(“Scripting.FileSystemObject”)
GetExeVersion = FSO.GetFileVersion(sFullName)
Set FSO = Nothing
End Function

Public Function GetExeInfo(ByVal sFullName As String) As String ‘获取可执行文件的信息
Dim FSO As Object
GetExeInfo = “”
If Not FileExist(sFullName) Then Exit Function
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim oFile As Object
Set oFile = FSO.GetFile(sFullName)
GetExeInfo = oFile.Size ‘Type/Attributes/Name/Path .etc
Set FSO = Nothing
End Function

Public Function GetWindows() As String ‘获取 Windows
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
GetWindows = FSO.GetSpecialFolder(0)
Set FSO = Nothing
End Function

Public Function GetSystem() As String ‘获取 System
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
GetSystem = FSO.GetSpecialFolder(1)
Set FSO = Nothing
End Function

Public Function GetTemporary() As String ‘获取 Temporary
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
GetTemporary = FSO.GetSpecialFolder(2)
Set FSO = Nothing
End Function

Public Function GetFileList(ByVal sFolder As String) As String ‘获取文件夹本级内所有文件
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim oFolder As Object, oItem As Object, oCollection As Object
Dim sList As String
If FSO.FolderExists(sFolder) Then
Set oFolder = FSO.GetFolder(sFolder)
Set oCollection = oFolder.Files
‘Debug.Print oCollection.Count
For Each oItem In oCollection
sList = sList & oItem.Name
sList = sList & “|”
Next
GetFileList = sList
Else
GetFileList = “”
End If
Set FSO = Nothing
End Function

Public Function GetFolderList(ByVal sFolder As String) As String ‘获取文件夹下一级所有子文件夹
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim oFolder As Object, oItem As Object, oCollection As Object
Dim sList As String
If FSO.FolderExists(sFolder) Then
Set oFolder = FSO.GetFolder(sFolder)
Set oCollection = oFolder.SubFolders
‘Debug.Print oCollection.Count
For Each oItem In oCollection
sList = sList & oItem.Name
sList = sList & “|”
Next
GetFolderList = sList
Else
GetFolderList = “”
End If
Set FSO = Nothing
End Function

Public Function GetDrivesList() As String
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim oItem As Object, oCollection As Object
Dim sList As String
Set oCollection = FSO.Drives
For Each oItem In oCollection
‘Debug.Print oItem.SerialNumber
sList = sList & oItem.DriveLetter
sList = sList & “|”
Next
GetDrivesList = sList
Set FSO = Nothing
End Function

Option Explicit
‘注册表操作
Public Declare Function RegCloseKey Lib “advapi32.dll” (ByVal hkey As Long) As Long
Private Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA” (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKey Lib “advapi32.dll” Alias “RegOpenKeyA” (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib “advapi32.dll” Alias “RegQueryValueExA” (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib “advapi32.dll” Alias “RegSetValueExA” (ByVal hkey&, ByVal lpValueName$, ByVal Reserved&, ByVal dwType&, ByVal lpData$, ByVal cbData&) As Long
Private Declare Function RegSetValue Lib “advapi32.dll” Alias “RegSetValueA” (ByVal hkey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegDeleteValue Lib “advapi32.dll” Alias “RegDeleteValueA” (ByVal hkey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegOpenKeyEx Lib “advapi32” Alias “RegOpenKeyExA” (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Public Declare Function RegCreateKeyEx Lib “advapi32.dll” Alias “RegCreateKeyExA” (ByVal hkey&, ByVal lpSubKey$, ByVal Reserved&, ByVal lpClass$, ByVal dwOptions&, ByVal samDesired&, ByVal SecAtts&, phkResult&, lpdwDisp&) As Long
Private Declare Function RegDeleteKey Lib “advapi32.dll” Alias “RegDeleteKeyA” (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Public Declare Function SHDeleteKey Lib “shlwapi.dll” Alias “SHDeleteKeyA” (ByVal hkey As Long, ByVal pszSubKey As String) As Long

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const KEY_ALL_ACCESS = (&H1F0000 Or &H1 Or &H2 Or &H4 Or &H8 Or &H10 Or &H20) And (Not &H100000)
Public Const REG_NONE = (0)
Public Const REG_SZ = (1) ‘REG_SZ ——键值存储为字符串值
Public Const REG_EXPAND_SZ = (2)
Public Const REG_BINARY = (3) ‘REG_BINARY ——键值存储为二进制值
Public Const REG_DWORD = (4) ‘REG_DWORD ——键值存储为DWORD值（双字）
Public Const REG_DWORD_BIG_ENDIAN = (5)
Public Const REG_LINK = (6)
Public Const REG_MULTI_SZ = (7)
Public Const REG_RESOURCE_LIST = (8)
Public Const REG_FULL_RESOURCE_DESCRIPTOR = (9)
Public Const REG_RESOURCE_REQUIREMENTS_LIST = (10)

Function RegQueryStringValue(ByVal hkey As Long, ByVal sValueName As String) As String
On Error Resume Next
Dim lResult As Long, lValueType As Long, sBuf As String, lDataBufSize As Long
‘retrieve nformation about the key
lResult = RegQueryValueEx(hkey, sValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
‘Create a buffer
sBuf = String(lDataBufSize, Chr$(0))
‘retrieve the key’s content
lResult = RegQueryValueEx(hkey, sValueName, 0, 0, ByVal sBuf, lDataBufSize)
If lResult = 0 Then
‘Remove the unnecessary chr$(0)’s
‘RegQueryStringValue = Left$(sBuf, InStr(1, sBuf, Chr$(0)) – 1)
‘Avoid making mistakes when chr$(0) is zero
RegQueryStringValue = GetAPIString(sBuf)
End If
ElseIf lValueType = REG_BINARY Then
Dim sData As Integer
‘retrieve the key’s value
lResult = RegQueryValueEx(hkey, sValueName, 0, 0, sData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = sData
End If
End If
End If
On Error GoTo 0
End Function

Function GetString(ByVal hkey As Long, sPath As String, ByVal sValue As String, ByVal sApp As Variant, ByVal sIniFile As Variant) ‘从注册表读取数据, 如果失败则从初始化文件读取
On Error Resume Next
Dim lResult1, lResult2
‘Open the key
lResult1 = RegOpenKey(hkey, sPath, lRet)
‘Get the key’s content
lResult2 = RegQueryStringValue(lRet, sValue)
GetString = lResult2
‘Close the key
RegCloseKey lRet
On Error GoTo 0
‘OS is diversity, determine if registry success
If IsMissing(sApp) Then Exit Function
If IsMissing(sIniFile) Then Exit Function
If lResult1 = 0 And Len(lResult2) > 0 And Not ChineseExist(lResult2) Then Exit Function ‘含汉字字符串时不一定对
On Error Resume Next
‘Read ini file, when operating Registry is fail.
GetString = ReadIniFile(sApp, sValue, sIniFile)
On Error GoTo 0
End Function

Sub SaveString(ByVal hkey As Long, ByVal sPath As String, ByVal sValue As String, ByVal sData As String, ByVal sApp As Variant, ByVal sIniFile As Variant) ‘向注册表写入数据, 如果失败则向初始化文件写入
On Error Resume Next
Dim lResult1, lResult2
‘Create a new key
lResult1 = RegCreateKey(hkey, sPath, lRet)
‘Save a string to the key
lResult2 = RegSetValueEx(lRet, sValue, 0, REG_SZ, ByVal sData, Len(sData))
‘close the key
RegCloseKey lRet
On Error GoTo 0
‘Debug.Print lResult1
‘Debug.Print lResult2
‘OS is diversity, determine if registry success
If IsMissing(sApp) Then Exit Function
If IsMissing(sIniFile) Then Exit Function
If lResult1 = 0 And lResult2 = 0 And Not ChineseExist(sData) Then Exit Sub ‘含汉字字符串时结果有问题
On Error Resume Next
‘Write ini file, when operating Registry is fail.
WriteIniFile sApp, sValue, sData, sIniFile
‘WritePrivateProfileString sApp, sValue, sData, sIniFile
On Error GoTo 0
End Sub

Sub DelSetting(ByVal hkey As Long, ByVal sPath As String, ByVal sValue As String, ByVal sApp As Variant, ByVal sIniFile As Variant) ‘删除注册表数据, 如果失败则删除初始化文件数据
On Error Resume Next
‘Debug.Print hKey
‘Debug.Print sPath
‘Debug.Print sValue
Dim lResult1, lResult2
‘Create a new key
lResult1 = RegCreateKey(hkey, sPath, lRet)
‘Delete the key’s value
lResult2 = RegDeleteValue(lRet, sValue)
‘close the key
RegCloseKey lRet
On Error GoTo 0
‘Debug.Print lResult1
‘Debug.Print lResult2
‘OS is diversity, determine if registry success
If IsMissing(sApp) Then Exit Function
If IsMissing(sIniFile) Then Exit Function
If lResult1 = 0 And hkey = HKEY_LOCAL_MACHINE Then Exit Sub ‘lResult2 = 2 or 5 含汉字字符串时须两处删除
On Error Resume Next
‘Write ini file, when operating Registry is fail.
WriteIniFile sApp, sValue, vbNullString, sIniFile
‘WritePrivateProfileString sApp, sValue, vbNullString, sIniFile
On Error GoTo 0
End Sub

Public Sub DelKey(hkey As Long, sKey As String)
‘Delete the key
lRet = RegDeleteKey(hkey, sKey)
End Sub