frmsdi.frm

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

                ' 用户在另存为对话框中选择了取消; 否则,
                ' 保存此文件。
                If strFilename <> "" Then
                    SaveFileAs strFilename
                End If
            Case 7      ' 用户选择否。卸在此文件。
                Cancel = False
            Case 2      ' 用户选择取消。取消此卸载。
                Cancel = True
        End Select
    End If
End Sub

Private Sub Form_Resize()
    ' 调用重新调整尺寸过程
    ResizeNote
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' 调用最近文件列表过程。
    GetRecentFiles
End Sub

Private Sub imgCopyButton_Click()
    ' 刷新图像。
    imgCopyButton.Refresh
    ' 调用复制过程。
    EditCopyProc
End Sub

Private Sub imgCopyButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向下状态的图片。
    imgCopyButton.Picture = imgCopyButtonDn.Picture
End Sub

Private Sub imgCopyButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 如果按钮被按下，当鼠标拖离按钮区域时
    ' 显示向上位图; 否则
    ' 显示向下位图。
    Select Case Button
    Case 1
        If X <= 0 Or X > imgCopyButton.Width Or Y < 0 Or Y > imgCopyButton.Height Then
            imgCopyButton.Picture = imgCopyButtonUp.Picture
        Else
            imgCopyButton.Picture = imgCopyButtonDn.Picture
        End If
    End Select
End Sub

Private Sub imgCopyButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向上状态的图片。
    imgCopyButton.Picture = imgCopyButtonUp.Picture
End Sub

Private Sub imgCutButton_Click()
    ' 刷新图像。
    imgCutButton.Refresh
    ' 调用剪切过程。
    EditCutProc
End Sub

Private Sub imgCutButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向下状态的图片。
    imgCutButton.Picture = imgCutButtonDn.Picture
End Sub

Private Sub imgCutButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 如果按钮被按下，当鼠标拖离按钮区域时
    ' 显示向上位图; 否则
    ' 显示向下位图。
    Select Case Button
    Case 1
        If X <= 0 Or X > imgCutButton.Width Or Y < 0 Or Y > imgCutButton.Height Then
            imgCutButton.Picture = imgCutButtonUp.Picture
        Else
            imgCutButton.Picture = imgCutButtonDn.Picture
        End If
    End Select
End Sub

Private Sub imgCutButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向上状态的图片。
    imgCutButton.Picture = imgCutButtonUp.Picture
End Sub

Private Sub imgFileNewButton_Click()
    ' 刷新图像。
    imgFileNewButton.Refresh
    ' 调用新建文件过程。
    FileNew
End Sub

Private Sub imgFileNewButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向下状态的图片。
    imgFileNewButton.Picture = imgFileNewButtonDn.Picture
End Sub

Private Sub imgFileNewButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 如果按钮被按下，当鼠标拖离按钮区域时
    ' 显示向上位图; 否则
    ' 显示向下位图。
    Select Case Button
    Case 1
        If X <= 0 Or X > imgFileNewButton.Width Or Y < 0 Or Y > imgFileNewButton.Height Then
            imgFileNewButton.Picture = imgFileNewButtonUp.Picture
        Else
            imgFileNewButton.Picture = imgFileNewButtonDn.Picture
        End If
    End Select
End Sub

Private Sub imgFileNewButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向上状态的图片。
    imgFileNewButton.Picture = imgFileNewButtonUp.Picture
End Sub

Private Sub imgFileOpenButton_Click()
    ' 刷新图像。
    imgFileOpenButton.Refresh
    ' 调用文件打开过程。
    FileOpenProc
    frmZdm.cmdFresh.Enabled = True
End Sub

Private Sub imgFileOpenButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向下状态的图片。
    imgFileOpenButton.Picture = imgFileOpenButtonDn.Picture
End Sub

Private Sub imgFileOpenButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 如果按钮被按下，当鼠标拖离按钮区域时
    ' 显示向上位图; 否则
    ' 显示向下位图。
    Select Case Button
    Case 1
        If X <= 0 Or X > imgFileOpenButton.Width Or Y < 0 Or Y > imgFileOpenButton.Height Then
            imgFileOpenButton.Picture = imgFileOpenButtonUp.Picture
        Else
            imgFileOpenButton.Picture = imgFileOpenButtonDn.Picture
        End If
    End Select
End Sub

Private Sub imgFileOpenButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向上状态的图片。
    imgFileOpenButton.Picture = imgFileOpenButtonUp.Picture

End Sub

Private Sub imgPasteButton_Click()
    ' 刷新图像。
    imgPasteButton.Refresh
    ' 调用粘贴过程。
    EditPasteProc
End Sub

Private Sub imgPasteButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向下状态的图片。
    imgPasteButton.Picture = imgPasteButtonDn.Picture
End Sub

Private Sub imgPasteButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 如果按钮被按下，当鼠标拖离按钮区域时
    ' 显示向上的位图; 否则
    ' 显示向下的位图。
    Select Case Button
    Case 1
        If X <= 0 Or X > imgPasteButton.Width Or Y < 0 Or Y > imgPasteButton.Height Then
            imgPasteButton.Picture = imgPasteButtonUp.Picture
        Else
            imgPasteButton.Picture = imgPasteButtonDn.Picture
        End If
    End Select
End Sub

Private Sub imgPasteButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' 显示向上状态的图片。
    imgPasteButton.Picture = imgPasteButtonUp.Picture
End Sub

Private Sub mnuEditCopy_Click()
    ' 调用复制过程。
    EditCopyProc
End Sub

Private Sub mnuEditCut_Click()
    ' 调用剪切过程
    EditCutProc
End Sub

Private Sub mnuEditDelete_Click()
' 如果鼠标指针不存在于记事本的结尾处...
    If txtNote.SelStart <> Len(Screen.ActiveControl.Text) Then
        ' 如果没有进行选择, 将选项加一。
        If txtNote.SelLength = 0 Then
            txtNote.SelLength = 1
            ' 如果鼠标指针在一个空的直线上，将选相加二。
            If Asc(txtNote.SelText) = 13 Then
                txtNote.SelLength = 2
            End If
        End If
        ' 删除选定的文本
        txtNote.SelText = ""
    End If
End Sub

Private Sub mnuEditPaste_Click()
    ' 调用粘贴过程。
    EditPasteProc
End Sub

Private Sub mnuEditSelectAll_Click()
    ' 使用 SelStart & SelLength 来选择文本。
    txtNote.SelStart = 0
    txtNote.SelLength = Len(txtNote.Text)
End Sub

Private Sub mnuEditTime_Click()
    ' 插入当前的时间和日期。
    txtNote.SelText = Now
End Sub

Private Sub mnuFileExit_Click()
    ' 结束应用程序。
    Unload Me
End Sub

Public Sub mnuFileNew_Click()
    ' 调用新建窗体过程。
    FileNew
End Sub

Private Sub mnuFileOpen_Click()
    ' 调用文件打开过程。
    FileOpenProc
End Sub

Private Sub mnuFileSave_Click()
    '调用文件保存过程。
    FileSave
    frmZdm.cmdFresh.Enabled = True
End Sub

Private Sub mnuFileSaveAs_Click()
    Dim strSaveFileName As String
    Dim strDefaultName As String
    
    ' 指派窗体表提到变量。
    strDefaultName = Right$(Me.Caption, Len(Me.Caption) - 14)
    If Me.Caption = "SDI 记事本 - 无标题" Then
        ' 文件还没有被保存。
        ' 获得文件名称，并且调用保存过程， strSaveFileName。
        
        strSaveFileName = GetFileName("Untitled.txt")
        If strSaveFileName <> "" Then SaveFileAs (strSaveFileName)
        ' 更新文件菜单控件数组中的最近打开文件列表。
        UpdateFileMenu (strSaveFileName)
    Else
        ' 窗体的标题包含打开的文件名称。
        strSaveFileName = GetFileName(strDefaultName)
        If strSaveFileName <> "" Then SaveFileAs (strSaveFileName)
        ' 更新文件菜单控件数组中的最近打开文件列表。
        UpdateFileMenu (strSaveFileName)
    End If
End Sub

Private Sub mnuFontName_Click(Index As Integer)
    ' 分配选定的字体到文本框 fontname 属性。
    txtNote.FontName = mnuFontName(Index).Caption
End Sub

Private Sub mnuOptions_Click()
    ' 切换选中的选项与 .Visible 属性相匹配。
    mnuOptionsToolbar.Checked = picToolbar.Visible
End Sub

Private Sub mnuOptionsLaunch_Click()
    Dim strApp As String
    
    ' 创建此记事本实例新的外壳程序。
    strApp = App.Path & "\" & App.EXEName
    Shell strApp, 1
End Sub

Private Sub mnuOptionsToolbar_Click()
    ' 切换工具栏的 visible 属性。
    picToolbar.Visible = Not picToolbar.Visible
    ' 更改选定来适合当前状态。
    mnuOptionsToolbar.Checked = picToolbar.Visible
    ' 调用重新调整大小过程。
    ResizeNote
End Sub

Private Sub mnuRecentFile_Click(Index As Integer)
    ' 调用文件打开过程, 传递一个
    ' 引用到选定名称的文件
    OpenFile (mnuRecentFile(Index).Caption)
    ' 更新文件菜单控件数组中的最近打开文件列表。
    GetRecentFiles
End Sub

Private Sub mnuSearchFind_Click()
    ' 如果文本框中有文本, 分配它到
    ' 查找窗体的文本框中, 否则分配
    ' 最后的 findtext 的值。
    If txtNote.SelText <> "" Then
        frmFind.txtFind.Text = txtNote.SelText
    Else
        frmFind.txtFind.Text = gFindString
    End If
    ' 设置公共变量在开头的地方启动。
    gFirstTime = True
    ' 设置大小写复选框与公共变量匹配。
    If (gFindCase) Then
        frmFind.chkCase = 1
    End If
    ' 显示查找窗题。
    frmFind.Show vbModal
End Sub

Private Sub mnuSearchFindNext_Click()
    ' 如果公共变量不为空, 调用
    ' 查找过程, 否则调用查找菜单。
    If Len(gFindString) > 0 Then
        FindIt
    Else
        mnuSearchFind_Click
    End If
End Sub

Private Sub txtNote_Change()
    ' 设置公共变量来显示已经更改的文本。
    FState.Dirty = True
End Sub