VB6 PRO DOCS

中文

English

中文

English

Appearance

TextBox Control (VBCCRTextBox) ​

VBCCRTextBox 控件是一个增强的文本框控件，提供了比标准 TextBox 更多的功能，包括撤销/重做、自动完成、拼写检查等特性。它可用于单行或多行文本输入。

属性 ​

关键属性 ​

  • Text: 文本内容
  • SelText: 选中的文本
  • SelStart: 选择起始位置
  • SelLength: 选择长度
  • MultiLine: 是否多行
  • ScrollBars: 滚动条
  • Alignment: 文本对齐方式
  • MaxLength: 最大文本长度
  • PasswordChar: 密码字符
  • Locked: 是否锁定
  • HideSelection: 失去焦点时是否隐藏选择
  • OLEDropMode: OLE拖放模式
  • CueBanner: 提示文本（占位符）
  • AutoComplete: 自动完成
  • UndoLimit: 撤销限制

方法 ​

主要方法 ​

  • SelAll(): 全选文本
  • Cut(): 剪切
  • Copy(): 复制
  • Paste(): 粘贴
  • Undo(): 撤销
  • Redo(): 重做
  • LoadFile(FileName As String): 加载文件
  • SaveFile(FileName As String): 保存文件
  • FindText(Text As String, [Start As Long], [Options As SearchOptionsConstants]): 查找文本

事件 ​

  • Change(): 文本改变事件
  • Click(): 点击事件
  • DblClick(): 双击事件
  • KeyDown(KeyCode As Integer, Shift As Integer)
  • KeyPress(KeyAscii As Integer)
  • KeyUp(KeyCode As Integer, Shift As Integer)
  • MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  • MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  • MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  • OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  • OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)

代码示例 ​

基本用法 ​

vb
Private Sub Form_Load()
    ' 配置文本框
    With TextBox1
        .MultiLine = True
        .ScrollBars = vbVertical
        .Text = "请在此输入..."
        .SelStart = 0
        .SelLength = Len(.Text)
        .CueBanner = "输入搜索关键词"
        .MaxLength = 1000
    End With
End Sub

文本处理 ​

vb
Private Sub ProcessText()
    With TextBox1
        ' 获取选中文本
        Dim SelectedText As String
        SelectedText = .SelText
        
        ' 替换选中文本
        .SelText = UCase$(SelectedText)
        
        ' 在光标位置插入文本
        .SelText = vbNewLine & "新行"
        
        ' 移动光标到末尾
        .SelStart = Len(.Text)
    End With
End Sub

撤销/重做支持 ​

vb
Private Sub SetupUndoRedo()
    With TextBox1
        .UndoLimit = 100  ' 设置撤销步数
        
        ' 添加编辑菜单项
        mnuEdit.Enabled = True
        mnuUndo.Enabled = .CanUndo
        mnuRedo.Enabled = .CanRedo
    End With
End Sub

Private Sub TextBox1_Change()
    ' 更新菜单状态
    mnuUndo.Enabled = TextBox1.CanUndo
    mnuRedo.Enabled = TextBox1.CanRedo
End Sub

Private Sub mnuUndo_Click()
    If TextBox1.CanUndo Then TextBox1.Undo
End Sub

Private Sub mnuRedo_Click()
    If TextBox1.CanRedo Then TextBox1.Redo
End Sub

常见用例 ​

查找和替换 ​

vb
Private Type FindSettings
    Text As String
    WholeWord As Boolean
    MatchCase As Boolean
    SearchUp As Boolean
End Type

Private FindOpts As FindSettings

Private Function FindNext() As Boolean
    Dim StartPos As Long
    Dim Options As Long
    
    With TextBox1
        ' 设置搜索选项
        If FindOpts.WholeWord Then Options = Options Or vbTextCompareWholeWord
        If FindOpts.MatchCase Then Options = Options Or vbBinaryCompare
        
        ' 设置开始位置
        If FindOpts.SearchUp Then
            StartPos = .SelStart - 1
            If StartPos < 0 Then StartPos = Len(.Text)
        Else
            StartPos = .SelStart + .SelLength
            If StartPos > Len(.Text) Then StartPos = 0
        End If
        
        ' 查找文本
        Dim Pos As Long
        Pos = .FindText(FindOpts.Text, StartPos, Options)
        
        If Pos >= 0 Then
            .SelStart = Pos
            .SelLength = Len(FindOpts.Text)
            FindNext = True
        Else
            MsgBox "找不到指定文本。", vbInformation
            FindNext = False
        End If
    End With
End Function

自动完成 ​

vb
Private AutoCompleteList As Collection

Private Sub InitAutoComplete()
    Set AutoCompleteList = New Collection
    
    ' 添加自动完成项
    With AutoCompleteList
        .Add "Visual Basic"
        .Add "VB6"
        .Add "VBA"
        .Add "Visual Studio"
        .Add "Windows"
    End With
    
    ' 配置文本框
    With TextBox1
        .AutoComplete = True
        .AutoCompleteSource = AutoCompleteList
    End With
End Sub

Private Sub TextBox1_AutoCompleteNeeded(ByVal Prefix As String, _
                                      ByRef Found As Boolean, _
                                      ByRef Value As String)
    ' 查找匹配项
    Dim Item As Variant
    For Each Item In AutoCompleteList
        If LCase$(Left$(Item, Len(Prefix))) = LCase$(Prefix) Then
            Value = Item
            Found = True
            Exit Sub
        End If
    Next Item
    Found = False
End Sub

数值验证 ​

vb
Private Sub TextBox1_KeyPress(KeyAscii As Integer)
    ' 只允许数字和小数点
    Select Case KeyAscii
        Case vbKey0 To vbKey9
            ' 允许数字
        Case vbKeyBack
            ' 允许退格键
        Case Asc(".")
            ' 只允许一个小数点
            If InStr(TextBox1.Text, ".") > 0 Then
                KeyAscii = 0
            End If
        Case Else
            KeyAscii = 0
    End Select
End Sub

Private Function ValidateNumber(ByVal Text As String) As Boolean
    ' 验证数值格式
    If IsNumeric(Text) Then
        Dim Value As Double
        Value = Val(Text)
        
        ' 检查范围
        If Value >= 0 And Value <= 100 Then
            ValidateNumber = True
            Exit Function
        End If
    End If
    ValidateNumber = False
End Function

最佳实践 ​

  1. 文本监控
vb
Private LastText As String
Private IsChanged As Boolean

Private Sub MonitorChanges()
    If TextBox1.Text <> LastText Then
        IsChanged = True
        LastText = TextBox1.Text
        UpdateStatus
    End If
End Sub

Private Sub UpdateStatus()
    ' 更新状态显示
    StatusBar1.Panels(1).Text = IIf(IsChanged, "已修改", "未修改")
    cmdSave.Enabled = IsChanged
End Sub
  1. 自动保存
vb
Private AutoSaveInterval As Long
Private LastSaveTime As Date

Private Sub SetupAutoSave()
    AutoSaveInterval = 300  ' 5分钟
    LastSaveTime = Now
    Timer1.Interval = 1000  ' 每秒检查
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    If IsChanged And DateDiff("s", LastSaveTime, Now) >= AutoSaveInterval Then
        AutoSave
    End If
End Sub

Private Sub AutoSave()
    On Error GoTo ErrorHandler
    
    Dim BackupFile As String
    BackupFile = App.Path & "\AutoSave_" & Format$(Now, "yyyymmdd_hhnnss") & ".txt"
    
    TextBox1.SaveFile BackupFile
    LastSaveTime = Now
    Exit Sub
    
ErrorHandler:
    Debug.Print "自动保存错误: " & Err.Description
End Sub

已知问题和解决方案 ​

  1. 性能优化
vb
Private Sub OptimizePerformance()
    ' 禁用重绘
    LockWindowUpdate TextBox1.hWnd
    
    ' 执行批量操作
    With TextBox1
        .Text = String$(1000, "A")  ' 大量文本
    End With
    
    ' 启用重绘
    LockWindowUpdate 0
End Sub
  1. 内存管理
vb
Private Sub ClearLargeText()
    ' 清理大文本
    TextBox1.Text = ""
    
    ' 强制垃圾回收
    Dim tmp As String
    tmp = Space$(1)
    Set TextBox1.Font = TextBox1.Font
End Sub

高级特性 ​

语法高亮 ​

vb
Private Type TextRange
    Start As Long
    Length As Long
    Color As Long
End Type

Private TextRanges() As TextRange
Private RangeCount As Long

Private Sub HighlightSyntax(ByVal Text As String)
    ' 清除现有高亮
    ReDim TextRanges(100)
    RangeCount = 0
    
    ' 查找关键字
    Dim Keywords() As String
    Keywords = Split("Dim|Private|Public|Sub|Function|End|If|Then|Else", "|")
    
    Dim i As Long
    For i = 0 To UBound(Keywords)
        HighlightKeyword Text, Keywords(i), vbBlue
    Next i
    
    ' 应用高亮
    ApplyHighlight
End Sub

Private Sub HighlightKeyword(ByVal Text As String, _
                           ByVal Keyword As String, _
                           ByVal Color As Long)
    Dim Pos As Long
    Pos = InStr(1, Text, Keyword, vbTextCompare)
    
    Do While Pos > 0
        ' 添加高亮范围
        With TextRanges(RangeCount)
            .Start = Pos - 1
            .Length = Len(Keyword)
            .Color = Color
        End With
        RangeCount = RangeCount + 1
        
        ' 查找下一个
        Pos = InStr(Pos + 1, Text, Keyword, vbTextCompare)
    Loop
End Sub

Private Sub ApplyHighlight()
    ' 应用文本颜色
    Dim i As Long
    For i = 0 To RangeCount - 1
        With TextRanges(i)
            TextBox1.SelStart = .Start
            TextBox1.SelLength = .Length
            TextBox1.SelColor = .Color
        End With
    Next i
    
    ' 恢复默认选择
    TextBox1.SelStart = 0
    TextBox1.SelLength = 0
End Sub

代码编辑器功能 ​

vb
Private Sub EnableCodeEditing()
    With TextBox1
        .MultiLine = True
        .ScrollBars = vbBoth
        .Font.Name = "Courier New"
        .Font.Size = 10
        
        ' 配置制表符
        .TabWidth = 4
        .UseTabs = False
        
        ' 配置行号
        .ShowLineNumbers = True
        .LineNumbersColor = vbBlue
        .LineNumbersWidth = 40
    End With
    
    ' 添加快捷键
    SetupShortcuts
End Sub

Private Sub SetupShortcuts()
    ' Ctrl+Space: 代码完成
    ' Ctrl+/: 注释/取消注释
    ' Tab/Shift+Tab: 缩进/取消缩进
    ' Ctrl+Z/Y: 撤销/重做
End Sub

Private Sub TextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
    ' 处理快捷键
    Select Case KeyCode
        Case vbKeyTab
            If Shift = 0 Then
                ' 插入缩进
                InsertIndent
            Else
                ' 减少缩进
                RemoveIndent
            End If
            KeyCode = 0
    End Select
End Sub

Private Sub InsertIndent()
    ' 插入缩进
    TextBox1.SelText = Space$(4)
End Sub

Private Sub RemoveIndent()
    ' 获取当前行
    Dim LineText As String
    LineText = GetCurrentLine()
    
    ' 如果以空格开头，则删除
    If Left$(LineText, 4) = Space$(4) Then
        TextBox1.SelStart = TextBox1.SelStart - 4
        TextBox1.SelLength = 4
        TextBox1.SelText = ""
    End If
End Sub

Private Function GetCurrentLine() As String
    Dim Start As Long
    Start = TextBox1.SelStart
    
    ' 查找行首
    While Start > 0 And Mid$(TextBox1.Text, Start, 1) <> vbNewLine
        Start = Start - 1
    Wend
    
    ' 查找行尾
    Dim Length As Long
    Length = 0
    While Start + Length <= Len(TextBox1.Text) And _
          Mid$(TextBox1.Text, Start + Length, 1) <> vbNewLine
        Length = Length + 1
    Wend
    
    GetCurrentLine = Mid$(TextBox1.Text, Start + 1, Length)
End Function

VB6及其LOGO版权为微软公司所有

VBMAN 版权所有 © 2019-2025 邓伟