sdinote.bas

行业软件,该源代码为道路设计纵断面典型的计算程序,该程序界面友好,计算准确,值得借鉴

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

' 存储关于子窗体信息的用户定义类型
Type FormState
    Deleted As Integer
    Dirty As Integer
    Color As Long
End Type
Public strFilename As String
Public FState As FormState              ' 用户定义型数组
Public gFindString As String            ' 保存搜索文本
Public gFindCase As Integer             ' 区分大小写标志
Public gFindDirection As Integer        ' 搜索方向标志
Public gCurPos As Integer               ' 保存当前光标位置
Public gFirstTime As Integer            ' 起始位置
Public Const ThisApp = "MDINote"        ' 注册表 App 常量。
Public Const ThisKey = "Recent Files"   ' 注册表 Key 常量。





Sub EditCopyProc()
    ' 复制选定文本到剪贴板
    Clipboard.SetText frmSDI.txtNote.SelText
End Sub

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

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

Sub FileNew()
    Dim intResponse As Integer
    
    ' 如果文件已改变，则保存之
    If FState.Dirty = True Then
        intResponse = FileSave
        If intResponse = False Then Exit Sub
    End If
    ' 清除 textbox 并更新标题
    frmSDI.txtNote.Text = ""
    frmSDI.Caption = "SDI 记事本 - 无标题"
End Sub


Function FileSave() As Integer
    

    If frmSDI.Caption = "SDI 记事本 - 无标题" Then
        ' 文件尚未保存
        ' 得到文件名并调用保存过程，GetFileName
        strFilename = GetFileName(strFilename)
    Else
        ' 否则，窗体标题包含打开的文件名
        strFilename = Right(frmSDI.Caption, Len(frmSDI.Caption) - 10)   '译者修改， 原为 14
    End If
    ' 调用保存过程
    ' 如果 Filename = Empty，用户在“另存为”对话框中选择“取消”
    ' 否则，保存文件
    If strFilename <> "" Then
        SaveFileAs strFilename
        FileSave = True
    Else
        FileSave = False
    End If
    frmZdm.txtPrj.Text = strFilename
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 = frmSDI.txtNote.SelStart) Then
        intOffset = 1
    Else
        intOffset = 0
    End If

    ' 为起始位置读公有变量
    If gFirstTime Then intOffset = 0
    ' 给搜索起始位置赋值
    intStart = frmSDI.txtNote.SelStart + intOffset
        
    ' 如果不匹配大小写，将字符串转换成大写
    If gFindCase Then
        strFindString = gFindString
        strSourceString = frmSDI.txtNote.Text
    Else
        strFindString = UCase(gFindString)
        strSourceString = UCase(frmSDI.txtNote.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
        frmSDI.txtNote.SelStart = intPos - 1
        frmSDI.txtNote.SelLength = Len(strFindString)
    Else
        strMsg = "找不到 " & Chr(34) & gFindString & Chr(34)
        intResponse = MsgBox(strMsg, 0, App.Title)
    End If
    
    ' 重新设置公有变量
    gCurPos = frmSDI.txtNote.SelStart
    gFirstTime = False
End Sub

Sub GetRecentFiles()
    ' 本过程演示 GetAllSettings 函数的用法，它从 Windows 注册表中返回值的数组。
    ' 在这种情况下，注册表包含最近打开的文件列表。使用 SaveSetting 语句记下最近使用的文件名。
   ' 该语句在 WriteRecentFiles 过程中使用
    Dim i As Integer
    Dim varFiles As Variant ' 存储返回的数组的变量
    
    ' 用 GetAllSettings 语句从注册表中返回最近使用的文件。
    '  ThisApp 和 ThisKey是模块中定义的常数
   
    If GetSetting(ThisApp, ThisKey, "RecentFile1") = Empty Then Exit Sub
    
    varFiles = GetAllSettings(ThisApp, ThisKey)
    
    For i = 0 To UBound(varFiles, 1)
        frmSDI.mnuRecentFile(0).Visible = True
        frmSDI.mnuRecentFile(i + 1).Caption = varFiles(i, 1)
        frmSDI.mnuRecentFile(i + 1).Visible = True
    Next i
End Sub
Sub ResizeNote()
    ' 文本框充满窗体的内部区域
    If frmSDI.picToolbar.Visible Then
        frmSDI.txtNote.Height = frmSDI.ScaleHeight - frmSDI.picToolbar.Height
        frmSDI.txtNote.Width = frmSDI.ScaleWidth
        frmSDI.txtNote.Top = frmSDI.picToolbar.Height
    Else
        frmSDI.txtNote.Height = frmSDI.ScaleHeight
        frmSDI.txtNote.Width = frmSDI.ScaleWidth
        frmSDI.txtNote.Top = 0
    End If
End Sub

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

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