frmdocument.frm

菜单浏览系统 vb环境开发 界面做的非常好 是vb学习的绝佳素材 this vbsystem is very useful

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmDocument 
   Caption         =   "frmDocument"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   4680
   LinkTopic       =   "frmMain"
   MDIChild        =   -1  'True
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   Begin RichTextLib.RichTextBox rtfText 
      Height          =   1995
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   3000
      _ExtentX        =   5292
      _ExtentY        =   3519
      _Version        =   393217
      ScrollBars      =   3
      TextRTF         =   $"frmDocument.frx":0000
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuFileNew 
         Caption         =   "新建(&N)"
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuFileOpen 
         Caption         =   "打开(&O)..."
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuFileBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileSave 
         Caption         =   "保存(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuFileSaveAs 
         Caption         =   "另存为(&A)..."
      End
      Begin VB.Menu mnuFileBar5 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mnuEditCut 
         Caption         =   "剪切(&T)"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuEditCopy 
         Caption         =   "复制(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "粘贴(&P)"
         Shortcut        =   ^V
      End
   End
   Begin VB.Menu mnuWindow 
      Caption         =   "窗口(&W)"
      WindowList      =   -1  'True
      Begin VB.Menu mnuWindowCascade 
         Caption         =   "层叠(&C)"
      End
      Begin VB.Menu mnuWindowTileHorizontal 
         Caption         =   "横向平铺(&H)"
      End
      Begin VB.Menu mnuWindowTileVertical 
         Caption         =   "纵向平铺(&V)"
      End
      Begin VB.Menu mnuWindowArrangeIcons 
         Caption         =   "排列图标(&A)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A) "
         Shortcut        =   {F1}
      End
   End
End
Attribute VB_Name = "frmDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
   Form_Resize
End Sub

Private Sub Form_Resize()
   On Error Resume Next
   rtfText.Move 100, 100, ScaleWidth - 200, ScaleHeight - 200
   rtfText.RightMargin = rtfText.Width - 400
End Sub

Private Sub mnuHelpAbout_Click()
   MsgBox "版本 " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

Private Sub mnuWindowArrangeIcons_Click()
   ''整理子窗口最小化之后的图标
   frmMain.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
   ''以垂直方式排列各个子窗口
   frmMain.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
   ''以水平方式安排各个子窗口
   frmMain.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()
   ''以层叠方式安排各个子窗口
   frmMain.Arrange vbCascade
End Sub

Private Sub mnuEditPaste_Click()
   On Error Resume Next
   rtfText.SelRTF = Clipboard.GetText

End Sub

Private Sub mnuEditCopy_Click()
   On Error Resume Next
   Clipboard.SetText rtfText.SelRTF

End Sub

Private Sub mnuEditCut_Click()
   On Error Resume Next
   Clipboard.SetText rtfText.SelRTF
   rtfText.SelText = vbNullString

End Sub

Private Sub mnuFileExit_Click()
   '卸载窗体
   Unload frmMain

End Sub

Private Sub mnuFileSaveAs_Click()
   Dim sFile As String
 
   With frmMain.dlgCommonDialog
      .DialogTitle = "另存为"
      .CancelError = False
      'ToDo: 设置 common dialog 控件的标志和属性
      .Filter = "所有文件 (*.*)|*.*"
      .ShowSave
      If Len(.FileName) = 0 Then
         Exit Sub
      End If
      sFile = .FileName
   End With
   Caption = sFile
   rtfText.SaveFile sFile

End Sub

Private Sub mnuFileSave_Click()
   Dim sFile As String
   If Left$(Caption, 8) = "Document" Then
      With frmMain.dlgCommonDialog
         .DialogTitle = "保存"
         .CancelError = False
         'ToDo: 设置 common dialog 控件的标志和属性
         .Filter = "所有文件 (*.*)|*.*"
         .ShowSave
         If Len(.FileName) = 0 Then
            Exit Sub
         End If
         sFile = .FileName
      End With
      rtfText.SaveFile sFile
   Else
      sFile = Caption
      rtfText.SaveFile sFile
   End If

End Sub

Private Sub mnuFileOpen_Click()
   Dim sFile As String

   With frmMain.dlgCommonDialog
      .DialogTitle = "打开"
      .CancelError = False
      'ToDo: 设置 common dialog 控件的标志和属性
      .Filter = "所有文件 (*.*)|*.*"
      .ShowOpen
      If Len(.FileName) = 0 Then
         Exit Sub
      End If
      sFile = .FileName
   End With
   rtfText.LoadFile sFile
   Caption = sFile

End Sub

Private Sub mnuFileNew_Click()
   Static lDocumentCount As Long
   Dim frmD As frmDocument
   lDocumentCount = lDocumentCount + 1
   Set frmD = New frmDocument
   frmD.Caption = "Document " & lDocumentCount
   frmD.Show
End Sub