📄 mdifrm.frm
字号:
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 + -