form1.frm

来自「用VB编写的写字板」· FRM 代码 · 共 789 行 · 第 1/2 页

RichTextBox1.font.Bold = CommonDialog1.FontBold
RichTextBox1.font.Italic = CommonDialog1.FontItalic
RichTextBox1.font.Name = CommonDialog1.FontName
RichTextBox1.font.Size = CommonDialog1.FontSize


End Sub

Private Sub Form_Activate()
RichTextBox1.SetFocus
ToolBar.Checked = True
geshilan.Checked = True
zhuangtailan.Checked = True
Form1.Caption = "文档－写字板"
End Sub
Private Sub Form_Load()

For i = 8 To 72
  Combo2.AddItem i
Next i
  Combo2.Text = 12
  RichTextBox1.SelFontSize = 12
For a = 0 To Screen.FontCount - 1
  Combo1.AddItem Screen.Fonts(a)
  Combo1.Text = "宋体"
  RichTextBox1.SelFontName = "宋体"
Next a
gblnIndent = False
gstrFileName = ""
RichTextBox1.SelTabCount = 6
RichTextBox1.SelTabs(0) = 400
RichTextBox1.SelTabs(1) = 800
RichTextBox1.SelTabs(2) = 1200
RichTextBox1.SelTabs(3) = 1600
RichTextBox1.SelTabs(4) = 2000
RichTextBox1.SelTabs(5) = 2400
zhuangtailan.Visible = True
End Sub
Sub SetTabStop(frm As Form, blnv As Boolean)
  Dim ctrl As Control
  On Error Resume Next
  For Each ctrl In frm.Controls
      ctrl.TabStop = blnv
  Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
msgtext = "文件" & gstrFileName & "的文字已经改变。" & Chr(10) & Chr(13) & "想保存文件吗？"
    If gblnChange = True Then
        Flag = MsgBox(msgtext, 35, "写字板")
            If Flag = vbYes Then mnuSave_Click
            If Flag = vbCancel Then Cancel = True
            If Flag = vbNo Then Unload Me
    End If

End Sub

Private Sub geshilan_Click()
  geshilan.Checked = Not geshilan.Checked
  If geshilan.Checked = False Then
     Toolbar2.Visible = False
  ElseIf geshilan.Checked = True Then
     Toolbar2.Visible = True
  End If
End Sub

Private Sub mnuBullet_Click()
  If RichTextBox1.SelBullet = True Then
     RichTextBox1.SelBullet = False
  ElseIf RichTextBox1.SelBullet = False Then
     RichTextBox1.SelBullet = True
  End If
End Sub

Private Sub mnuContinueFind_Click()
  Dim vntA
  gvntPos = gvntPos + 1
  If gvntPos + Len(gstrFind) >= Len(RichTextBox1.Text) Then gvntPos = 0
  If Len(gstrFind) > 0 Then
     vntA = RichTextBox1.Find(gstrFind, gvntPos)
     If vntA = -1 Then
        MsgBox ("已经查到文件尾！")
        Exit Sub
     End If
     If vntA <= gvntPos Then _
        vntA = RichTextBox1.Find(gstrFind, gvntPos * 2)
     gvntPos = vntA
 End If
 
End Sub

Private Sub mnuContinueReplace_Click()
  RichTextBox1.SelRTF = gstrReplace
End Sub

Private Sub mnuCopy_Click()
  Clipboard.SetText RichTextBox1.SelRTF
  mnuPaste.Enabled = True
End Sub

Private Sub mnuCut_Click()
  Clipboard.SetText RichTextBox1.SelRTF
  RichTextBox1.SelRTF = ""
  mnuPaste.Enabled = True
  
End Sub

Private Sub mnuDel_Click()
   RichTextBox1.SelRTF = ""
End Sub

Private Sub mnuDown_Click()
   gvntSize = RichTextBox1.SelFontSize
   RichTextBox1.SelCharOffset = -20
   RichTextBox1.SelFontSize = RichTextBox1.SelFontSize * 0.8
End Sub

Private Sub mnuExit_Click()
msgtext = "文件" & gstrFileName & "的文字已经改变。" & Chr(10) & Chr(13) & "想保存文件吗？"
    If gblnChange = True Then
        Flag = MsgBox(msgtext, 35, "写字板")
            If Flag = vbYes Then mnuSave_Click
            If Flag = vbCancel Then Cancel = True
            If Flag = vbNo Then End
    ElseIf gblnChange = False Then
      Unload Me
    End If
If CommonDialog1.CancelError = True Then
  Cancel = True
End If
End Sub

Private Sub mnuFind_Click()
  gstrFind = InputBox("键入需要寻找的字符串")
  If Len(gstrFind) > 0 Then
     gvntPos = RichTextBox1.Find(gstrFind, 0)
  End If
End Sub

Private Sub mnuIndent_Click()
  gblnIndent = Not gblnIndent
  If gblnIndent Then
     RichTextBox1.SelIndent = 600
  Else
     RichTextBox1.SelIndent = -600
  End If
End Sub

Private Sub mnuNew_Click()
If gblnChange Then
    Form1.Caption = "文档－写字板"
    Button = MsgBox(Form1.Caption + "文件的内容已改变," + Chr(13) + "是否保存?", vbYesNoCancel + vbExclamation)
    
    If Button = vbYes Then
        mnuSave_Click
    
    ElseIf Button = vbNo Then
    RichTextBox1.Text = ""
    End If
ElseIf gblnChange = False Then
   RichTextBox1.Text = ""
End If
If CommonDialog1.CancelError = True Then

RichTextBox1.Text = ""
Form1.Caption = "文档－写字板"

End If

End Sub

Private Sub mnuNormal_Click()
  RichTextBox1.SelFontSize = gvntSize
  RichTextBox1.SelCharOffset = 0
End Sub

Private Sub mnuOpen_Click()
  On Error GoTo 100
  CommonDialog1.Filter = "所有文件(*.*)|*.*|文本文件(*.txt)" & "|*.txt|富文本文件(*.rtf)|*.rtf"
  CommonDialog1.FilterIndex = 2
  CommonDialog1.DefaultExt = "txt"
  CommonDialog1.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist Or cdlOFNNoReadOnlyReturn
  CommonDialog1.DialogTitle = "选择文本文件"
  CommonDialog1.CancelError = True
  CommonDialog1.ShowOpen
  gstrFileName = CommonDialog1.FileName
  RichTextBox1.LoadFile gstrFileName
  Form1.Caption = gstrFileName
 Exit Sub
100:
     MsgBox "取消！"
 
End Sub

Private Sub mnuPaste_Click()
  RichTextBox1.SelRTF = Clipboard.GetText
End Sub

Private Sub mnuPrint_Click()
  On Error Resume Next
  CommonDialog1.Flags = cdlPDDisablePrintToFile
  CommonDialog1.PrinterDefault = True
  CommonDialog1.Min = 1
  CommonDialog1.Max = 100
  If RichTextBox1.SelLength = 0 Then
     CommonDialog1.Flags = CommonDialog1.Flags Or cdlPDNoSelection
  Else
     CommonDialog1.Flags = CommonDialog1.Flags Or cdlPDSelection
  End If
  CommonDialog1.CancelError = True
  CommonDialog1.ShowPrinter
  If Err = 0 Then
      If CommonDialog1.Flags And cdlPDSelection Then
         Printer.Print RichTextBox1.SelText
      Else
         Printer.Print RichTextBox1.Text
      End If
  End If
  Printer.EndDoc
  Exit Sub
End Sub

Private Sub mnuPrinter_Click()
   CommonDialog1.Flags = cdlPDPrintSetup
   CommonDialog1.ShowPrinter
End Sub

Private Sub mnuReplace_Click()
  gstrReplace = InputBox("键入作替换用的字符串")
  RichTextBox1.SelRTF = gstrReplace
End Sub

Private Sub mnuSave_Click()
On Error GoTo 100
If Form1.Caption = "文档－写字板" Then

CommonDialog1.DialogTitle = "保存"
CommonDialog1.Filter = "所有文件(*.*)|*.*|文本文件(*.txt)|*.txt" & "富文本文件(*.rtf)|*.rtf"

CommonDialog1.FilterIndex = 2
CommonDialog1.DefaultExt = "txt"
CommonDialog1.ShowSave
file = CommonDialog1.FileName
    If file <> "" Then
    Form1.Caption = file
    Open file For Output As #1
    Print #1, RichTextBox1.Text
    Close #1
    End If

Else
    file = Form1.Caption
    Open file For Output As #1
    Print #1, RichTextBox1.Text
    Close #1
End If
Exit Sub
100:
     MsgBox "取消！"

End Sub
Private Sub mnuSaveAs_Click()
On Error GoTo 100
  CommonDialog1.DialogTitle = "另存为 "
  CommonDialog1.Filter = "所有文件(*.*)|*.*|文本文件(*.txt)|*.txt" & "富文本文件(*.rtf)|*.rtf"

CommonDialog1.FilterIndex = 2
CommonDialog1.DefaultExt = "txt"
CommonDialog1.ShowSave
file = CommonDialog1.FileName
If file <> "" Then
    Form1.Caption = file
    Open file For Output As #1
    Print #1, RichTextBox1.Text
    Close #1
End If
 Exit Sub
100:
     MsgBox "取消！"
End Sub

Private Sub mnuUndo_Click()
SendKeys "^{z}"
End Sub

Private Sub Text1_Change()
Changed = True
mnuUndo.Enabled = True


End Sub

Private Sub mnuSelectAll_Click()
  RichTextBox1.SelStart = 0
    RichTextBox1.SelLength = Len(RichTextBox1.Text)
End Sub

Private Sub mnuUp_Click()
   gvntSize = RichTextBox1.SelFontSize
   RichTextBox1.SelCharOffset = 70
   RichTextBox1.SelFontSize = RichTextBox1.SelFontSize * 0.8
End Sub

Private Sub RichTextBox1_GotFocus()
  SetTabStop Me, False
End Sub

Private Sub RichTextBox1_LostFocus()
  SetTabStop Me, True
End Sub

Private Sub RichTextBox1_SelChange()
  gblnChange = True
  If RichTextBox1.SelLength > 0 Then
     mnuCut.Enabled = True
     mnuCopy.Enabled = True
  Else
     mnuCut.Enabled = False
     mnuCopy.Enabled = False
  End If
End Sub

Private Sub ToolBar_Click()
  ToolBar.Checked = Not ToolBar.Checked
  If ToolBar.Checked = False Then
     Toolbar1.Visible = False
  ElseIf ToolBar.Checked = True Then
     Toolbar1.Visible = True
  End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
  Case 1
    mnuNew_Click
  Case 2
    mnuOpen_Click
  Case 3
    mnuSave_Click
  Case 4
    mnuFind_Click
  Case 5
    mnuCut_Click
  Case 6
    mnuCopy_Click
  Case 7
    mnuPaste_Click
  Case 8
    mnuDel_Click
  Case 9
End Select
End Sub

Private Sub ToolBar11_Click()
  
End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
   Case 1
     If RichTextBox1.SelBold = False Then
      RichTextBox1.SelBold = True
      ElseIf RichTextBox1.SelBold = True Then
      RichTextBox1.SelBold = False
      End If
   Case 2
     RichTextBox1.SelItalic = True
   Case 3
     RichTextBox1.SelUnderline = True
   Case 4
     CommonDialog2.Flags = vbccrgbinit
     CommonDialog2.ShowColor
     If Err <> vbCancel Then
        RichTextBox1.SelColor = CommonDialog2.Color
     End If
     
End Select
End Sub


Private Sub zhuangtailan_Click()
 zhuangtailan.Checked = Not zhuangtailan.Checked
  If zhuangtailan.Checked = False Then
     StatusBar1.Visible = False
  ElseIf zhuangtailan.Checked = True Then
     StatusBar1.Visible = True
  End If
End Sub
Private Sub Form_Resize()
    RichTextBox1.Height = Form1.ScaleHeight
    RichTextBox1.Width = Form1.ScaleWidth
    
End Sub