⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mdifrm.frm

📁 Simple Word Document...
💻 FRM
📖 第 1 页 / 共 3 页
字号:
    stBar.Width = Me.Width
    MakeStatusBarFormated stBar
    
    FormatBand.BackColor = ColBar.BackColor
    FormatBand.Height = FormatTools.Height
    
    For i = 0 To Printer.FontCount - 1
        ComFont.AddItem Printer.Fonts(i)
    Next i
    For i = 8 To 28 Step 2
        comSize.AddItem i
    Next i
    comSize.AddItem "36"
    comSize.AddItem "48"
    comSize.AddItem "72"
End Sub
Private Sub SetAutotextMenu()
Dim MailingCap(7) As String
Dim ReferenceCap(2) As String
Dim SalutationCap(3) As String

    MailingCap(0) = "CERTIFIED MAIL"
    MailingCap(1) = "CONFIDENTIAL"
    MailingCap(2) = "PERSONAL"
    MailingCap(3) = "REGISTERED MAIL"
    MailingCap(4) = "SPECIAL DELIVERY"
    MailingCap(5) = "VIA AIRMAIL"
    MailingCap(6) = "VIA FACSIMAIL"
    MailingCap(7) = "VIA OVERNIGHT MAIL"
    
    
    ReferenceCap(0) = "In reply to:"
    ReferenceCap(1) = "RE:"
    ReferenceCap(2) = "Reference:"
    
    SalutationCap(0) = "Dear Mom and Dad,"
    SalutationCap(1) = "Dear Sir or Madam:"
    SalutationCap(2) = "Ladies and Gentleman:"
    SalutationCap(3) = "To Whom It May Concern:"
    
    For i = 0 To 7
        Select Case i
            Case 0
                mnuMailing(i).Caption = MailingCap(i)
                MnuReference(i).Caption = ReferenceCap(i)
                mnuSalutation(i).Caption = SalutationCap(i)
            Case Else
                Load mnuMailing(i)
                mnuMailing(i).Caption = MailingCap(i)
                
                If i < 3 Then
                    Load MnuReference(i)
                    MnuReference(i).Caption = ReferenceCap(i)
                End If
                
                If i < 4 Then
                    Load mnuSalutation(i)
                    mnuSalutation(i).Caption = SalutationCap(i)
                End If
        End Select
    Next i
End Sub

Private Sub mnuAboutus_Click()
    frmAbout.Show 1, MDIfrm
End Sub

Private Sub mnuAlign_Click(Index As Integer)
    SetAlignment Index
End Sub

Public Function SetAlignment(Index As Integer)
    mnuAlign(Index).Checked = True
    Select Case Index
        Case 0
            mnuAlign(1).Checked = False
            mnuAlign(2).Checked = False
            
            FormatTools.Buttons(4).Value = 1
            FormatTools.Buttons(5).Value = 0
            FormatTools.Buttons(6).Value = 0
            
            MDIfrm.ActiveForm.SetTab MDIfrm.ActiveForm.Document_.SelIndent
        Case 1
            mnuAlign(0).Checked = False
            mnuAlign(2).Checked = False
            
            FormatTools.Buttons(6).Value = 1
            FormatTools.Buttons(5).Value = 0
            FormatTools.Buttons(4).Value = 0
            MDIfrm.ActiveForm.SetTab MDIfrm.ActiveForm.DRuler.Width - MDIfrm.ActiveForm.Document_.SelRightIndent
        Case 2
            mnuAlign(0).Checked = False
            mnuAlign(1).Checked = False
            
            FormatTools.Buttons(5).Value = 1
            FormatTools.Buttons(4).Value = 0
            FormatTools.Buttons(6).Value = 0
    End Select
    ActiveForm.Document_.SelAlignment = Index
End Function
Private Sub mnuAttn_Click(Index As Integer)
    ActiveForm.Document_.SelRTF = mnuAttn(Index).Caption
End Sub

Private Sub mnuBreak_Click()
    DlgBreak.Show 1, MDIfrm
End Sub

Private Sub mnuBulletNumber_Click()
    ActiveForm.ActiveControl.SelBullet = Not ActiveForm.ActiveControl.SelBullet
    mnuBulletNumber.Checked = Not mnuBulletNumber.Checked
    
    If mnuBulletNumber.Checked = True Then
        FormatTools.Buttons(7).Value = tbrPressed
    Else
        FormatTools.Buttons(7).Value = tbrUnpressed
    End If
End Sub

Private Sub mnuChangeCase_Click()
    DlgChangeCase.Show 1, MDIfrm
End Sub

Private Sub mnuClear_Click()
    SendKeys "{DEL}"
End Sub

Private Sub mnuClose_Click()
    On Error Resume Next

Dim Cntr As Integer
    
    Unload Me.ActiveForm
    Cntr = 0
    
    For Each XX In Forms
        Cntr = Cntr + 1
    Next
    If Cntr < 2 Then
        DisableControlNoDocu
    End If
End Sub

Private Sub mnuClosing_Click(Index As Integer)
    ActiveForm.Document_.SelRTF = mnuClosing(Index).Caption
End Sub

Private Sub mnuCopy_Click()
  On Error Resume Next
    Clipboard.Clear
    Clipboard.SetText ActiveForm.Document_.SelRTF
End Sub

Private Sub mnuCut_Click()
  On Error Resume Next
    Clipboard.Clear
    Clipboard.SetText ActiveForm.Document_.SelRTF
    ActiveForm.Document_.SelText = vbNullString
End Sub

Private Sub mnuDateTime_Click()
    DlgDateTime.Show 1, MDIfrm
End Sub

Private Sub mnuexit_Click()
    Unload Me
End Sub

Private Sub mnuFind_Click()
    Load frmFindReplace
    frmFindReplace.loadfind
    frmFindReplace.Show , MDIfrm
End Sub

Private Sub mnuFonts_Click()
    ShowFormatWindow CmnDlg
End Sub

Private Sub mnuFromFile_Click()
    OpenInsertFromFile CmnDlg
End Sub

Private Sub mnuHorizon_Click()
    Me.Arrange 1
End Sub

Private Sub mnuInsertFile_Click()
    InsertFile CmnDlg
End Sub

Private Sub mnuMailing_Click(Index As Integer)
    ActiveForm.Document_.SelRTF = mnuMailing(Index).Caption
End Sub

Private Sub mnuNew_Click()
    NewDocument
End Sub

Private Sub mnuNewwindow_Click()
    mnuNew_Click
End Sub

Private Sub mnuOpen_Click()
    OpenDocument CmnDlg
End Sub

Private Sub mnuPageSetup_Click()
    DlgPageSetup.Show 1, MDIfrm
End Sub

Private Sub mnuParagraph_Click()
    DlgParagraph.Show 1, MDIfrm
End Sub

Private Sub mnuPaste_Click()
    PasteData
End Sub

Private Sub MnuReference_Click(Index As Integer)
    ActiveForm.Document_.SelRTF = MnuReference(Index).Caption
End Sub

Private Sub mnuReplace_Click()
    Load frmFindReplace
    frmFindReplace.loadReplace
    frmFindReplace.Show , MDIfrm
End Sub

Private Sub mnuSalutation_Click(Index As Integer)
    ActiveForm.Document_.SelRTF = mnuSalutation(Index).Caption
End Sub

Private Sub mnuSave_Click()
    SaveDocument CmnDlg, MDIfrm.ActiveForm
End Sub

Private Sub mnuSaveAs_Click()
    SaveAsDocument CmnDlg, MDIfrm.ActiveForm
End Sub

Private Sub mnuSelectAll_Click()
  On Error Resume Next
    ActiveForm.Document_.SelStart = 0
    ActiveForm.Document_.SelLength = Len(ActiveForm.Document_.Text)
End Sub

Public Sub PasteData()
On Error Resume Next
    ActiveForm.Document_.SelRTF = Clipboard.GetText
End Sub

Private Sub mnuSpellGrammer_Click()
Dim Textbox_ As String
Dim msg As String
    If ActiveForm.Document_.Text <> "" Then
        msg = "Spell Checker requires that you have Microsoft WORD 97 or later installed on your system."
        msg = msg + Chr(13) + ""
        msg = msg + "Running Spell Checker on a system without WORD could result in unpredictable behaviour."
        msg = msg + Chr(13)
        msg = msg + Chr(13) + "If you are running Spell Checker for the first time"
        msg = msg + " or if you DO NOT have WORD"
        msg = msg + Chr(13) + "installed on your system it is recommended that you Save your report "
        msg = msg + "before you continue."
        msg = msg + Chr(13)
        msg = msg + Chr(13) + Space(33) + "Are You Sure You Want To Continue?"
        
        If MsgBox(msg, vbYesNo + vbInformation) = vbYes Then
            Textbox_ = ActiveForm.Document_.Text                       'Assign Contens Of TextBox To Variable "TextBox"
            MDIfrm.ActiveForm.Document_.Text = SpellChecker(Textbox_)                      'Call SpellChecking Function ~ Transfer variable
            MsgBox "The Spelling Check Complete.", vbOKOnly + vbInformation
        End If
    End If
End Sub

Private Sub mnuSubject_Click()
    ActiveForm.Document_.SelRTF = mnuSubject.Caption
End Sub

Private Sub mnuSymbol_Click()
    DlgSymbols.Show 1, MDIfrm
End Sub

Private Sub mnuTool_Click(Index As Integer)
    mnuTool(Index).Checked = Not mnuTool(Index).Checked
    Select Case Index
        Case 0
            ColBar.Bands(1).Visible = Not ColBar.Bands(1).Visible
        Case 1
            ColBar.Bands(2).Visible = Not ColBar.Bands(2).Visible
        Case 2
            ColBar.Bands(3).Visible = Not ColBar.Bands(3).Visible
    End Select
End Sub

Private Sub mnuVertical_Click()
    Me.Arrange 2
End Sub


Public Sub ChangeSelectTextStatus(Obj_ As RichTextBox)
    With Obj_
        If IsNull(.SelAlignment) = True Then
        ElseIf .SelAlignment = 0 Then
            SetAlignment 0
        ElseIf .SelAlignment = 1 Then
            SetAlignment 1
        ElseIf .SelAlignment = 2 Then
            SetAlignment 2
        End If
        
        FormatTools.Buttons(1).MixedState = False
        If IsNull(.SelBold) = True Then
            FormatTools.Buttons(1).MixedState = True
        ElseIf .SelBold = False Then
            FormatTools.Buttons(1).Value = tbrUnpressed
        ElseIf .SelBold = True Then
            FormatTools.Buttons(1).Value = tbrPressed
        End If
        
        FormatTools.Buttons(2).MixedState = False
        If IsNull(.SelItalic) = True Then
            FormatTools.Buttons(2).MixedState = True
        ElseIf .SelItalic = False Then
            FormatTools.Buttons(2).Value = tbrUnpressed
        ElseIf .SelItalic = True Then
            FormatTools.Buttons(2).Value = tbrPressed
        End If
        
        FormatTools.Buttons(3).MixedState = False
        If IsNull(.SelUnderline) = True Then
            FormatTools.Buttons(3).MixedState = True
        ElseIf .SelUnderline = False Then
            FormatTools.Buttons(3).Value = tbrUnpressed
        ElseIf .SelUnderline = True Then
            FormatTools.Buttons(3).Value = tbrPressed
        End If
        
        
        If IsNull(.SelBullet) = True Then
            mnuBulletNumber.Checked = True
        ElseIf .SelBullet = False Then
            mnuBulletNumber.Checked = False
        ElseIf .SelBullet = True Then
            mnuBulletNumber.Checked = True
        End If
        
        FormatTools.Buttons(7).MixedState = False
        If IsNull(.SelBullet) = True Then
            FormatTools.Buttons(7).MixedState = True
        ElseIf .SelBullet = False Then
            FormatTools.Buttons(7).Value = tbrUnpressed
        ElseIf .SelBullet = True Then
            FormatTools.Buttons(7).Value = tbrPressed
        End If
        
        If IsNull(.SelFontName) = True Then
            ComFont.Text = ""
        Else
            ComFont.Text = .SelFontName
        End If
        If IsNull(.SelFontSize) = True Then
            comSize.Text = ""
        Else
            comSize.Text = .SelFontSize
        End If
    End With
End Sub


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -