form1.frm

给大家一个练字的平台 哦,一个小小的工具,可以满足你的要求.

   Begin VB.Menu munFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu open 
         Caption         =   "打开"
         Shortcut        =   ^O
      End
      Begin VB.Menu save 
         Caption         =   "保存"
         Shortcut        =   ^S
      End
      Begin VB.Menu otherSave 
         Caption         =   "另存为..."
      End
      Begin VB.Menu munline 
         Caption         =   "-"
      End
      Begin VB.Menu exit 
         Caption         =   "退出"
         Shortcut        =   ^E
      End
   End
   Begin VB.Menu bianji 
      Caption         =   "编辑(&E)"
      Begin VB.Menu cut 
         Caption         =   "剪切"
         Shortcut        =   ^X
      End
      Begin VB.Menu copy 
         Caption         =   "复制"
         Shortcut        =   ^C
      End
      Begin VB.Menu All 
         Caption         =   "全选"
         Shortcut        =   ^A
      End
      Begin VB.Menu affix 
         Caption         =   "粘贴"
         Shortcut        =   ^V
      End
   End
   Begin VB.Menu format 
      Caption         =   "格式(&O)"
      Begin VB.Menu font 
         Caption         =   "字体"
         Index           =   0
      End
      Begin VB.Menu colour 
         Caption         =   "颜色"
         Index           =   1
      End
   End
   Begin VB.Menu aa 
      Caption         =   "aa"
      Visible         =   0   'False
      Begin VB.Menu open1 
         Caption         =   "打开(&O)"
      End
      Begin VB.Menu All1 
         Caption         =   "全选(&A)"
      End
      Begin VB.Menu copy1 
         Caption         =   "复制(&C)"
      End
      Begin VB.Menu cut1 
         Caption         =   "剪切(&T)"
      End
      Begin VB.Menu fix1 
         Caption         =   "粘贴(&P)"
      End
      Begin VB.Menu delete 
         Caption         =   "删除(&D)"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private b As Boolean
Private a As Integer
Private C As String        '设置文本框保存后内容改变时再做保存
Private Sub affix_Click()        '粘贴
  rchtxt.SelText = Clipboard.GetText()
End Sub

Private Sub All_Click()          '全选
rchtxt.SelStart = 0
rchtxt.SelLength = Len(rchtxt.Text)
End Sub

Private Sub All1_Click()          '右键菜单全选
Call All_Click
End Sub

Private Sub colour_Click(Index As Integer)   '调出颜色
   com.ShowColor
   'MsgBox com.Color
   rchtxt.SelColor = com.Color
End Sub

Private Sub Combo1_Click()              '下拉列表框选择字体
  rchtxt.SelFontName = Combo1
End Sub

Private Sub Combo2_Click()             '下拉列表框选择字号
 rchtxt.SelFontSize = Combo2
End Sub

Private Sub copy_Click()              '复制
  Clipboard.Clear
  Clipboard.SetText rchtxt.SelText
End Sub

Private Sub copy1_Click()             '右键菜单复制
Call copy_Click
End Sub

Private Sub cut_Click()               '剪切
  Clipboard.Clear
  Clipboard.SetText rchtxt.SelText
  rchtxt.SelText = ""
End Sub

Private Sub cut1_Click()              '右键菜单剪切
Call cut_Click
End Sub

Private Sub delete_Click()             '删除
rchtxt.SelText = ""
End Sub

Private Sub exit_Click()                '退出
  Unload Me
End Sub

Private Sub fix1_Click()               '右键菜单粘贴
Call affix_Click
End Sub

Private Sub Font_Click(Index As Integer)    '调出字体
   com.ShowFont
   rchtxt.SelFontSize = com.FontSize
End Sub

Private Sub Form_Load()
  com.Flags = &O12
  For Index = 1 To Screen.FontCount        '列表1 循环添加字体
     Combo1.AddItem Screen.Fonts(Index)
  Next
    For a = 1 To 72                        '列表2 循环添加字号
      Combo2.AddItem a
    Next
  StatusBar1.Panels(1).Text = Now
  Pic.BackColor = 0
End Sub

Private Sub Form_Resize()
If Form1.WindowState = 0 Then                 '设置窗体大小
  rchtxt.Width = Form1.Width
  rchtxt.Height = Form1.Height - CoolBar1.Height
  CoolBar1.Width = Form1.Width
ElseIf Form1.WindowState = 2 Then
  rchtxt.Width = Form1.Width
  rchtxt.Height = Form1.Height - CoolBar1.Height
  CoolBar1.Width = Form1.Width
End If
End Sub

Private Sub open_Click()                    '打开
  com.Filter = "Text (*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico"
  com.ShowOpen
  rchtxt.FileName = com.FileName
End Sub

Private Sub open1_Click()
Call open_Click
End Sub

Private Sub otherSave_Click()
com.Filter = "Text (*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico"
com.ShowSave
rchtxt.SaveFile com.FileName, 1
End Sub

Private Sub Pic_Click()           '用图片框显示的颜色点击后,字体颜色跟着变
rchtxt.SelColor = com.Color
End Sub

Private Sub rchtxt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then                             '添加右键菜单
  PopupMenu aa
End If
End Sub
Private Sub save_Click()                       '保存
  com.Filter = "Text (*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico"
    If b = False Then                          '第一次点击选择保存路径
    com.ShowSave
    rchtxt.SaveFile com.FileName, 1
    C = rchtxt.Text
    b = True
    ElseIf b = True Then                  '再次点击保存到第一次选择的路径
    rchtxt.SaveFile com.FileName, 1
    C = rchtxt.Text
    End If
End Sub

Private Sub Timer1_Timer()         '让时间显示为当前时间
StatusBar1.Panels(1).Text = Now()
End Sub

Private Sub Toolbar1_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
Select Case Button.Index
    Case 1
        com.Filter = "Text (*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico"
        com.ShowOpen
        rchtxt.FileName = com.FileName
    Case 2
        com.Filter = "Text (*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico"
        If b = False Then
        com.ShowSave
        rchtxt.SaveFile com.FileName, 1
        C = rchtxt.Text
        b = True
        ElseIf b = True Then
        rchtxt.SaveFile com.FileName, 1
        C = rchtxt.Text
        End If
    Case 4
        Unload Me
    Case 6
        Clipboard.Clear
        Clipboard.SetText rchtxt.SelText
        rchtxt.SelText = ""
    Case 7
        Clipboard.Clear
        Clipboard.SetText rchtxt.SelText
    Case 8
        rchtxt.SelText = Clipboard.GetText()
End Select
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
com.Filter = "Text (*.txt)|*.txt|Pictures (*.bmp;*.ico)|*.bmp;*.ico"
If b = False And rchtxt.Text <> "" Then
    a = MsgBox("是否保存对文档的修改?", vbQuestion + vbYesNoCancel, Me.Caption)
    If a = 6 Then
        com.ShowSave
        rchtxt.SaveFile com.FileName, 1
    ElseIf a = 7 Then
        Unload Me
    ElseIf a = 2 Then
        Cancel = True
    End If
ElseIf rchtxt.Text <> C Then           '当保存后文本框内容改变时
    a = MsgBox("是否保存对文档的修改?", vbQuestion + vbYesNoCancel, Me.Caption)
    If a = 6 Then
        com.ShowSave
        rchtxt.SaveFile com.FileName, 1
    ElseIf a = 7 Then
        Unload Me
    ElseIf a = 2 Then
        Cancel = True
    End If
ElseIf rchtxt.Text = "" Or b = True Then
    Unload Me
End If
    End Sub


Private Sub Toolbar1_ButtonMenuClick(Index As Integer, ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    If ButtonMenu = "黑色" Then                       'toolbar下拉颜色列表
       rchtxt.SelColor = 0
       Pic.BackColor = 0
       com.Color = 0
    ElseIf ButtonMenu = "红色" Then
       rchtxt.SelColor = 255
       Pic.BackColor = 255
       com.Color = 255
    ElseIf ButtonMenu = "黄色" Then
       rchtxt.SelColor = 65535
       Pic.BackColor = 65535
       com.Color = 65535
    ElseIf ButtonMenu = "蓝色" Then
       rchtxt.SelColor = 16711680
       Pic.BackColor = 16711680
       com.Color = 16711680
    ElseIf ButtonMenu = "绿色" Then
       rchtxt.SelColor = 65280
       Pic.BackColor = 65280
       com.Color = 65280
    ElseIf ButtonMenu = "紫色" Then
       rchtxt.SelColor = 16711808
       Pic.BackColor = 16711808
       com.Color = 16711808
    ElseIf ButtonMenu = "更多颜色..." Then
       com.ShowColor
       rchtxt.SelColor = com.Color
       Pic.BackColor = com.Color
    End If
End Sub