?? menuitem.bas
字號:
Attribute VB_Name = "MENUITEM"
Global UserCancel As Integer 'False = User OK, True = User Cancel
Global SearchString As String 'Used in Search/Replace routine
Global ReplaceString As String 'Used in Replace routine
Global ReplaceFlag As Integer 'False = Search, True = Replace, 3 = Replace All
Global MatchCase As Integer 'False = case insensitive, True = case sensitive
Global VerifyReplace As Integer 'False = verify each replacement, True = replace all without verification
Global StartSearchPos As Long 'Set by frmSearch on Form_Load,
'Used to return cursor to start pos if
'no text match is found
Sub EditCopy()
Dim F As Form
Dim T As String
Dim P As String
Dim StartPos As Long
Dim EndPos As Long
On Error GoTo EditCopyError
'----------------------------------------------------------------------------
Set F = frmMain.ActiveForm 'Set active form to object var
StartPos = F.Text1.SelStart 'Assign starting position of highlighted text
EndPos = F.Text1.SelLength 'Assign length of highlighted text
If EndPos = 0 Then Exit Sub 'If no text highlighted then exit sub
T = Mid$(F.Text1, StartPos + 1, EndPos) 'Assign highlighted text to var
'----------------------------------------------------------------------------
Clipboard.SetText T 'Copy highlighted text to clipboard
Exit Sub
'----------------------------------------------------------------------------
EditCopyError:
If Err = 91 Then 'If no active form to save
Exit Sub 'then Exit Sub
End If
Resume Next
End Sub
Sub EditCut()
Dim F As Form
Dim T As String
Dim P As String
Dim StartPos As Long
Dim EndPos As Long
On Error GoTo EditCutError
'----------------------------------------------------------------------------
Set F = frmMain.ActiveForm 'Set active form to object var
StartPos = F.Text1.SelStart 'Assign starting position of highlighted text
EndPos = F.Text1.SelLength 'Assign length of highlighted text
If EndPos = 0 Then Exit Sub 'If no text highlighted then exit sub
T = Mid$(F.Text1, StartPos + 1, EndPos) 'Assign highlighted text to var
'----------------------------------------------------------------------------
Clipboard.SetText T 'Copy highlighted text to clipboard
T = Mid$(F.Text1, 1, StartPos) 'Assign text up to highlighted area
P = Mid$(F.Text1, StartPos + EndPos + 1, Len(F.Text1) - StartPos + EndPos + 1) 'Assign text after highlighted area
F.Text1 = T + P 'Combine both areas not highlighted, this effectively deletes highlighted text
F.Text1.SelStart = StartPos 'Leave cursor positioned at beginning of cut
Exit Sub
'----------------------------------------------------------------------------
EditCutError:
If Err = 91 Then 'If no active form to save
Exit Sub 'then Exit Sub
End If
Resume Next
End Sub
Sub EditFind()
Dim F As Form
Dim C As Control
Set F = frmMain
Set C = F.ActiveForm.Text1
Dim StartPos As Long
Dim NextPos As Long
Static LoopCount As Integer 'Flags no occurance of search term after
'two loops
'----------------------------------------------------------------------------
MENUITEMEditFind: 'RETURN POINT FOR LOOP
'----------------------------------------------------------------------------
'See if no match has been found in two loops of text contents,
'if so reset counter, message user, reset cursor pos and exit sub
If LoopCount = 2 Then
LoopCount = 0
MsgBox "Text not found", 64, "Search Results"
C.SelStart = StartSearchPos
Exit Sub
End If
'----------------------------------------------------------------------------
'Get current position of cursor in doc
StartPos = C.SelStart
'Find first position of next occurance of SearchString in this doc
If MatchCase = True Then
'Case Sensitive
If C.SelLength <> 0 Then
'If single character of text is highlighted
NextPos = InStr(StartPos + Len(SearchString) + 1, C, SearchString, 0) - 1
Else
'If no text is highlighted
NextPos = InStr(StartPos + Len(SearchString), C, SearchString, 0) - 1
End If
Else
'Case Insensitive
If C.SelLength <> 0 Then
'If single character of text is highlighted
NextPos = InStr(StartPos + Len(SearchString) + 1, C, SearchString, 1) - 1
Else
'If no text is highlighted
NextPos = InStr(StartPos + Len(SearchString), C, SearchString, 1) - 1
End If
End If
Unload frmSearch
'Check for return to SearchStartPos and if so msg user and exit sub
'If NextPos = StartSearchPos Then
' MsgBox "End of text.", 64, "Search Complete"
'End If
'----------------------------------------------------------------------------
If NextPos > -1 Then 'If another occurance of search string is found in text
C.SelStart = NextPos 'Set cursor pos to first pos of next occurance
C.SelLength = Len(SearchString) 'Highlight next occurance of the search string
LoopCount = 0 'resets loop counter flagging it found an ocurrance of the search string
Else
C.SelStart = 0 'If no more occurance of search string to EOF then position cursor at start of file and loop back through text
LoopCount = LoopCount + 1 'Increment counter, twice through without a hit causes pgm to msg user and exit sub
GoTo MENUITEMEditFind 'Loop back to top of routine
End If
End Sub
Sub EditPaste()
Dim F As Form
Dim T As String
Dim P As String
Dim Temp As String
Dim StartPos As Long
Dim EndPos As Long
On Error GoTo EditPasteError
'----------------------------------------------------------------------------
Set F = frmMain.ActiveForm 'Set active form to object var
StartPos = F.Text1.SelStart 'Assign starting position of highlighted text
EndPos = F.Text1.SelLength 'Assign length of highlighted text
'----------------------------------------------------------------------------
'Assign contents of clipboard to var
Temp = Clipboard.GetText()
'Assign text up to highlighted area
T = Mid$(F.Text1, 1, StartPos)
'Assign text after highlighted area
P = Mid$(F.Text1, StartPos + EndPos + 1, Len(F.Text1) - StartPos + EndPos + 1)
'Combine both areas not highlighted, this effectively deletes highlighted text
F.Text1 = T + Temp + P
'Leave cursor positioned at end of paste
F.Text1.SelStart = StartPos + Len(Temp)
Exit Sub
'----------------------------------------------------------------------------
EditPasteError:
If Err = 91 Then 'If no active form to save
Exit Sub 'then Exit Sub
End If
Resume Next
End Sub
Sub EditReplace()
Dim F As Form
Dim C As Control
Set F = frmMain
Set C = F.ActiveForm.Text1
Dim StartPos As Long
Dim EndPos As Long
Dim NextPos As Long
Static LoopCount As Integer 'Flags no occurance of search term after
'two loops
If ReplaceString = "" Then
MsgBox "No replacement string set. Aborting operation"
Exit Sub
End If
Unload frmSearch 'Unload search form
'----------------------------------------------------------------------------
MENUITEMEditReplace: 'RETURN POINT FOR LOOP
'----------------------------------------------------------------------------
'See if no match has been found in two loops of text contents,
'if so reset counter, message user, reset cursor pos and exit sub
If LoopCount = 2 Then
LoopCount = 0
MsgBox "Reached end of document.", 64, "Search Results"
C.SelStart = StartSearchPos
Exit Sub
End If
'----------------------------------------------------------------------------
StartPos = C.SelStart '
EndPos = C.SelLength
If EndPos > 0 Then 'Look for highlighted text
Select Case VerifyReplace
Case True 'Replace current word only and verify
Select Case MsgBox("Replace Text?", 35, "Verify Replace")
Case 6 '= YES
S1 = Left$(C, StartPos)
S2 = Right$(C, Len(C) - (StartPos + EndPos))
C = S1 + ReplaceString + S2
C.SelStart = StartPos
Exit Sub
Case 7 '=NO
Exit Sub
Case 2 '=CANCEL
Exit Sub
End Select
Case False 'Replace current word only NO verify
S1 = Left$(C, StartPos)
S2 = Right$(C, Len(C) - (StartPos + EndPos))
C = S1 + ReplaceString + S2
C.SelStart = StartPos
Exit Sub
Case 3 'Replace all occurance and verify each replacement
Select Case MsgBox("Replace Text?", 35, "Verify Replace")
Case 6 '= YES
S1 = Left$(C, StartPos)
S2 = Right$(C, Len(C) - (StartPos + EndPos))
C = S1 + ReplaceString + S2
C.SelStart = StartPos
Case 7 '=NO
'Do Nothing
Case 2 '=CANCEL
Exit Sub
End Select
Case 4
S1 = Left$(C, StartPos)
S2 = Right$(C, Len(C) - (StartPos + EndPos))
C = S1 + ReplaceString + S2
C.SelStart = StartPos
End Select
End If
'Find first position of next occurance of SearchString in this doc
If MatchCase = True Then
'Case Sensitive
NextPos = InStr(StartPos + Len(ReplaceString) + 1, C, SearchString, 0) - 1
Else
'Case Insensitive
NextPos = InStr(StartPos + Len(ReplaceString) + 1, C, SearchString, 1) - 1
End If
'Check for return to SearchStartPos and if so msg user and exit sub
If NextPos = StartSearchPos Then
MsgBox "End of text.", 64, "Search Complete"
Exit Sub
End If
'----------------------------------------------------------------------------
If NextPos > -1 Then 'If another occurance of search string is found in text
C.SelStart = NextPos 'Set cursor pos to first pos of next occurance
C.SelLength = Len(SearchString) 'Highlight next occurance of the search string
LoopCount = 0 'resets loop counter flagging it found an ocurrance of the search string
Else
C.SelStart = 0 'If no more occurance of search string to EOF then position cursor at start of file and loop back through text
LoopCount = LoopCount + 1 'Increment counter, twice through without a hit causes pgm to msg user and exit sub
End If
GoTo MENUITEMEditReplace 'Loop back to top of routine
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -