notebook.frm

这是小弟刚学VB时的课件作业

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 
   AutoRedraw      =   -1  'True
   Caption         =   "记事本"
   ClientHeight    =   5325
   ClientLeft      =   165
   ClientTop       =   2820
   ClientWidth     =   8190
   LinkTopic       =   "Form1"
   ScaleHeight     =   5325
   ScaleWidth      =   8190
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   3120
      Top             =   1200
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   1
      Top             =   5070
      Width           =   8190
      _ExtentX        =   14446
      _ExtentY        =   450
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   5
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   2
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            AutoSize        =   1
            Object.Width           =   3096
            TextSave        =   "2004-9-23"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   3
            AutoSize        =   2
            Enabled         =   0   'False
            TextSave        =   "Ins"
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   2
            AutoSize        =   2
            TextSave        =   "NUM"
         EndProperty
         BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   7
            AutoSize        =   1
            Enabled         =   0   'False
            Object.Width           =   3096
            TextSave        =   "KANA"
         EndProperty
      EndProperty
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      Left            =   0
      TabIndex        =   3
      Top             =   4800
      Visible         =   0   'False
      Width           =   7935
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   5295
      Left            =   7920
      TabIndex        =   2
      Top             =   0
      Visible         =   0   'False
      Width           =   255
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   960
      Top             =   840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      DefaultExt      =   ".txt"
   End
   Begin RichTextLib.RichTextBox RichText 
      Height          =   5535
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   8175
      _ExtentX        =   14420
      _ExtentY        =   9763
      _Version        =   393217
      BorderStyle     =   0
      Enabled         =   -1  'True
      ScrollBars      =   3
      AutoVerbMenu    =   -1  'True
      OLEDragMode     =   0
      OLEDropMode     =   0
      TextRTF         =   $"notebook.frx":0000
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Menu mnufile 
      Caption         =   "文件（&F）"
      Begin VB.Menu mnunewfile 
         Caption         =   "新建（&N）"
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuopen 
         Caption         =   "打开（&O）..."
         Shortcut        =   ^O
      End
      Begin VB.Menu mnusave 
         Caption         =   "保存（&S）"
         Shortcut        =   ^S
      End
      Begin VB.Menu mnusaveas 
         Caption         =   "另存为（&A）..."
      End
      Begin VB.Menu mnuline 
         Caption         =   "-"
      End
      Begin VB.Menu mnupagesetup 
         Caption         =   "页面设置（&U）..."
      End
      Begin VB.Menu mnuprint 
         Caption         =   "打印（&P）..."
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuline2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuexit 
         Caption         =   "退出（&X）"
      End
   End
   Begin VB.Menu mnuedit 
      Caption         =   "编辑（&E）"
      Begin VB.Menu mnucancel 
         Caption         =   "撤销（&U）"
         Shortcut        =   ^Z
      End
      Begin VB.Menu mnueditline1 
         Caption         =   "-"
      End
      Begin VB.Menu mnucut 
         Caption         =   "剪切（&T）"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnucopy 
         Caption         =   "复制（&C）"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuplaster 
         Caption         =   "粘贴（&P）"
         Shortcut        =   ^V
      End
      Begin VB.Menu mnudel 
         Caption         =   "删除（&L）"
         Shortcut        =   {DEL}
      End
      Begin VB.Menu mnueditline2 
         Caption         =   "-"
      End
      Begin VB.Menu mnufound 
         Caption         =   "查找（&F）..."
         Shortcut        =   ^F
      End
      Begin VB.Menu mnufoundnext 
         Caption         =   "查找下一个（&N）"
         Shortcut        =   {F3}
      End
      Begin VB.Menu mnureplace 
         Caption         =   "替换（&R）..."
         Shortcut        =   ^H
      End
      Begin VB.Menu mnugoto 
         Caption         =   "转到（&G）..."
         Shortcut        =   ^G
      End
      Begin VB.Menu mnueditline3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuall 
         Caption         =   "全选（&A）"
         Shortcut        =   ^A
      End
      Begin VB.Menu mnutimedate 
         Caption         =   "时间/日期（&D）"
         Shortcut        =   {F6}
      End
   End
   Begin VB.Menu mnuformat 
      Caption         =   "格式（&O）"
      Begin VB.Menu mnuwordwrap 
         Caption         =   "自动换行（&W）"
      End
      Begin VB.Menu mnufont 
         Caption         =   "字体（&F）..."
      End
   End
   Begin VB.Menu mnusee 
      Caption         =   "查看（&V）"
      Begin VB.Menu mnustatusbar 
         Caption         =   "状态栏（&S）"
      End
   End
   Begin VB.Menu mnuhelp 
      Caption         =   "帮助（&H）"
      Begin VB.Menu mnuhelptopic 
         Caption         =   "帮助主题（&H）"
      End
      Begin VB.Menu mnuhelpline1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuabout 
         Caption         =   "关于记事本（&A）"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim filename As String
Dim FileType As String
Dim FiType As String
Dim sFind As String
Dim result As String
Dim bWrap As Boolean
Dim ask As Boolean
Dim msgtext As String
Dim Flag As String


Private Sub Form_Load()
    ask = False
    RichText.Text = ""
    filename = "无标题-记事本"
    Form1.Caption = "无标题-记事本"
    RichText.Height = Form1.ScaleHeight
    RichText.Width = Form1.ScaleWidth
    StatusBar1.Visible = False
    StatusBar1.Panels(1).Text = Time
    mnucopy.Enabled = False
    mnucut.Enabled = False
    mnufound.Enabled = False
    mnufoundnext.Enabled = False
    mnudel.Enabled = False
    mnucancel.Enabled = False
    mnuwordwrap.Checked = True
    mnugoto.Enabled = False
    If Clipboard.GetText <> "" Then
        mnuplaster.Enabled = True
    Else
        mnuplaster.Enabled = False
    End If
    App.HelpFile = App.Path & "\notepad.chm"
End Sub

Private Sub Form_Resize()
    RichText.Height = Form1.ScaleHeight
    RichText.Width = Form1.ScaleWidth
End Sub

Private Sub Form_Unload(Cancel As Integer)
    msgtext = "文件" & filename & "的文字已经改变。" & Chr(10) & Chr(13) & "想保存文件吗？"
    If ask = True Then
        Flag = MsgBox(msgtext, 35, "记事本") ' 35=32+3
            If Flag = vbYes Then mnusave_Click '选择了确定则保存之
            If Flag = vbCancel Then Cancel = True
            If Flag = vbNo Then Unload Me
    End If
    
End Sub

Private Sub mnuabout_Click()
    MsgBox "记事本  版权所有(C) 2004 薛永", vbOKOnly, "关于"
End Sub

Private Sub mnuall_Click()
    RichText.SelStart = 0
    RichText.SelLength = Len(RichText.Text)
End Sub

Private Sub mnucancel_Click()
    MsgBox "请点击鼠标右键撤销！", vbOKOnly, "提示"
End Sub

Private Sub mnucopy_Click()
    Clipboard.Clear
    Clipboard.SetText RichText.SelText
End Sub

Private Sub mnucut_Click()
    Clipboard.Clear
    Clipboard.SetText RichText.SelText
    RichText.SelText = ""

End Sub

Private Sub mnudel_Click()
    RichText.SelText = ""
End Sub

Private Sub mnuedit_Click()
     If RichText.SelText <> "" Then
        mnuopen.Enabled = True
        mnucut.Enabled = True
        mnudel.Enabled = True
        mnucopy.Enabled = True
    End If
    If Len(RichText.Text) <> 0 Then
        mnufound.Enabled = True
        mnufoundnext.Enabled = True
    End If
    If ask = True Then mnucancel.Enabled = True
End Sub

Private Sub mnuexit_Click()
Unload Me
End Sub

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

Private Sub mnufound_Click()
    sFind = InputBox("请输入要查找的字、词：", "查找内容", sFind)
    RichText.Find sFind
End Sub

Private Sub mnufoundnext_Click()
    RichText.SelStart = RichText.SelStart + RichText.SelLength + 1
    RichText.Find sFind, , Len(RichText)

End Sub



Private Sub mnuhelptopic_Click()
    SendKeys "{F1}"
End Sub

Private Sub mnunewfile_Click()
    On Error Resume Next
    Dim n As Integer
    msgtext = "文件" & filename & "的文字已经改变。" & Chr(10) & Chr(13) & "想保存文件吗？"
    If Len(RichText.Text) <> 0 Then
        If filename = "无标题-记事本" Then
            Flag = MsgBox(msgtext, 35, "记事本") '给予提示
                If Flag = vbYes Then
                    mnusaveas_Click
                    RichText.Text = ""
                    Form1.Caption = "无标题-记事本"
                    filename = "无标题-记事本"
                End If
                If Flag = vbCancel Then Exit Sub
                If Flag = vbNo Then
                    RichText.Text = ""
                    Form1.Caption = "无标题-记事本"
                    filename = "无标题-记事本"
                End If
        End If
    End If
End Sub

Private Sub mnuopen_Click()
    msgtext = "文件" & filename & "的文字已经改变。" & Chr(10) & Chr(13) & "想保存文件吗？"
    On Error Resume Next
    If ask = True Then
        Flag = MsgBox(msgtext, 35, "记事本") '给予提示
            If Flag = vbYes Then mnusave_Click '选择了确定则保存之
            If Flag = vbCancel Then Exit Sub
            If Flag = vbNo Then GoTo L1
    End If
    ask = False

   
L1: CommonDialog1.Filter = "文本文档(*.txt)|*.txt|RTF文档(*.rtf)|*.rtf|所有文件(*.*)|*.*"
    CommonDialog1.ShowOpen
    RichText.Text = "" '清空文本框
    filename = CommonDialog1.filename
    RichText.LoadFile filename
    result = GetFileTitle(filename)
    Me.Caption = "" & result & "-记事本"

End Sub

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

Private Sub mnuplaster_Click()
    RichText.SelText = Clipboard.GetText(1)
End Sub

Private Sub mnuprint_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 RichText.Text
            i = i + 1
        Loop
    Next
    Printer.EndDoc
Cancel:
If Err.Number = 32755 Then
    Exit Sub
    End If
End Sub

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


Private Sub mnusaveas_Click()
    CommonDialog1.Filter = "文本文档(*.txt)|所有文件(*.*)|*.*"
    On Error Resume Next
    
    CommonDialog1.ShowSave
    filename = CommonDialog1.filename
    RichText.SaveFile filename, rtfText
       
    result = GetFileTitle(filename)
    Me.Caption = "" & result & "-记事本"
    ask = False
End Sub

Private Sub mnustatusbar_Click()
    If mnustatusbar.Checked Then
        StatusBar1.Visible = False
        mnustatusbar.Checked = False
    Else
        StatusBar1.Visible = True
        mnustatusbar.Checked = True
    End If
    
End Sub

Private Sub mnutimedate_Click()
    RichText.SelText = Format(Now, "h:mm ddddd")
End Sub

Private Sub mnuwordwrap_Click()
    WrapTextLine RichText, bWrap
    bWrap = Not bWrap
    If mnuwordwrap.Checked = False Then
        HScroll1.Enabled = True
        mnuwordwrap.Checked = True
        
    Else
        HScroll1.Enabled = False
        mnuwordwrap.Checked = False
        
    End If
    
End Sub

Private Sub RichText_Change()
    ask = True
End Sub



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

End Sub