mdiform1.frm

vb学习

      Caption         =   "察看[&V]"
      Begin VB.Menu mViewToolbar 
         Caption         =   "工具栏[&T]"
      End
      Begin VB.Menu mViewStat 
         Caption         =   "状态栏[&S]"
      End
   End
   Begin VB.Menu mWindow 
      Caption         =   "窗口[&W]"
      WindowList      =   -1  'True
      Begin VB.Menu mWindowTitle 
         Caption         =   "平铺[&T]"
      End
      Begin VB.Menu mWindowCa 
         Caption         =   "层叠[&C]"
      End
   End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Sub LoadMenu()
    Dim hFile
    Dim sFile
    
    sFile = App.Path + "\file.ini"
    If Dir$(sFile) = "" Then
        hFile = FreeFile
        Open sFile For Append As #hFile
        Close #hFile
    End If
    hFile = FreeFile
    Open sFile For Input As #hFile
    Close hFile
End Sub
Sub FindStrRTF(RTF As RichTextBox)
    Dim L1, L2 As Long
    
    If Me.ActiveForm.FindStr <> "" Then
        '利用API获得当前插入点位置
        SendMessageByRef RTF.hwnd, EM_GETSEL, L1, L2
        
        If RTF.Find(Me.ActiveForm.FindStr, L2) = -1 Then
            L2 = 0
            If RTF.Find(Me.ActiveForm.FindStr, L2) = -1 Then
                MsgBox Me.ActiveForm.FindStr + " 没有找到", vbOKOnly, ""
            End If
        End If
    End If
End Sub

Private Sub MDIForm_Load()
    mViewToolbar.Checked = True
    mViewStat.Checked = True
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    End
End Sub

Private Sub mEditCopy_Click()
    If Me.ActiveForm.RichTextBox1.SelText <> "" Then
        Clipboard.SetText Me.ActiveForm.RichTextBox1.SelText, vbCFText
    End If
End Sub

Private Sub mEditCut_Click()
    If Me.ActiveForm.RichTextBox1.SelText <> "" Then
        Clipboard.SetText Me.ActiveForm.RichTextBox1.SelText, vbCFText
        Me.ActiveForm.RichTextBox1.SelText = ""
    End If
End Sub

Private Sub mEditFind_Click()
    With Me.ActiveForm
        If .RichTextBox1.SelText <> "" Then
            frmFind.txtFind.Text = .RichTextBox1.SelText
        ElseIf .FindStr <> "" Then
            frmFind.txtFind.Text = .FindStr
        End If
        frmFind.Show 0
        frmFind.txtFind.SetFocus
        frmFind.txtFind.SelStart = 0
        frmFind.txtFind.SelLength = Len(frmFind.txtFind.Text)
    End With
End Sub

Private Sub mEditFindNext_Click()
    FindStrRTF Me.ActiveForm.RichTextBox1
End Sub

Private Sub mEditPaste_Click()
    If Clipboard.GetFormat(vbCFText) Then
        Me.ActiveForm.RichTextBox1.SelText = Clipboard.GetText(vbCFText)
    End If
End Sub

Private Sub mEditRedo_Click()
    SendMessageByRef Me.ActiveForm.RichTextBox1.hwnd, EM_REDO, ByVal 0, ByVal 0
End Sub

Private Sub mEditReplace_Click()
    With frmReplace
        .Show 0
        If Me.ActiveForm.FindStr = "" Then
            .txtFind.Text = Me.ActiveForm.RichTextBox1.SelText
        Else
            .txtFind.Text = Me.ActiveForm.FindStr
        End If
    End With
    Me.ActiveForm.RichTextBox1.SelAlignment = 0
End Sub

Private Sub mEditSelAll_Click()
    Me.ActiveForm.RichTextBox1.SelStart = 0
    Me.ActiveForm.RichTextBox1.SelLength = LenB(Me.ActiveForm.RichTextBox1.Text)
End Sub

Private Sub mEditUndo_Click()
    SendMessageByRef Me.ActiveForm.RichTextBox1.hwnd, EM_UNDO, ByVal 0, ByVal 0
End Sub

Private Sub mFileExit_Click()
    Unload MDIForm1
End Sub

Private Sub mFileNew_Click()
    Dim frmNew As New Form1
    
    frmNew.Visible = True
    frmNew.Show
    frmNew.OpenFile = ""
End Sub

Private Sub mFileOpen_Click()
    Dim strOpen As String
    With CommonDialog1
        .FileName = ""
        .Filter = " 文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"

        .DialogTitle = "打开文件"
        .ShowOpen
        If .FileName = "" Then Exit Sub
        strOpen = .FileName
        
        If Dir$(strOpen) <> "" Then
            For Each frmA In Forms
                If frmA.Name = "Form1" Then
                    If frmA.OpenFile = strOpen Then
                        frmA.SetFocus
                        Exit Sub
                    End If
                End If
            Next
            Dim frmNew As New Form1
            frmNew.Visible = True
            frmNew.Show
            frmNew.OpenFile = strOpen
            frmNew.RichTextBox1.LoadFile strOpen, 1
            frmNew.Caption = strOpen    '设置新窗体标题为文件名
            frmNew.HasChanged = False
        Else
            MsgBox "文件不存在!", vbOKOnly, "打开文件"
        End If
    End With
End Sub

Private Sub mFilePrint_Click()
    On Error GoTo lPrintErr
    With CommonDialog1
        .CancelError = True
        .PrinterDefault = True
        .Flags = cdlPDReturnDC
        
        If Me.ActiveForm.RichTextBox1.SelLength = 0 Then
            .Flags = .Flags + cdlPDAllPages
        Else
            .Flags = .Flags + cdlPDSelection
        End If
        .ShowPrinter
    End With
    
    '将活动编辑窗口的内容发送到打印机
    Me.ActiveForm.RichTextBox1.SelPrint CommonDialog1.hDC

    Exit Sub

'如果用户在打印对话框中选择了Cancel就会引发错误，而
'错误在这里处理
lPrintErr:
    If Err.Number = 32755 Then
        Exit Sub
    Else
        Resume Next
    End If
End Sub

Private Sub mFileSave_Click()
    Me.ActiveForm.SaveFile
End Sub

Private Sub mFileSaveAs_Click()
    Me.ActiveForm.SaveFileAs
End Sub

Private Sub mViewStat_Click()
    If mViewStat.Checked Then
        StatusBar1.Visible = False
        mViewStat.Checked = False
    Else
        StatusBar1.Visible = True
        mViewStat.Checked = True
    End If
End Sub

Private Sub mViewToolbar_Click()
    If mViewToolbar.Checked Then
        Toolbar1.Visible = False
        mViewToolbar.Checked = False
    Else
        Toolbar1.Visible = True
        mViewToolbar.Checked = True
    End If
End Sub

Private Sub mWindowCa_Click()
    Me.Arrange 0
End Sub

Private Sub mWindowTitle_Click()
    Me.Arrange 1
End Sub

Private Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "New"
            mFileNew_Click
        Case "Open"
            mFileOpen_Click
        Case "Save"
            mFileSave_Click
        Case "Print"
            mFilePrint_Click
        Case "Cut"
            mEditCut_Click
        Case "Copy"
            mEditCopy_Click
        Case "Paste"
            mEditPaste_Click
        Case "Find"
            mEditFind_Click
        Case "Undo"
            mEditUndo_Click
        Case "Redo"
            mEditRedo_Click
    End Select
End Sub