mini_editor.frm

主要是一些文件操作的技巧

VERSION 5.00
Begin VB.Form Mini_Editor 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Interval        =   400
      Left            =   120
      Top             =   1800
   End
   Begin VB.TextBox Text1 
      Height          =   1335
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "Mini_Editor.frx":0000
      Top             =   480
      Width           =   3735
   End
   Begin VB.Label Label1 
      Caption         =   "1 of 1"
      Height          =   615
      Left            =   480
      TabIndex        =   1
      Top             =   2280
      Width           =   3735
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuFileNew 
         Caption         =   "&New"
      End
      Begin VB.Menu mnuFileOpen 
         Caption         =   "&Open"
      End
      Begin VB.Menu mnuFileSave 
         Caption         =   "&Save"
      End
      Begin VB.Menu mnuSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "&Edit"
      Begin VB.Menu mnuEditUndo 
         Caption         =   "&Undo"
      End
      Begin VB.Menu mnuSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditCut 
         Caption         =   "C&ut"
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "&Paste"
      End
      Begin VB.Menu mnuEditDelete 
         Caption         =   "&Delete"
      End
   End
End
Attribute VB_Name = "Mini_Editor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
Const MB_CAncel = 2
Const MB_YES = 6
Const MB_NO = 7
Const CTRL_MASK = 2
'
Dim OldPos As Integer
Dim OldTotal  As Integer
'
Function PromptSave()
    Dim Title As String
    Dim Msg As String
    Title = "文件已经改变"
    Msg = "是否保存改变？"
    PromptSave = MsgBox(Msg, 19, Title)
End Function
'
Private Sub Form_Resize()
    ' 保持文本框和标签始终为全屏
    Text1.Left = 0
    Text1.Top = 0
    Text1.Width = Me.ScaleWidth
    Text1.Height = Me.ScaleHeight - Label1.Height
    Label1.Left = 10
    Label1.Top = Me.ScaleHeight - Label1.Height
End Sub
'
Private Sub mnuFileExit_Click()
    Dim Button As Integer
    If TextModified(Text1) Then
        Button = PromptSave()
        Select Case Button
            Case MB_CAncel
                Exit Sub
            Case MB_YES
                ' 在这里写保存文件的代码
            Case Else
        End Select
    End If
    End
End Sub
'
Private Sub mnuFileNew_Click()
    Dim Button As Integer
    If TextModified(Text1) Then
        Button = PromptSave()
        Select Case Button
            Case MB_CAncel
                Exit Sub
            Case MB_YES
                ' 在这里写保存文件的代码
            Case Else
        End Select
    End If
    Text1.Text = ""
    TextClean Text1
End Sub
'
Private Sub mnuFileOpen_Click()
    Dim Button As Integer
    If TextModified(Text1) Then
        Button = PromptSave()
        Select Case Button
            Case MB_CAncel
                Exit Sub
            Case MB_YES
                ' 在这里写保存文件的代码
            Case Else
        End Select
    End If
    Text1.Text = "在这里添加打开文件的代码"
    TextClean Text1
End Sub
'
Private Sub mnuFileSave_Click()
    ' 在这里写保存文件的代码
    TextClean Text1
End Sub
'
Private Sub mnuEditUndo_Click()
    EditUndo Text1
End Sub
'
Private Sub mnuEditCut_Click()
    EditCut Text1
End Sub
'
Private Sub mnuEditCopy_Click()
    EditCopy Text1
End Sub
'
Private Sub mnuEditPaste_Click()
    EditPaste Text1
End Sub
'
Private Sub mnuEditDelete_Click()
    EditClear Text1
End Sub
'
Private Sub Timer1_Timer()
    Dim CurLine As Integer
    Dim TLines As Integer
    CurLine = TextCurLine(Text1)
    TLines = TextLines(Text1)
    If CurLine <> OldPos Or TLines <> OldTotal Then
        Label1.Caption = Str(CurLine) + " Of" + Str(TLines)
        OldPos = CurLine
        OldTotal = TLines
    End If
End Sub
'
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    ' 下面代码实现Ctrl+Y快捷键删除整行的功能
    On Error GoTo LineDelErr
    Dim CurLine As Integer
    Dim LineLen As Integer
    If KeyCode = Asc("Y") And Shift = CTRL_MASK Then
        CurLine = TextCurLine(Text1) - 1
        Text1.SelStart = TextLineBegin(Text1, CurLine)
        LineLen = TextLineBegin(Text1, CurLine + 1) - Text1.SelStart
        Text1.SelLength = LineLen
        Text1.SelText = ""
    End If
    Exit Sub
LineDelErr:
End Sub