关于MSVC的一些宏

Build Duration

 

Sub  Application_BeforeBuildStart()
     '  keep the build-starting time
    dBuildStartTime  =   Now
    Application.PrintToOutputWindow  "   "
    Application.PrintToOutputWindow  " -------------------------------- "
    Application.PrintToOutputWindow  " Build start:  "   &  dBuildStartTime
End Sub

Sub  Application_BuildFinish(nNumErrors, nNumWarnings)
    
     '  get build time
    dNow  =   Now

    sec  =   DateDiff ( " s " , dBuildStartTime, dNow)

    hours  =  sec    3600
    sec  =  sec  -  hours  *   3600

    min  =  sec    60
    sec  =  sec  -  min  *   60

     '  format
     Dim  strH, strM, strS

     If  hours  >   10   Then
        strH  =  hours
     Else
        strH  =   " 0 "   &  hours
     End   If

     If  min  >   10   Then
        strM  =  min
     Else
        strM  =   " 0 "   &  min
     End   If

     If  sec  >   10   Then
        strS  =  sec
     Else
        strS  =   " 0 "   &  sec
     End   If

     '  display
    Application.PrintToOutputWindow  " Build end:    "   &  dNow
    Application.PrintToOutputWindow  " Build time:   "   &  strH  &   " : "   &  strM  &   " : "   &  strS
    Application.PrintToOutputWindow nNumWarnings  &   "  warning(s),  "   &  nNumErrors  &   "  error(s). "

End Sub

  Macros to go to beginning or end of function body, and to find corresponding function definition.

 

    Sub GoToBeginOfFunction()
        'DESCRIPTION: Go to the previous { which is at the beginning of a line.
        Dim sel As TextSelection
        sel = ActiveDocument.Selection
        sel.Cancel()
        Dim bFind As Boolean
        bFind = sel.FindText("^/{", DsTextSearchOptions.dsMatchBackward + DsTextSearchOptions.dsMatchRegExp)
        sel.StartOfLine()
    End Sub

    Sub GoToEndOfFunction()
        'DESCRIPTION: Go to the next } which is at the beginning of a line.
        Dim sel As TextSelection
        sel = ActiveDocument.Selection
        sel.Cancel()
        sel.FindText("^/}", DsTextSearchOptions.dsMatchRegExp)
    End Sub

    Sub FindFunction()
        'DESCRIPTION: Open corresponding .h or .cpp file and
        'find the function definition.

        Dim sel As TextSelection
        sel = ActiveDocument.Selection
        sel.WordRight()
        sel.WordLeft(DsMovementOptions.dsExtend)

        Dim str As String
        str = sel.Text

        Dim filename As String
        Dim s1 As TextSelection

        If (right(activedocument.name, 2) = ".h") Then
            ' now in .h, open cpp and find the function
            filename = activedocument.path & "" & _
              mid(ActiveDocument.name, 1, len(ActiveDocument.name) - 2) & ".cpp"
            DTE.Documents.Open(filename)
            s1 = ActiveDocument.Selection
            s1.Cancel()
            If s1.FindText("::" & str & "(", DsTextSearchOptions.dsMatchFromStart) = False Then
                s1.FindText(" " & str & "(")
            End If

        Else
            ' now in .cpp, open .h and find the function
            If (right(activedocument.name, 4) = ".cpp") Then
                filename = activedocument.path & "" & _
                  mid(ActiveDocument.name, 1, len(ActiveDocument.name) - 4) & ".h"
                DTE.Documents.Open(filename)
                s1 = ActiveDocument.Selection
                s1.Cancel()
                s1.FindText(str & "(", DsTextSearchOptions.dsMatchFromStart)
            End If
        End If
    End Sub

Filter build output and add sound

 

Solution
To  install the macro put it in your macro file under EnviromentEvents()  function .

Here  is  the macro:

Declare  Function  sndPlaySound Lib  " winmm.dll "  _ 
    Alias  " sndPlaySoundA "  (ByVal lpszSoundName  As   String , _ 
    ByVal uFlags  As   Long )  As   Long  
  
  
      Public  Declare  Function  waveOutGetNumDevs Lib  " winmm "  ()  As   Long  
      ' just after the sound is ended Exit Function 
      Const  SND_SYNC  =   & H0 
      ' just after the beginning of the sound Exit Function 
      Const  SND_ASYNC  =   & H1 
      ' if the sound cannot be found no Error message 
      Const  SND_NODEFAULT  =   & H2 
      ' repeat the sound until the Function is called again 
      Const  SND_LOOP  =   & H8 
      ' if currently a sound is played the 
      ' Function will return without playing the selected sound 
      Const  SND_NOSTOP  =   & H10 
      Const  Flags &   =  SND_ASYNC  Or  SND_NODEFAULT 
  
      Public   Sub  BuildEvents_OnBuildDone(ByVal _
         Scope  As  EnvDTE.vsBuildScope, _ 
         ByVal Action  As  EnvDTE.vsBuildAction) Handles _ 
         BuildEvents.OnBuildDone 
  
          '  Create a tool window handle for the Output window. 
          Dim  win  As  Window  =  
           DTE.Windows.Item(EnvDTE.Constants.vsWindowKindOutput) 
          '  Create handles to the Output window and its panes. 
          Dim  OW  As  OutputWindow  =  win.Object 
          Dim  OWp  As  OutputWindowPane 
          Dim  Loc  As   Integer  
  
         OWp  =  OW.OutputWindowPanes.Item( 1 ) 
         OWp.TextDocument.Selection.SelectAll() 
          Dim  Context  As   String   =  OWp.TextDocument.Selection.Text 
         OWp.TextDocument.Selection.CharLeft() 
  
         Loc  =   InStr (Context,  " ---------- Done ----------- " ) 
  
         OWp  =  OW.OutputWindowPanes.Item( 2 ) 
         OWp.Activate() 
         OWp.Clear() 
         OWp.OutputString( Mid (Context,  1 , Loc  -   7 )) 
         OWp.TextDocument.Selection.GotoLine_
                 (OWp.TextDocument.EndPoint().Line()) 
  
          ' Play sounds 
          If   InStr (Context,  " 0 error(s) " )  =   0   Then  
             sndPlaySound( " Error.wav " , SND_SYNC)  '  Edit
          ElseIf   InStr (Context,  " 0 warning(s) " )  =   0   Then  
             sndPlaySound( " Warning.wav " , SND_SYNC)  '  Edit
          Else  
             sndPlaySound( " Fine.wav " , SND_SYNC)  '  Edit
          End   If  
  
      End Sub
Don ' t forget to edit the wav file names to suit it to your needs. After that go back to your project and work as usual.

source code to HTML

 

Sub  Src2Html()
        DTE.UndoContext.Open("ToHTML" )
        Try
            DTE.Find.Target =  vsFindTarget.vsFindTargetCurrentDocumentSelection
            DTE.Find.MatchCase = True
            DTE.Find.MatchWholeWord  = False
            DTE.Find.MatchInHiddenText  = False
            DTE.Find.PatternSyntax  =  vsFindPatternSyntax.vsFindPatternSyntaxLiteral
            DTE.Find.ResultsLocation =  vsFindResultsLocation.vsFindResultsNone
            DTE.Find.Action =  vsFindAction.vsFindActionReplaceAll

            DTE.Find.FindWhat = "&"
            DTE.Find.ReplaceWith  = "&"
            DTE.Find.Execute()

            DTE.Find.FindWhat  = "<"
            DTE.Find.ReplaceWith  = "<"
            DTE.Find.Execute()

            DTE.Find.FindWhat  = ">"
            DTE.Find.ReplaceWith  = ">"
            DTE.Find.Execute()

            DTE.ActiveDocument.Selection.Untabify()
            DTE.ActiveDocument.Selection.Copy()
        Finally
            DTE.UndoContext.Close()
            DTE.ActiveDocument.Undo()
         End  Try

    End Sub

Upper case -> Lower case -> Capitalized case

Sub  MakeCaseUpperLower()
Dim  doc
set  doc  =  ActiveDocument 

'  Be sure active document is a text document
if  doc  Is   Nothing   Then
Exit   Sub
elseif  doc.Type  <>   " Text "   Then
Exit   Sub
End   If  

strSelected  =  doc.Selection
strNewUCase  =   ""
strNewLCase  =   ""

strNewUCase  =   UCase (strSelected)
strNewLCase  =   LCase (strSelected)
'  Upper case -> Lower case
if ( strNewUCase  =  strSelected )  then
doc.Selection  =   LCase (strSelected)
'  Lower case -> Capitalized Case
elseif  strNewLCase  =  strSelected  Then
doc.Selection  =   Left (strNewUCase, 1 )  +   Right (strNewLCase,  Len (strNewLCase) - 1 )
'  Capitalized Case
else
doc.Selection  =  strNewUCase
End   if
End Sub