7-2.bas

vb6.0编程实例详解,很详细的介绍,对学习VB有帮助

Attribute VB_Name = "Module1"
'*** MDI 记事本应用程序示例全局模块  ***
'***************************************
Option Explicit

' 存储关于子窗体信息的用户自定义类型。
Type FormState
    Deleted As Integer
    Dirty As Integer
    Color As Long
End Type

Public FState()  As FormState           ' 用户自定义型数组
Public Document() As New frmNotePad     ' 子窗体对象数组
Public gFindString As String            ' 保存搜索文本
Public gFindCase As Integer             ' 区分大小写标志
Public gFindDirection As Integer        ' 搜索方向标志
Public gCurPos As Integer               ' 保存当前光标位置
Public gFirstTime As Integer            ' 起始位置
Public gToolsHidden As Boolean          ' 保存工具栏状态
Public Const ThisApp = "MDINote"        ' ThisApp 常数
Public Const ThisKey = "Recent Files"   ' ThisKey 常数


Function AnyPadsLeft() As Integer
    Dim i As Integer        ' 计数器变量

    ' 遍历文档数组。
    ' 如果至少有一个打开的文档，返回 True。
    For i = 1 To UBound(Document)
        If Not FState(i).Deleted Then
            AnyPadsLeft = True
            Exit Function
        End If
    Next
End Function


Sub EditCopyProc()
    ' 复制选定文本到剪贴板。
    Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
End Sub

Sub EditCutProc()
    ' 复制选定文本到剪贴板。
    Clipboard.SetText frmMDI.ActiveForm.ActiveControl.SelText
    ' 删除选定文本。
    frmMDI.ActiveForm.ActiveControl.SelText = ""
End Sub

Sub EditPasteProc()
    ' 将文本从剪贴板粘贴到活动控件。
    frmMDI.ActiveForm.ActiveControl.SelText = Clipboard.GetText()
End Sub

Sub FileNew()
    Dim fIndex As Integer

    ' 找到下一个可用的索引并显示该子窗体。
    fIndex = FindFreeIndex()
    Document(fIndex).Tag = fIndex
    Document(fIndex).Caption = "无标题:" & fIndex
    Document(fIndex).Show

    ' 使工具栏中编辑按钮可见。
    frmMDI.imgCutButton.Visible = True
    frmMDI.imgCopyButton.Visible = True
    frmMDI.imgPasteButton.Visible = True
End Sub

Function FindFreeIndex() As Integer
    Dim i As Integer
    Dim ArrayCount As Integer

    ArrayCount = UBound(Document)

    ' 遍历文档数组
    ' 如果已删除其中一个文档，返回其索引。
    For i = 1 To ArrayCount
        If FState(i).Deleted Then
            FindFreeIndex = i
            FState(i).Deleted = False
            Exit Function
        End If
    Next

    ' 如果子窗体对象数组中的一个元素都没有删除，
    ' 文档数组与状态数组均加 1 并返回新元素的索引。

    ReDim Preserve Document(ArrayCount + 1)
    ReDim Preserve FState(ArrayCount + 1)
    FindFreeIndex = UBound(Document)
End Function

Sub FindIt()
    Dim intStart As Integer
    Dim intPos As Integer
    Dim strFindString As String
    Dim strSourceString As String
    Dim strMsg As String
    Dim intResponse As Integer
    Dim intOffset As Integer
    
    ' 根据当前光标位置设置偏移量变量。
    If (gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart) Then
        intOffset = 1
    Else
        intOffset = 0
    End If

    ' 为起始位置读全局变量。
    If gFirstTime Then intOffset = 0
    ' 给搜索起始位置赋值。
    intStart = frmMDI.ActiveForm.ActiveControl.SelStart + intOffset
        
    ' 如果不匹配大小写，将字符串转换成大写。
    If gFindCase Then
        strFindString = gFindString
        strSourceString = frmMDI.ActiveForm.ActiveControl.Text
    Else
        strFindString = UCase(gFindString)
        strSourceString = UCase(frmMDI.ActiveForm.ActiveControl.Text)
    End If
            
    ' 搜索字符串。
    If gFindDirection = 1 Then
        intPos = InStr(intStart + 1, strSourceString, strFindString)
    Else
        For intPos = intStart - 1 To 0 Step -1
            If intPos = 0 Then Exit For
            If Mid(strSourceString, intPos, Len(strFindString)) = strFindString Then Exit For
        Next
    End If

    ' 如果找到了字符串...
    If intPos Then
        frmMDI.ActiveForm.ActiveControl.SelStart = intPos - 1
        frmMDI.ActiveForm.ActiveControl.SelLength = Len(strFindString)
    Else
        strMsg = "找不到 " & Chr(34) & gFindString & Chr(34)
        intResponse = MsgBox(strMsg, 0, App.Title)
    End If
    
    ' 重新设置全局变量
    gCurPos = frmMDI.ActiveForm.ActiveControl.SelStart
    gFirstTime = False
End Sub

Sub GetRecentFiles()
    ' 本过程演示 GetAllSettings 函数的用法，它从 Windows 注册表中返回值的数组。
    ' 在这种情况下，注册表包含最近打开的文件列表。
    ' 使用 SaveSetting 语句记下最近使用的文件名。
    ' 该语句在 WriteRecentFiles 过程中。
    Dim i, j As Integer
    Dim varFiles As Variant ' Varible to store the returned array.
    
    ' 用 GetAllSettings 语句从注册表中返回最近使用的文件。
    ' 模块中定义常数 ThisApp 和 ThisKey。
    If GetSetting(ThisApp, ThisKey, "RecentFile1") = Empty Then Exit Sub
    
    varFiles = GetAllSettings(ThisApp, ThisKey)
    
    frmMDI.mnuRecentFile(0).Visible = True '显示分割符
    
    For i = 0 To UBound(varFiles, 1)
        
        frmMDI.mnuRecentFile(i + 1).Caption = varFiles(i, 1)
        frmMDI.mnuRecentFile(i + 1).Visible = True
            ' 遍历所有文档并更新每个菜单。
            For j = 1 To UBound(Document)
                If Not FState(j).Deleted Then
                    Document(j).mnuRecentFile(0).Visible = True
                    Document(j).mnuRecentFile(i + 1).Caption = varFiles(i, 1)
                    Document(j).mnuRecentFile(i + 1).Visible = True
                End If
            Next j
    Next i

End Sub

Sub OptionsToolbarProc(CurrentForm As Form)
    ' 切换 Checked 属性。
    CurrentForm.mnuOptionsToolbar.Checked = Not CurrentForm.mnuOptionsToolbar.Checked
    ' 如果不是 MDI 窗体，设置 MDI 窗体的 Checked 属性。
    If Not TypeOf CurrentForm Is MDIForm Then
        frmMDI.mnuOptionsToolbar.Checked = CurrentForm.mnuOptionsToolbar.Checked
    End If
    ' 基于值切换工具栏。
    If CurrentForm.mnuOptionsToolbar.Checked Then
        frmMDI.picToolbar.Visible = True
    Else
        frmMDI.picToolbar.Visible = False
    End If
End Sub

Sub WriteRecentFiles(OpenFileName)
    ' 本过程使用 SaveSettings 语句将最近使用的文件名写入系统注册表。
    ' SaveSettings 语句要求三个参数其中两个存储为常数并在本模块内定义。
    ' GetRecentFiles 过程中使用 GetAllSettings 函数来检索在这个过程中存储的文件名。。
    
    Dim i, j As Integer
    Dim strFile, key As String

    ' 将文件 最近处理文件1 复制给 最近处理文件2，等等
    For i = 3 To 1 Step -1
        key = "最近处理文件" & i
        strFile = GetSetting(ThisApp, ThisKey, key)
        If strFile <> "" Then
            key = "最近处理文件" & (i + 1)
            SaveSetting ThisApp, ThisKey, key, strFile
        End If
    Next i
  
    ' 将正在打开的文件写到最近使用的文件列表的第一项。
    SaveSetting ThisApp, ThisKey, "RecentFile1", OpenFileName
End Sub