Option Explicit
'Button数组枚举
Enum ButtonName
iHelp = 1
iCancel = 2
iBack = 3
iNext = 4
iFinish = 5
iOpen = 6
End Enum
Enum FrameName
WelCome = 0
SelectActiveX = 1
End Enum
Enum TextName
About = 0
ActiveXName = 1
ClearText = 2
End Enum
Private Declare Sub InitCommonControls Lib
"comctl32.dll"
()
Private Sub Form_Load()
Call InitCommonControls
Call ReadOnlyText(txt(About)) '只读文本框
fra(SelectActiveX).Left = fra(WelCome).Left
fra(SelectActiveX).Top = fra(WelCome).Top
End Sub
Private Sub cmd_Click(Index As Integer)
Select Case Index
Case iHelp
dlgOpenFile.HelpFile = App.Path &
"\FREEACTIVEX.HLP"
dlgOpenFile.HelpCommand = cdlHelpContents
dlgOpenFile.ShowHelp '调用帮助文件,Action = 6
Case iNext
cmd(iBack).Enabled = True
cmd(iFinish).Enabled = True
cmd(iNext).Enabled = False
fra(WelCome).Visible = False
fra(SelectActiveX).Visible = True
Case iBack
cmd(iBack).Enabled = False
cmd(iNext).Enabled = True
cmd(iFinish).Enabled = False
fra(SelectActiveX).Visible = False
fra(WelCome).Visible = True
Case iOpen
With dlgOpenFile
.FileName =
""
'清除上一次打开的文件
.DialogTitle =
"想打开哪一个文件呢?"
'设置对话框标题上显示的字
.Filter =
"All File|*.*|全部支持的类型|*.ocx;*.dll"
'给用户提供可以选择的文件类型,分号就是两种类型的文件的分隔符
.FilterIndex = 2 '指定缺省的过滤器 即*.exe
.ShowOpen '打开对话框,Action = 1
End With
txt(ActiveXName).Text = dlgOpenFile.FileName
Case iFinish
If Len(txt(ActiveXName).Text) = 0 Then
MsgBox
"你还未选择ActiveOcx控件!"
, vbCritical,
"错误"
ElseIf Len(txt(ClearText).Text) = 0 Then
MsgBox
"你还未输入要清除的标题!"
, vbCritical,
"错误"
Else
Call FindTitle
End If
Case iCancel
Unload Me
End Select
End Sub
Public Sub FindTitle()
Dim i As Long, j As Long
Dim abytFile() As Byte
Dim abytTitle() As Byte
Dim BakFileName As String
lblExplain(7).Caption =
"正在检索...."
Open txt(ActiveXName) For Binary As
ReDim abytFile(FileLen(txt(ActiveXName)))
Get
Close
abytTitle = txt(ClearText)
Do
If abytFile(i) = abytTitle(0) Then
For j = 1 To UBound(abytTitle)
If abytFile(i + j) <> abytTitle(j) Then Exit For
If j = UBound(abytTitle) Then Exit Do
Next
End If
i = i + 1
If i > UBound(abytFile) Then
MsgBox
"未搜索到对话框的标题,请重新选择ActiveX部件!"
, vbInformation,
"失败"
lblExplain(7).Caption =
""
Exit Sub
End If
Loop
BakFileName = Left$(txt(ActiveXName), Len(txt(ActiveXName)) - 4) &
".bak"
FileCopy txt(ActiveXName), BakFileName
Open txt(ActiveXName) For Binary As
Put
Close
lblExplain(7).Caption =
"正在清除...."
MsgBox
"清除ActiveX部件对话框成功!"
, vbInformation,
"成功"
lblExplain(7).Caption =
""
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmMain = Nothing
End Sub