frmnote.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 frmNote 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "无标题—记事本"
   ClientHeight    =   9165
   ClientLeft      =   1035
   ClientTop       =   1710
   ClientWidth     =   11925
   LinkTopic       =   "Form1"
   ScaleHeight     =   9165
   ScaleWidth      =   11925
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   11160
      Top             =   1440
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   405
      Left            =   0
      TabIndex        =   1
      Top             =   8760
      Visible         =   0   'False
      Width           =   11925
      _ExtentX        =   21034
      _ExtentY        =   714
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   10760
            MinWidth        =   10760
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Alignment       =   2
            Object.Width           =   11466
            MinWidth        =   11466
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   11280
      Top             =   8400
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin RichTextLib.RichTextBox rtfText 
      Height          =   8655
      Left            =   240
      TabIndex        =   0
      Top             =   0
      Width           =   10695
      _ExtentX        =   18865
      _ExtentY        =   15266
      _Version        =   393217
      Enabled         =   -1  'True
      HideSelection   =   0   'False
      ScrollBars      =   3
      RightMargin     =   1
      TextRTF         =   $"frmNote.frx":0000
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuNew 
         Caption         =   "新建(&N)"
      End
      Begin VB.Menu mnuOpen 
         Caption         =   "打开(&O)"
      End
      Begin VB.Menu mnuSave 
         Caption         =   "保存(&S)"
      End
      Begin VB.Menu mnuOtherSave 
         Caption         =   "另存为(&A)"
      End
      Begin VB.Menu mnustep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEnd 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mnuCancle 
         Caption         =   "撤销(&U)"
      End
      Begin VB.Menu mnuEditStep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCut 
         Caption         =   "剪切(&T)"
      End
      Begin VB.Menu mnuCopy 
         Caption         =   "复制(&C)"
      End
      Begin VB.Menu mnuPaste 
         Caption         =   "粘贴(&P)"
      End
      Begin VB.Menu mnuDelete 
         Caption         =   "删除(&L)"
      End
      Begin VB.Menu mnuEditStep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFind 
         Caption         =   "查找(&F)"
      End
      Begin VB.Menu mnuDisplace 
         Caption         =   "替换(&R)"
      End
      Begin VB.Menu mnuEditStep3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuChAll 
         Caption         =   "全选(&A)"
      End
      Begin VB.Menu mnuTime 
         Caption         =   "时间/日期(&D)"
      End
   End
   Begin VB.Menu mnuFomat 
      Caption         =   "格式(&O)"
      Begin VB.Menu mnuEnter 
         Caption         =   "自动换行(&W)"
      End
      Begin VB.Menu mnuFont 
         Caption         =   "字体(&F)..."
      End
   End
   Begin VB.Menu mnuScan 
      Caption         =   "查看(&K)"
      Begin VB.Menu mnuState 
         Caption         =   "状态栏(&Z)"
      End
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "关于(&G)"
   End
End
Attribute VB_Name = "frmNote"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_UNDO = &HC7
Private Const EM_CANUNDO = &HC6
Dim TextChange As Boolean
Dim FileName As String
Dim FileTitle As String
Dim NewText As Boolean
Private Sub Form_Load()
 frmNote.Show
 rtfText.Text = ""
 TextChange = False
 NewText = True
 rtfText.SetFocus
 mnuEnter.Checked = True
 FileName = ""
 StatusBar1.Panels(1).Text = "无标题"
End Sub

Private Sub Form_Paint()
 rtfText.Left = 20
 rtfText.Top = 20
 rtfText.Width = frmNote.ScaleWidth - 40
 If mnuState.Checked = True Then
  rtfText.Height = frmNote.ScaleHeight - StatusBar1.Height
 Else
  rtfText.Height = frmNote.ScaleHeight - 40
 End If
 StatusBar1.Panels(1).AutoSize = sbrSpring
StatusBar1.Panels(2).AutoSize = sbrSpring
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 If TextChange = True Then
  msg = MsgBox("文件" + CommonDialog1.FileName + "的文字已经改变。" + vbCrLf + "想保存文件吗?", vbExclamation + vbYesNoCancel, "记事本")
  If msg = vbYes Then
    If FileName = "" Then
     Call mnuOtherSave_Click
    Else
     rtfText.SaveFile FileName, 1
    End If
  ElseIf msg = vbCancel Then
   Cancel = True
  End If
 End If
End Sub


Private Sub mnuAbout_Click()
 frmAbout.Show , Me
End Sub

Private Sub mnuCancle_Click() '撤销
 Call SendMessage(rtfText.hwnd, EM_UNDO, 0, 0)
End Sub

Private Sub mnuChAll_Click() '全选
 rtfText.SelStart = 0
 rtfText.SelLength = Len(rtfText.Text)
End Sub

Private Sub mnuCopy_Click() '复制
Cut = False
Clipboard.Clear
Clipboard.SetText rtfText.SelText
End Sub

Private Sub mnuCut_Click() '剪切
Clipboard.Clear
Clipboard.SetText rtfText.SelText
rtfText.SelText = ""
Cut = True
End Sub

Private Sub mnuDelete_Click() '删除
rtfText.SelText = ""
End Sub

Private Sub mnuDisplace_Click()
frmRpl.Show , Me
End Sub

Private Sub mnuEdit_Click() '编辑
 If Me.rtfText.SelText = "" Then
  mnuCut.Enabled = False
  mnuCopy.Enabled = Fals
  mnuDelete.Enabled = False
 Else
  mnuCut.Enabled = True
  mnuCopy.Enabled = True
  mnuDelete.Enabled = True
 End If
 If Clipboard.GetText = "" Then
  mnuPaste.Enabled = False
  Else
   mnuPaste.Enabled = True
 End If
If SendMessage(rtfText.hwnd, EM_CANUNDO, 0, 0) Then
 mnuCancle.Enabled = True
Else
 mnuCancle.Enabled = False
End If
End Sub

Private Sub mnuEnd_Click() '结束
Unload frmNote
End Sub

Private Sub mnuEnter_Click()
mnuEnter.Checked = Not mnuEnter.Checked
If mnuEnter.Checked = True Then
    rtfText.RightMargin = 0
Else
   rtfText.RightMargin = 250000
End If
End Sub

Private Sub mnuFind_Click()
frmFind.Show , Me
End Sub

Private Sub mnuFont_Click() '字体
CommonDialog1.Flags = cdlCFScreenFonts
CommonDialog1.FontName = rtfText.Font.Name
CommonDialog1.FontSize = rtfText.Font.Size
CommonDialog1.FontBold = rtfText.Font.Bold
CommonDialog1.FontItalic = rtfText.Font.Italic
CommonDialog1.ShowFont
rtfText.Font.Name = CommonDialog1.FontName
rtfText.Font.Bold = CommonDialog1.FontBold
rtfText.Font.Italic = CommonDialog1.FontItalic
rtfText.Font.Size = CommonDialog1.FontSize

End Sub



Private Sub mnuHelp_Click()
'frmAbout.Show , Me
rtfText.Text = rtfText.SelStart
End Sub

Private Sub mnuNew_Click() '新建
 Dim msg As Integer
 If TextChange = True Then
  msg = MsgBox("文件" + CommonDialog1.FileName + "的文字已经改变。" + vbCrLf + "想保存文件吗?", vbExclamation + vbYesNoCancel, "记事本")
  If msg = vbYes Then
    Call mnuSave_Click
  ElseIf msg = vbCancel Then
   Exit Sub
  End If
 End If
  rtfText.Text = ""
  FileTitle = "无标题"
  frmNote.Caption = "无标题-记事本"
  NewText = True
 TextChange = False
 rtfText.SetFocus
 StatusBar1.Panels(1).Text = "无标题"
End Sub

Private Sub mnuOpen_Click() '打开
 Dim str As String
 Dim Flag As String
If TextChange = True Then '文件是否改变，若改变是否保存
  msg = MsgBox("文件" + CommonDialog1.FileName + "的文字已经改变。" + vbCrLf + "想保存文件吗?", vbExclamation + vbYesNoCancel, "记事本")
  If msg = vbYes Then
     Call mnuSave_Click
  ElseIf msg = vbCancel Then
     Exit Sub
  End If
End If
 CommonDialog1.Filter = "所有文件*.*|*.*|*.txt|*.txt"
 CommonDialog1.FilterIndex = 2
 CommonDialog1.FileName = ""  ''取消异常
 CommonDialog1.ShowOpen
 Flag = ""
 Flag = CommonDialog1.FileName
 If Flag <> "" Then
   FileName = CommonDialog1.FileName
   If Dir(FileName, vbNormal) = "" Then '判断文件存在否
   y = MsgBox("文件不存在！", vbInformation, "记事本")
   Else
     rtfText.Text = ""
   
     frmNote.Caption = CommonDialog1.FileTitle + "—记事本"
     rtfText.LoadFile FileName, 1
      StatusBar1.Panels(1).Text = FileName
     TextChange = False
     NewText = False
  End If
 End If
  StatusBar1.Panels(1).Text = FileName
End Sub

Private Sub mnuOtherSave_Click() '另存为
 Dim Flag As String
 CommonDialog1.FileName = ""
 CommonDialog1.Filter = "*.txt|*.txt"
 CommonDialog1.ShowSave
 Flag = CommonDialog1.FileName
 If Flag <> "" Then '消除不保存异常
   If Dir(Flag, vbNormal) <> "" Then '判断文件存在否
    y = MsgBox("文件已存在！" + vbCrLf + "是否替换？", vbExclamation + vbYesNoCancel, "记事本")
     If y <> vbYes Then
       Exit Sub
     End If
   End If
     FileName = Flag
     rtfText.SaveFile FileName, 1
     Me.Caption = CommonDialog1.FileTitle & "-记事本"
     TextChange = False
     NewText = False
     StatusBar1.Panels(1).Text = FileName
 End If
End Sub

Private Sub mnuPaste_Click() '粘贴
 rtfText.SelText = Clipboard.GetText
 If Cut = True Then
 Clipboard.Clear
 End If
End Sub

Private Sub mnuSave_Click() '保存
Dim Flag As String
If NewText = True Then
 Call mnuOtherSave_Click
Else
  rtfText.SaveFile FileName, 1
  TextChange = False
End If
End Sub

Private Sub mnuState_Click()
   If StatusBar1.Visible = True Then
        mnuState.Checked = False
        StatusBar1.Visible = False
   Else
        mnuState.Checked = True
        StatusBar1.Visible = True
   End If
 If mnuState.Checked = True Then
  rtfText.Height = frmNote.ScaleHeight - StatusBar1.Height
 Else
  rtfText.Height = frmNote.ScaleHeight - 40
 End If
End Sub

Private Sub mnuTime_Click()
rtfText.SelText = Now
End Sub

Private Sub mnuYM_Click()
 CommonDialog1.ShowPrinter
End Sub

Private Sub rtfText_Change()
TextChange = True
End Sub


Private Sub rtfText_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
 If Button = 2 Then
  PopupMenu mnuEdit
 End If
End Sub

Private Sub Timer1_Timer()
 StatusBar1.Panels(2).Text = str(Now()) + "  "
End Sub