menuitem.bas

NOPAD的VB6原碼,寫的還蠻齊全的,請參考

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