visualcpluspluscode.bas

c#设计模式WithCla

Attribute VB_Name = "VisualCPlusPlusCode"
Option Explicit
Option Base 1      'All array indexes start with 1
'(c) 1993-1998 MicroGold Software, Inc.
'Set Tools-Options-Editor All Boxes Checked
'Set Tools-Options-General Break On All Errors

Sub CodeLinkToVisualC()
Dim s1 As Object
Dim Document1 As Object
Dim ClassList As Object
Dim currentClass As Object
Dim strClass As String
Dim strClassHeader As String
Dim strClassSource As String
Dim strPath As String
Dim strProjectPath As String
Dim counter As Integer
Dim k As Integer

' CodeGenerateVCHeader
' CodeGenerateVCSource

strProjectPath = ActiveDocument.WorkingDirectory
Documents.Application.Visible = True
Set ClassList = ActiveDocument.Classes
    counter = ClassList.Count
      ClassList.Restart
      While (ClassList.IsLast = False)
       Set currentClass = ClassList.GetNext
       strClass = currentClass.Name
       Let strClassHeader = strProjectPath & "\" & strClass & ".h"
       Let strClassSource = strProjectPath & "\" & strClass & ".cpp"
       Documents.Open strClassHeader, "Text"
       Documents.Open strClassSource, "Text"
      Wend
End Sub

Sub CodeGenerateVCHeader()
 Dim wcDocument As Object
 Dim MyAttributes As Object
 Dim MyOperations As Object
 Dim MyParameters As Object
 Dim currentClass As Object
 Dim currentAttribute As Object
 Dim currentOperation As Object
 Dim currentBaseClass As Object
 Dim anindex As Integer
    Dim I As Integer
    Dim j As Integer
    Dim k As Integer
    Dim l As Integer
    Dim n As Integer
    Dim m As Integer
    Dim p As Integer
    Dim ParameterCount As Integer
    Dim counter As Integer
    Dim baseCounter As Integer
    Dim attrCounter As Integer
    Dim operCounter As Integer
    Dim includeCounter As Integer
    Dim filename As String
    Dim infile As String
    Dim cfilename As String
    Dim hfilename As String
    Dim tmpStr As String
    Dim strVis As String
    Dim ClassList As Object
    
    Set wcDocument = ActiveDocument
    Set ClassList = wcDocument.Classes
    counter = ClassList.Count
    For I = 1 To counter
    Set currentClass = ClassList.Item(I)
' *************** File Output ************************
        n = FreeFile
        hfilename = wcDocument.DocumentDirectory & "\" & currentClass.Name & ".h"
        Open hfilename For Output As #n
'*********************************************************
        Print #n, " "
        Print #n, "// **************************************************************"
        Print #n, "// "; currentClass.Description
        Print #n, "// **************************************************************"
        Print #n, " "
        Print #n, "class " & currentClass.Name;
        baseCounter = currentClass.SuperClasses.Count
        If (baseCounter > 0) Then
        Print #n, " : public ";
        For p = 1 To currentClass.SuperClasses.Count
        Set currentBaseClass = currentClass.SuperClasses.Item(p)
        Print #n, currentBaseClass.Name;
        If (p < baseCounter - 1) Then
            Print #n, ", ";
        End If
        Next p
        End If
        Print #n, " "
        Print #n, "{"
        Print #n, " "
        
        Set MyAttributes = currentClass.Attributes
        Set MyOperations = currentClass.Operations
        
        GenerateVCAttributes n, MyAttributes, "private"
        GenerateVCAttributes n, MyAttributes, "protected"
        GenerateVCAttributes n, MyAttributes, "public"
        
        
        Print #n, " "
        
        GenerateVCOperations n, MyOperations, "private"
        GenerateVCOperations n, MyOperations, "protected"
        GenerateVCOperations n, MyOperations, "public"
        
        Print #n, " "
        Print #n, "};"
        Close #n
    Next I
        
        MsgBox ("Finished generating C++ Header files")


End Sub

Private Function GenerateVCAttributePostKeywordString(currentAttribute As Object, strReturn As String)
 strReturn = ""
 If (currentAttribute.IsArray) Then
 strReturn = strReturn & "[" & currentAttribute.Length & "]"
 End If
End Function



Private Function GenerateVCAttributePreKeywordString(currentAttribute As Object, strReturn As String)
strReturn = ""
If currentAttribute.IsStatic Then
    strReturn = strReturn & "static "
    End If
If currentAttribute.IsConstant Then
    strReturn = strReturn & "const "
    End If
End Function



Private Function GenerateVCAttributes(FileId As Integer, TheAttributes As Object, Visibility As String)

Dim currentAttribute As Object
        Dim attrCounter As Integer
        Dim j As Integer
        Dim tmpStr As String
        Dim list As New Collection
        Dim k As Integer
        
        attrCounter = TheAttributes.Count
        For k = 1 To attrCounter
        Set currentAttribute = TheAttributes.Item(k)
        If (currentAttribute.Visibility = Visibility) Then
        list.Add currentAttribute
        End If
        Next k
        
        attrCounter = list.Count
        If attrCounter > 0 Then
            Print #FileId, Visibility & ":"
            attrCounter = list.Count
            For j = 1 To attrCounter
            Set currentAttribute = list.Item(j)
            GenerateVCAttributePreKeywordString currentAttribute, tmpStr
            Print #FileId, Tab(5); tmpStr;
            Print #FileId, Tab(20); currentAttribute.Type & " "; Tab(35); currentAttribute.Name;
            GenerateVCAttributePostKeywordString currentAttribute, tmpStr
            Print #FileId, tmpStr & ";"
            Next j
        End If
End Function

Private Function GenerateVCOperationPreKeywordString(currentOperation As Object, strReturn As String)
strReturn = ""
If currentOperation.IsFriend Then
    strReturn = strReturn & "friend "
    End If
If (currentOperation.IsVirtual) Then
    strReturn = strReturn & "virtual "
    End If
If currentOperation.IsStatic Then
    strReturn = strReturn & "static "
    End If
End Function



Private Function GenerateVCOperationPostKeywordString(currentOperation As Object, strReturn As String)
 strReturn = ""
If currentOperation.IsConst Then
    strReturn = strReturn & " const"
    End If
If (currentOperation.IsAbstract) Then
    strReturn = strReturn & " = 0"
    End If
End Function
Private Function GenerateVCParameterString(theParameters As Object, strReturn As String)
        Dim ParameterCount As Integer
        Dim l As Integer

        ParameterCount = theParameters.Count
        strReturn = ""
        For l = 1 To ParameterCount
        If (l = (ParameterCount - 1)) Then
            strReturn = strReturn & theParameters.ItemType(l) & " "
            strReturn = strReturn & theParameters.ItemName(l)
        Else
            strReturn = strReturn & theParameters.ItemType(l) & " "
            strReturn = strReturn & theParameters.ItemName(l) & ", "
        End If
        Next l
End Function
Private Sub GenerateVCOperations(FileId As Integer, TheOperations As Object, Visibility As String)
    Dim operCounter As Integer
    Dim currentOperation As Object
    Dim strVis As String
    Dim tmpStr As String
    Dim k As Integer
    Dim strOper As String
    Dim list As New Collection
    Dim z As Integer
        
        operCounter = TheOperations.Count
        For k = 1 To operCounter
        Set currentOperation = TheOperations.Item(k)
        If (currentOperation.Visibility = Visibility) Then
        list.Add currentOperation
        End If
        Next k
        
        operCounter = list.Count
        If operCounter > 0 Then

        
        
        Print #FileId, Visibility & ":"
        For z = 1 To operCounter
        Set currentOperation = list.Item(z)
        GenerateVCOperationPreKeywordString currentOperation, tmpStr
        Print #FileId, Tab(5); tmpStr;
        Print #FileId, Tab(20); currentOperation.ReturnType; Tab(35); currentOperation.Name; Tab(55); "(";
        GenerateVCParameterString currentOperation.Parameters, tmpStr
        Print #FileId, tmpStr & ")";
        GenerateVCOperationPostKeywordString currentOperation, tmpStr
        Print #FileId, tmpStr;
        Print #FileId, ";"
        Next z
        
        
        End If

End Sub

Sub CodeGenerateVCSource()
 Dim wcDocument As Object
 Dim MyOperations As Object
 Dim MyParameters As Object
 Dim currentClass As Object
 Dim currentOperation As Object
 Dim currentBaseClass As Object
    Dim I As Integer
    Dim n As Integer
    Dim ParameterCount As Integer
    Dim counter As Integer
    Dim baseCounter As Integer
    Dim attrCounter As Integer
    Dim operCounter As Integer
    Dim includeCounter As Integer
    Dim filename As String
    Dim infile As String
    Dim cfilename As String
    Dim hfilename As String
    Dim tmpStr As String
    Dim strVis As String
    Dim j As Integer
    Dim ClassList As Object
    
  
    
    
    
    
Set wcDocument = ActiveDocument

    Set ClassList = wcDocument.Classes
    counter = ClassList.Count


'    Print #n, "// Number of Classes = " & counter
    For I = 1 To counter
        Set currentClass = ClassList.Item(I)

' *************** File Output ************************
         n = FreeFile
        cfilename = wcDocument.DocumentDirectory & "\" & currentClass.Name & ".cpp"
        
        Open cfilename For Output As #n
'*********************************************************
        GenerateVCSourceIncludes n, currentClass
        Print #n, " "
        Print #n, " "
        Print #n, "// **************************************************************"
        Print #n, "// "; currentClass.Description
        Print #n, "// **************************************************************"
        Print #n, " "
        operCounter = currentClass.Operations.Count
        For j = 1 To operCounter
        Set currentOperation = currentClass.Operations.Item(j)
        GenerateVCOperationComments n, currentOperation
        GenerateVCOperationFramework n, currentOperation, currentClass
        Next j

        Close #n
    Next I
    
        MsgBox ("Finished Generating cpp Files")

End Sub

Private Sub GenerateVCSourceIncludes(FileId As Integer, currentClass As Object)
        Dim aggCounter As Integer
        Dim assocCounter As Integer
        Dim aggClass As With_Class.Class
        Dim assocClass As With_Class.Class
        Dim strInclude As String
        Dim baseCounter As Integer
        Dim p As Integer
        Dim currentBaseClass As With_Class.Class
        
        Print #FileId, "#include "; Chr(34); "stdafx.h"; Chr(34)
        Print #FileId, "#include "; Chr(34); currentClass.Name; ".h"; Chr(34)
        
       ' ****** Base Class Includes
        baseCounter = currentClass.SuperClasses.Count
        For p = 1 To baseCounter
        Set currentBaseClass = currentClass.SuperClasses.Item(p)
        Print #FileId, "#include "; Chr(34); currentBaseClass.Name; ".h"; Chr(34)
        Next p

       ' ****** agg Class Includes
        aggCounter = currentClass.AggregationClasses.Count
        For p = 1 To aggCounter
        Set aggClass = currentClass.AggregationClasses.Item(p)
        Print #FileId, "#include "; Chr(34); aggClass.Name; ".h"; Chr(34)
        Next p

       ' ****** assoc Class Includes
        assocCounter = currentClass.AssociationClasses.Count
        For p = 1 To assocCounter
        Set assocClass = currentClass.AssociationClasses.Item(p)
        Print #FileId, "#include "; Chr(34); assocClass.Name; ".h"; Chr(34)
        Next p

       ' ****** dependency Class Includes
        assocCounter = currentClass.DependencyClasses.Count
        For p = 1 To assocCounter
        Set assocClass = currentClass.DependencyClasses.Item(p)
        Print #FileId, "#include "; Chr(34); assocClass.Name; ".h"; Chr(34)
        Next p
        
       ' ****** include (import Class Includes
        assocCounter = currentClass.Imports.Count
        For p = 1 To assocCounter
        strInclude = currentClass.Imports.Item(p)
        Print #FileId, "#include "; Chr(34); strInclude; Chr(34)
        Next p
End Sub


Private Sub GenerateVCOperationComments(FileId As Integer, currentOperation As Object)
Dim strParms As String

  Print #FileId, "// Operation Name: "; Tab(30); currentOperation.Name
  Print #FileId, "// Operation Purpose: "; Tab(30); currentOperation.Comment1
  Print #FileId, "// Operation Return Type: "; Tab(30); currentOperation.ReturnType
  GenerateVCParameterString currentOperation.Parameters, strParms
  Print #FileId, "// Operation Parameters: "; Tab(30); strParms
  Print #FileId, "// Operation Comments: "; Tab(30); currentOperation.Comment2
End Sub

Private Function GenerateVCOperationFramework(FileId As Integer, currentOperation As Object, currentClass As Object)
  Dim strParms As String
  GenerateVCParameterString currentOperation.Parameters, strParms
  Print #FileId, currentOperation.ReturnType & "  " & currentClass.Name & "::" & currentOperation.Name;
  Print #FileId, "(" & strParms & ")"
  Print #FileId, Tab(2); "{"
  Print #FileId, Tab(2); currentOperation.Code
  Print #FileId, Tab(2); "}"
  Print #FileId, " "
End Function