⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 vb学习
💻 FRM
字号:
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "Richtx32.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5235
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6615
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   MousePointer    =   99  'Custom
   ScaleHeight     =   5235
   ScaleWidth      =   6615
   Begin RichTextLib.RichTextBox RichTextBox1 
      Height          =   4335
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5655
      _ExtentX        =   9975
      _ExtentY        =   7646
      _Version        =   393217
      BorderStyle     =   0
      HideSelection   =   0   'False
      ScrollBars      =   3
      TextRTF         =   $"Form1.frx":0000
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strFile As String
Dim strFind As String
Dim bChanged As Boolean

Property Get HasChanged() As Boolean
    HasChanged = bChanged
End Property
Property Let HasChanged(b As Boolean)
    bChanged = b
End Property

Sub SaveFile()
    If Me.OpenFile <> "" Then
        Me.RichTextBox1.SaveFile Me.OpenFile, rtfText
        bChanged = False
    Else
        With MDIForm1.CommonDialog1
            .Filter = " 所有文件(*.*)|*.*"
            '设置标志为当文件已经存在时提示是否覆盖
            .Flags = cdlOFNOverwritePrompt
            .ShowSave
            If .FileName <> "" Then     '用户输入了正确的文件名并按确定键
                Me.RichTextBox1.SaveFile .FileName, rtfText
                Me.OpenFile = .FileName
                Me.Caption = .FileName
                bChanged = False
            End If
        End With
    End If
End Sub
Sub SaveFileAs()
    With MDIForm1.CommonDialog1
        .FileName = Me.OpenFile
        .Flags = cdlOFNOverwritePrompt
        .Filter = " 所有文件(*.*)|*.*"
        .ShowSave
        If .FileName <> "" Then
            Me.RichTextBox1.SaveFile .FileName, rtfText
            Me.OpenFile = .FileName
            Me.Caption = .FileName
            bChanged = False
        End If
    End With
End Sub
Property Get FindStr() As String
    FindStr = strFind
End Property
Property Let FindStr(sFind As String)
    strFind = sFind
End Property
Property Get OpenFile() As String
    OpenFile = strFile
End Property
Property Let OpenFile(sFile As String)
    strFile = sFile
End Property

Private Sub Form_Activate()
    RichTextBox1_SelChange
End Sub

Private Sub Form_Load()
    Me.FindStr = ""
    With MDIForm1
        .mEdit.Visible = True
        .mFilePrint.Enabled = True
        .mFileSave.Enabled = True
        .mFileSaveAs.Enabled = True
        .mWindow.Visible = True
    End With
    With MDIForm1
        For i = 1 To .Toolbar1.Buttons.Count
            .Toolbar1.Buttons(i).Enabled = True
        Next i
    End With
    RichTextBox1.RightMargin = 300000
    RichTextBox1_SelChange
End Sub

Private Sub Form_Resize()
    With RichTextBox1
        .Width = Me.ScaleWidth
        .Height = Me.ScaleHeight
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim iCount As Integer
    Dim aForm

    For Each aForm In Forms
        If aForm.Name = "Form1" Then iCount = iCount + 1
    Next

    If iCount = 1 Then
        With MDIForm1
            .mEdit.Visible = False
            .mFilePrint.Enabled = False
            .mFileSave.Enabled = False
            .mFileSaveAs.Enabled = False
            .mWindow.Visible = False
            
        End With
    End If
    
    If bChanged Then
        a = MsgBox("是否保存 " + Me.Caption, vbYesNoCancel Or vbExclamation)
        If a = vbYes Then
            Me.SaveFile
            If Me.OpenFile = "" Then
                Cancel = 1
            End If
        ElseIf a = vbCancel Then
            Cancel = 1
        End If
    End If
    With MDIForm1
        For i = 1 To .Toolbar1.Buttons.Count
            .Toolbar1.Buttons(i).Enabled = False
        Next i
        .Toolbar1.Buttons("New").Enabled = True
        .Toolbar1.Buttons("Open").Enabled = True
    End With
End Sub

Private Sub RichTextBox1_Change()
    bChanged = True
    
    If SendMessageByRef(RichTextBox1.hwnd, EM_CANUNDO, ByVal 0, ByVal 0) Then
        MDIForm1.mEditUndo.Enabled = True
        MDIForm1.Toolbar1.Buttons("Undo").Enabled = True
    Else
        MDIForm1.mEditUndo.Enabled = False
        MDIForm1.Toolbar1.Buttons("Undo").Enabled = False
    End If
    
    If SendMessageByRef(RichTextBox1.hwnd, EM_CANREDO, ByVal 0, ByVal 0) Then
        MDIForm1.mEditRedo.Enabled = True
        MDIForm1.Toolbar1.Buttons("Redo").Enabled = True
    Else
        MDIForm1.mEditRedo.Enabled = False
        MDIForm1.Toolbar1.Buttons("Redo").Enabled = False
    End If
End Sub

Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then
        PopupMenu MDIForm1.mEdit
    End If
End Sub

Private Sub RichTextBox1_SelChange()
    Dim LPos, L1, L2, iLineX, iLineY As Long
    
    LPos = SendMessageByRef(RichTextBox1.hwnd, EM_LINEINDEX, ByVal -1, ByVal 0)

    iLineY = SendMessageByRef(RichTextBox1.hwnd, EM_LINEFROMCHAR, ByVal LPos, ByVal 0)
    
    SendMessageByRef RichTextBox1.hwnd, EM_GETSEL, L1, L2
    iLineX = L1 - LPos
    MDIForm1.StatusBar1.Panels(1).Text = "行:" + Str(iLineY) + _
        "   列:" + Str(iLineX)
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -