form1.frm

次程序基本实现微软的记事本功能

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6360
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   8490
   LinkTopic       =   "Form1"
   ScaleHeight     =   6360
   ScaleWidth      =   8490
   StartUpPosition =   3  '窗口缺省
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   1
      Top             =   5985
      Width           =   8490
      _ExtentX        =   14975
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin VB.Timer Timer1 
      Left            =   3480
      Top             =   2760
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   2160
      Top             =   2760
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin RichTextLib.RichTextBox RichTextBox1 
      Height          =   5535
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   8295
      _ExtentX        =   14631
      _ExtentY        =   9763
      _Version        =   393217
      Enabled         =   -1  'True
      ScrollBars      =   2
      TextRTF         =   $"Form1.frx":0000
   End
   Begin VB.Menu mfile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnew 
         Caption         =   "新建（&N）"
         Shortcut        =   ^N
      End
      Begin VB.Menu mopen 
         Caption         =   "打开（&O）"
         Shortcut        =   ^O
      End
      Begin VB.Menu msave 
         Caption         =   "保存（&S）"
         Shortcut        =   ^S
      End
      Begin VB.Menu msaveas 
         Caption         =   "另存为（&A）"
      End
      Begin VB.Menu mseparate1 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mpageset 
         Caption         =   "页面设置（&U）"
      End
      Begin VB.Menu mprint 
         Caption         =   "打印（&P）"
      End
      Begin VB.Menu mseparate2 
         Caption         =   "-"
         Index           =   2
      End
      Begin VB.Menu mexit 
         Caption         =   "退出（&X）"
      End
   End
   Begin VB.Menu medit 
      Caption         =   "编辑（&E）"
      Begin VB.Menu mback 
         Caption         =   "撤消（&U）"
         Shortcut        =   ^Z
      End
      Begin VB.Menu mseparate3 
         Caption         =   "-"
         Index           =   3
      End
      Begin VB.Menu mcut 
         Caption         =   "剪切（&T）"
         Shortcut        =   ^X
      End
      Begin VB.Menu mcopy 
         Caption         =   "复制（&C）"
         Shortcut        =   ^C
      End
      Begin VB.Menu mpaste 
         Caption         =   "粘贴（&V）"
         Shortcut        =   ^V
      End
      Begin VB.Menu mdelete 
         Caption         =   "删除（&L）"
         Shortcut        =   {DEL}
      End
      Begin VB.Menu mseparate4 
         Caption         =   "-"
         Index           =   4
      End
      Begin VB.Menu mfind 
         Caption         =   "查找（&F）"
         Shortcut        =   ^F
      End
      Begin VB.Menu mfindnext 
         Caption         =   "查找下一个（&N）"
         Shortcut        =   {F3}
      End
      Begin VB.Menu mexchange 
         Caption         =   "替换（&R）"
         Shortcut        =   ^H
      End
      Begin VB.Menu mgoto 
         Caption         =   "转到（&G）"
         Shortcut        =   ^G
      End
      Begin VB.Menu mseparate5 
         Caption         =   "-"
         Index           =   5
      End
      Begin VB.Menu mselectall 
         Caption         =   "全选（&A）"
         Shortcut        =   ^A
      End
      Begin VB.Menu mdatetime 
         Caption         =   "时间/日期（&D）"
         Shortcut        =   {F5}
      End
   End
   Begin VB.Menu mformat 
      Caption         =   "格式（&0）"
      Begin VB.Menu mautoenter 
         Caption         =   "自动换行（&W）"
      End
      Begin VB.Menu mfont 
         Caption         =   "字体（&F）"
      End
   End
   Begin VB.Menu mview 
      Caption         =   "查看（&V）"
      Begin VB.Menu mstatus 
         Caption         =   "状态栏（&S）"
      End
   End
   Begin VB.Menu mhelp 
      Caption         =   "帮助（&H）"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ask As Integer
Dim filename, filetype, filetype1, sfind, flag, msg As String
Dim change, bWrap As Boolean
Private Sub Form_Load()
Form1.Caption = "无标题-笔记本"
RichTextBox1.Text = ""
mpaste.Enabled = False
mcut.Enabled = False
mback.Enabled = False
mfind.Enabled = False
mdelete.Enabled = False
mcopy.Enabled = False
mfindnext.Enabled = False
mgoto.Enabled = False
mstatus.Enabled = True
StatusBar1.Visible = False
StatusBar1.Panels(1).Text = Time
If Clipboard.GetText <> "" Then
mpaste.Enabled = True
Else
mpaste.Enabled = False
End If
change = False

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If change = True Then
ask = MsgBox("文件" + Form1.Caption + "的文字已经改变,想保存文件吗?", vbYesNoCancel)
If ask = vbYes Then
msaveas_Click
End
ElseIf ask = vbNo Then
End
End If
Cancel = True
Else
End If
End Sub

Private Sub Form_Resize()
RichTextBox1.top = ScaleTop
RichTextBox1.left = ScaleLeft
RichTextBox1.Height = ScaleHeight
RichTextBox1.Width = ScaleWidth

End Sub

Private Sub mautoenter_Click()
   WrapTextLine RichTextBox1, bWrap
    bWrap = Not bWrap
    If mautoenter.Checked = False Then
        mautoenter.Checked = True
        
    Else
        mautoenter.Checked = False
        
    End If
End Sub

Private Sub mback_Click()
ls = SendMessage(RichTextBox1.hwnd, &H304, 0, 0)
RichTextBox1.SetFocus
End Sub

Private Sub mcopy_Click()
Clipboard.Clear
Clipboard.SetText RichTextBox1.SelText
End Sub

Private Sub mcut_Click()
Clipboard.Clear
Clipboard.SetText RichTextBox1.SelText
RichTextBox1.SelText = ""
End Sub

Private Sub mdatetime_Click()
dstring = FormatDateTime(Now, 4) + Space(4) + FormatDateTime(Now, 2)
SendKeys dstring
End Sub

Private Sub mdelete_Click()
RichTextBox1.SelText = ""
End Sub

Private Sub medit_Click()
If RichTextBox1.SelText <> "" Then
        mopen.Enabled = True
        mcut.Enabled = True
        mdelete.Enabled = True
        mcopy.Enabled = True
    End If
    If Len(RichTextBox1.Text) <> 0 Then
        mfind.Enabled = True
        mfindnext.Enabled = True
        mexchange.Enabled = True
    End If
    If change = True Then
    mexit.Enabled = True
    mback.Enabled = True
    End If
End Sub

Private Sub mexchange_Click()
Form2.Show
End Sub

Private Sub mexit_Click()
If change = True Then
ask = MsgBox("文件" + Form1.Caption + "的文字已经改变。想保存文件吗？", vbYesNoCancel)
If ask = vbYes Then
msave_Click
ElseIf ask = vbNo Then
End
End If
Else
End If
End
End Sub

Private Sub mfind_Click()
sfind = InputBox("请输入要查找的字、词：", "查找内容", sfind)
RichTextBox1.Find sfind
If RichTextBox1.SelText = "" Then
ask = MsgBox("没有找到" + sfind, vbOKOnly)
End If
End Sub

Private Sub mfindnext_Click()
 RichTextBox1.SelStart = RichTextBox1.SelStart + RichTextBox1.SelLength + 1
 RichTextBox1.Find sfind, , Len(RichTextBox1)
 If RichTextBox1.SelText = "" Then
 ask = MsgBox("没有找到" + sfind, vbOKOnly)
 End If
End Sub

Private Sub mfont_Click()
On Error Resume Next
    CommonDialog1.flags = &H3 Or &H1 Or &H2 Or &H100
    CommonDialog1.Action = 4
    RichTextBox1.Font.Name = CommonDialog1.FontName
    RichTextBox1.Font.Size = CommonDialog1.FontSize
    RichTextBox1.Font.Bold = CommonDialog1.FontBold
    RichTextBox1.Font.Italic = CommonDialog1.FontItalic
    RichTextBox1.Font.Underline = CommonDialog1.FontUnderline
    RichTextBox1.SelColor = CommonDialog1.Color
End Sub

Private Sub mhelp_Click()
Form3.Show
End Sub

Private Sub mnew_Click()
On Error Resume Next
    If change = True Then
    ask = MsgBox("文件" + Form1.Caption + "已经改变。是否保存文件？", vbYesNoCancel)
    If ask = vbYes Then
    msaveas_Click
    RichTextBox1.Text = ""
    Me.Caption = "无标题-记事本"
    ElseIf ask = vbNo Then
    RichTextBox1.Text = ""
    Me.Caption = "无标题-记事本"
    ElseIf ask = vbCancel Then
    Exit Sub
    End If
    End If
    
End Sub

Private Sub mopen_Click()
CommonDialog1.Filter = "文本文档(*.txt)|*.txt|所有文件(*.*)|*.*"
CommonDialog1.ShowOpen
RichTextBox1.Text = "" '清空文本框
filename = CommonDialog1.filename
RichTextBox1.LoadFile filename
Me.Caption = "记事本：" & filename

End Sub

Private Sub mpageset_Click()
 psdlg.lStructSize = Len(psdlg)
      psdlg.hwndOwner = hwnd
      PageSetupDlg psdlg
End Sub

Private Sub mpaste_Click()
RichTextBox1.SelText = Clipboard.GetText
End Sub

Private Sub mprint_Click()
Dim f As Integer, t As Integer
    Dim i As Integer
    CommonDialog1.CancelError = True
    CommonDialog1.Max = 1000
    CommonDialog1.Min = 1
    On Error Resume Next
    CommonDialog1.ShowPrinter
       For f = CommonDialog1.FromPage To t = CommonDialog1.ToPage
        Do While i < CommonDialog1.Copies + 1
            Printer.Print RichTextBox1.Text
            i = i + 1
        Loop
    Next
    Printer.EndDoc
Cancel:
If Err.Number = 32755 Then
    Exit Sub
    End If
End Sub

Private Sub msave_Click()
 CommonDialog1.Filter = "文本文档(*.txt)|所有文件(*.*)|*.*"
    On Error Resume Next
    filename = CommonDialog1.filename   '保存文件
        If filename <> "" Then
        RichText.SaveFile filename, rtfText
        Else
            msaveas_Click
        End If
     ask = False
End Sub

Private Sub msaveas_Click()
    CommonDialog1.Filter = "文本文档(*.txt)|所有文件(*.*)|*.*"
    On Error Resume Next
    CommonDialog1.ShowSave
    filename = CommonDialog1.filename
    RichTextBox1.SaveFile filename, rtfText
    msg = GetFileTitle(CommonDialog1.filename)
    Me.Caption = "记事本：" & filename
    change = False
End Sub

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

Private Sub mstatus_Click()
If mstatus.Checked Then
StatusBar1.Visible = False
mstatus.Checked = False
Else
StatusBar1.Visible = True
mstatus.Checked = True
    End If
End Sub

Private Sub RichTextBox1_Change()
change = True
End Sub

Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
PopupMenu medit, vbPopupMenuLeftAlign
Else
Exit Sub
End If
End Sub

Private Sub Timer1_Timer()
If StatusBar1.Panels(1).Text <> CStr(Time) Then
StatusBar1.Panels(1).Text = Time
End Sub