VB在运行时如何来替换主菜单?

Question

如题

Answer 1

新建一个form，加RichTextBox，菜单' *********************************************************************
'  Copyright ?997 Karl E. Peterson, All Rights Reserved
' *********************************************************************
'  You are free to use this code within your own applications, but you
'  are expressly forbidden from selling or otherwise distributing this
'  source code without prior written consent.
' *********************************************************************
Option Explicit
'
' Windows API call used to control textbox
'
#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
'
' Edit Control Messages
'
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     'WM_USER + 22
   Const EM_GETMODIFY = &H408   'WM_USER + 8
#ElseIf Win32 Then
   Const EM_CANUNDO = &HC6
   Const EM_GETMODIFY = &HB8
#End If
'
' Edit menu array constants
'
Const mUndo = 0
Const mCut = 2
Const mCopy = 3
Const mPaste = 4
Const mDelete = 5
'
' Flag to track status of Control key
'
Private m_ControlKey As BooleanPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   '
   ' Watch for Control key, set flag
   '
   If KeyCode = vbKeyControl Then
      m_ControlKey = True
   End If
End SubPrivate Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   '
   ' Watch for Control key, clear flag
   '
   If KeyCode = vbKeyControl Then
      m_ControlKey = False
   End If
End SubPrivate Sub Form_Load()
   '
   ' Load some data and show the RichTextBox
   '
   mLoad_Click
   mControl_Click 1
End SubPrivate Sub Form_Resize()
   '
   ' Size edit area to fit form
   '
   Text1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
   RichTextBox1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End SubPrivate Sub mControl_Click(Index As Integer)
   Const ctlText = 0
   Const ctlRichText = 1
   '
   ' Toggle between the two edit controls
   '
   Select Case Index
      Case ctlText
         Text1.Visible = True
         RichTextBox1.Visible = False
         Me.Caption = "Standard Edit Support: TextBox"
         mControl(ctlText).Checked = True
         mControl(ctlRichText).Checked = False
         mMain(2).Enabled = False
      Case ctlRichText
         RichTextBox1.Visible = True
         Text1.Visible = False
         Me.Caption = "Standard Edit Support: RichTextBox"
         mControl(ctlText).Checked = False
         mControl(ctlRichText).Checked = True
         mMain(2).Enabled = True
   End Select
End SubPrivate Sub mEdit_Click(Index As Integer)
   '
   ' Call generic routine to perform requested action.
   ' Same routine could be called from a toolbar event.
   '
   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 SubPrivate Sub mExit_Click()
   Unload Me
End SubPrivate Sub mFormat_Click(Index As Integer)
   Const mNormal = 0
   Const mBold = 1
   Const mItalic = 2
   Const mBoldItalic = 3
   '
   ' Format highlighted text appropriately
   '
   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 SubPrivate Sub mLoad_Click()
   Dim Proceed As Integer
   '
   ' See if user has changed the text, and if so
   ' prompt before loading new copy.
   '
   Proceed = vbYes
   If SendMessage(Text1.hWnd, EM_GETMODIFY, 0, 0&) Then
      Proceed = MsgBox("Text has been modified" _
                       & Chr$(13) & "Continue?", _
                       vbYesNo, "Warning")
   End If
   If Proceed = vbYes Then
      '
      ' Load AUTOEXEC.BAT (if exists) into textbox
      '
      On Error Resume Next
         Open "c:\autoexec.bat" For Binary As #1
         Text1.Text = Input(LOF(1), 1)
         RichTextBox1.Text = Text1.Text
         Close #1
      On Error GoTo 0
   End If
End SubPrivate Sub mMain_Click(Index As Integer)
   Const mDemo = 0
   Const mEdit = 1
   Const mFormat = 2
   '
   ' If Edit menu is dropped down, set available choices
   '
   If Index = mEdit Then
      EditMenuToggle
   End If
End SubPrivate Sub EditMenuToggle()
   If TypeOf Me.ActiveControl Is TextBox Or _
      TypeOf Me.ActiveControl Is RichTextBox Then
      '
      ' Determine if last edit can be undone
      '
      Me.mEdit(mUndo).Enabled = SendMessage(Me.ActiveControl.hWnd, EM_CANUNDO, 0, 0&)
      '
      ' See if there's anything to cut, copy, or delete
      '
      Me.mEdit(mCut).Enabled = Me.ActiveControl.SelLength
      Me.mEdit(mCopy).Enabled = Me.ActiveControl.SelLength
      Me.mEdit(mDelete).Enabled = Me.ActiveControl.SelLength
      '
      ' See if there's anything to paste
      '
      Me.mEdit(mPaste) = Clipboard.GetFormat(vbCFText)
   Else
      '
      ' If active control is not a textbox then disable all
      '
      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 SubPrivate Sub EditPerform(EditFunction As Integer)
   '
   ' A "wrapper" function for SendMessage
   ' Requests function passed in EditFunction
   ' Beeps if active control is not a textbox
   '
   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