form1.frm

这里有很多很实用的VB编程案例,方便大家学习VB.

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form Form1 
   Caption         =   "RichTextBox编辑器"
   ClientHeight    =   2970
   ClientLeft      =   1095
   ClientTop       =   1800
   ClientWidth     =   6300
   Icon            =   "form1.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2970
   ScaleWidth      =   6300
   Begin RichTextLib.RichTextBox RichTextBox1 
      Height          =   1095
      Left            =   270
      TabIndex        =   0
      Top             =   1560
      Width           =   5595
      _ExtentX        =   9869
      _ExtentY        =   1931
      _Version        =   393217
      ScrollBars      =   3
      AutoVerbMenu    =   -1  'True
      TextRTF         =   $"form1.frx":000C
   End
   Begin VB.Menu mMain 
      Caption         =   "&Edit"
      Index           =   1
      Begin VB.Menu mEdit 
         Caption         =   "&Undo"
         Index           =   0
         Shortcut        =   ^Z
      End
      Begin VB.Menu mEdit 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mEdit 
         Caption         =   "Cu&t"
         Index           =   2
         Shortcut        =   ^X
      End
      Begin VB.Menu mEdit 
         Caption         =   "&Copy"
         Index           =   3
         Shortcut        =   ^C
      End
      Begin VB.Menu mEdit 
         Caption         =   "&Paste"
         Index           =   4
         Shortcut        =   ^V
      End
      Begin VB.Menu mEdit 
         Caption         =   "&Delete"
         Index           =   5
         Shortcut        =   {DEL}
      End
   End
   Begin VB.Menu mMain 
      Caption         =   "&Format"
      Index           =   2
      Begin VB.Menu mFormat 
         Caption         =   "&Normal"
         Index           =   0
      End
      Begin VB.Menu mFormat 
         Caption         =   "&Bold"
         Index           =   1
      End
      Begin VB.Menu mFormat 
         Caption         =   "&Italic"
         Index           =   2
      End
      Begin VB.Menu mFormat 
         Caption         =   "B&old-Italic"
         Index           =   3
      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

#If Win16 Then
   Private Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
#ElseIf Win32 Then
   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
#End If

Const WM_CUT = &H300
Const WM_COPY = &H301
Const WM_PASTE = &H302
Const WM_CLEAR = &H303
Const WM_UNDO = &H304
#If Win16 Then
   Const EM_CANUNDO = &H416
   Const EM_GETMODIFY = &H408
#ElseIf Win32 Then
   Const EM_CANUNDO = &HC6
   Const EM_GETMODIFY = &HB8
#End If

Const mUndo = 0
Const mCut = 2
Const mCopy = 3
Const mPaste = 4
Const mDelete = 5

Private m_ControlKey As Boolean

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyControl Then
      m_ControlKey = True
   End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyControl Then
      m_ControlKey = False
   End If
End Sub



Private Sub Form_Resize()
   RichTextBox1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub





Private Sub mEdit_Click(Index As Integer)
   Select Case Index
      Case mUndo
         EditPerform WM_UNDO
      Case mCut
         EditPerform WM_CUT
      Case mCopy
         EditPerform WM_COPY
      Case mPaste
         EditPerform WM_PASTE
      Case mDelete
         EditPerform WM_CLEAR
   End Select
End Sub



Private Sub mFormat_Click(Index As Integer)
   Const mNormal = 0
   Const mBold = 1
   Const mItalic = 2
   Const mBoldItalic = 3

   With RichTextBox1
      Select Case Index
         Case mNormal
            .SelBold = False
            .SelItalic = False
         Case mBold
            .SelBold = True
            .SelItalic = False
         Case mItalic
            .SelBold = False
            .SelItalic = True
         Case mBoldItalic
            .SelBold = True
            .SelItalic = True
      End Select
   End With
End Sub



Private Sub mMain_Click(Index As Integer)
   Const mDemo = 0
   Const mEdit = 1
   Const mFormat = 2

   If Index = mEdit Then
      EditMenuToggle
   End If
End Sub

Private Sub EditMenuToggle()
   If TypeOf Me.ActiveControl Is TextBox Or _
      TypeOf Me.ActiveControl Is RichTextBox Then
      
      Me.mEdit(mUndo).Enabled = SendMessage(Me.ActiveControl.hWnd, EM_CANUNDO, 0, 0&)
      Me.mEdit(mCut).Enabled = Me.ActiveControl.SelLength
      Me.mEdit(mCopy).Enabled = Me.ActiveControl.SelLength
      Me.mEdit(mDelete).Enabled = Me.ActiveControl.SelLength
      Me.mEdit(mPaste) = Clipboard.GetFormat(vbCFText)
   Else
      Me.mEdit(mUndo).Enabled = False
      Me.mEdit(mCut).Enabled = False
      Me.mEdit(mCopy).Enabled = False
      Me.mEdit(mPaste).Enabled = False
      Me.mEdit(mDelete).Enabled = False
   End If
End Sub

Private Sub EditPerform(EditFunction As Integer)
   If TypeOf Me.ActiveControl Is TextBox Then
      Call SendMessage(Me.ActiveControl.hWnd, EditFunction, 0, 0&)
   ElseIf TypeOf Me.ActiveControl Is RichTextBox Then
      If m_ControlKey = False Then
         Call SendMessage(Me.ActiveControl.hWnd, EditFunction, 0, 0&)
      End If
   Else
      Beep
   End If
End Sub