ホーム > ライブラリ > memo

ライブラリ

memo

コールツリー用のメモ


Private Function prCode_GetDicDim(ByRef T_Mod As TP_VBE_Module)
    
    With T_Mod
        
        Set .Dic_Dim_Prv = New Scripting.Dictionary
        Set .Dic_Dim_Pub = New Scripting.Dictionary
        
        '宣言エリアが無い場合、終了
        If .Cnt_Dec = 0 Then Exit Function
        
        Dim i   As Long
        For i = 1 To .Cnt_Dec
            
            Dim Line    As String
            Line = .Lines(i)
            
            '表記を統一しておく
            If fString_Left_With(Line, "Global ") = True Then
                Line = Replace(Line, "Global ", "Public ", 1, 1)
            End If
            If fString_Left_With(Line, "Dim ") = True Then
                Line = Replace(Line, "Dim ", "Dim ", 1, 1)
            End If
            
            Dim Flg_Pub As Boolean
            Dim Flg_Prv As Boolean
            Flg_Pub = fString_Left_With(Line, "Public ")
            Flg_Prv = fString_Left_With(Line, "Private ")
            
            If Flg_Pub Or Flg_Prv Then
                
                '単語に分割
                Dim WordAry()   As String
                WordAry = fCode_Split(Line, Live_Dot:=True, Keep_Dot:=True)
                
                '変数の宣言とみなせる場合
                On Error Resume Next
                Dim Word2   As String
                Word2 = ""
                Word2 = WordAry(1)
                On Error GoTo 0
                Select Case Word2
                Case "", "Const", "Enum", "Declare", "Type"
                Case Else
                    
                    '変数の情報を取得
                    Dim DimName As String
                    Dim DimType As String
                    DimName = Word2
                    DimType = fCode_Dim_Type(WordAry)
                    
                    Select Case True
                    Case Flg_Pub:   .Dic_Dim_Pub.Item(DimName) = Array(DimName, DimType)
                    Case Flg_Prv:   .Dic_Dim_Pub.Item(DimName) = Array(DimName, DimType)
                    End Select
                
                End Select
                
            End If
            
        Next
        
    End With
    
End Function

Public Function FNC_Update_Dic_Dim(T_Mod As TP_VBE_Module)
'----------------------------------------------------------
'<概要>     ファンクションの辞書を作成(クラスの場合は[.]を繋げたファンクション名とする)
'<引数>     LineAry         :コード配列
'<引数>     Dic_Dim_Public  :Publicの New辞書
'<引数>     Dic_Dim_Private :PrivateのNew辞書
'<戻値>     なし(引数の辞書を更新)
'<備考>     なし
'<作成者>   庄野
'<作成日>   2014/2/22
'<更新者>
'<更新日>
'----------------------------------------------------------
    
    Dim WordAry         As Variant
    Dim Flg_Public      As Boolean
    Dim Flg_Private     As Boolean
    Dim DimName         As String
    Dim DimType         As String
    Dim T_Word          As String
    
    With T_Mod
        
        '宣言エリアの各コード行で
        Dim i   As Long
        For i = 1 To T_Mod.Cnt_Dec
            
            Dim LineStr As String
            LineStr = .Lines(i)
            
            '初期化
            DimName = ""
            DimType = ""
            
            '[Global]宣言を[Public]に統一する
            If fString_Left_With(LineStr, "Global ") = True Then
                LineStr = Replace(LineStr, "Global ", "Public ", 1, 1)
            End If
            
            '[Dim]宣言の変数の場合,[Private]に統一する
            If fCode_IsDimCode(LineStr) = True Then
                LineStr = Replace(LineStr, "Dim ", "Private ", 1, 1)
            End If
            
            'パブリックの判定取得
            Flg_Public = fString_Left_With(LineStr, "Public ")
            
            'プライベートの判定取得
            If Flg_Public = True Then
                Flg_Private = False
            Else
                Flg_Private = fString_Left_With(LineStr, "Private ")
            End If
            
            '[Public][Private]の宣言があった場合
            If Flg_Public = True Or Flg_Private = True Then
                
                '初期化
                DimName = ""
                DimType = ""
                
                '単語に分解して配列に格納
                WordAry = fCode_Split(LineStr, True, True)
                
                T_Word = WordAry(1)
                
                Select Case T_Word
                    
                    Case "Const", "Enum", "Declare", "Type"
                        
                    '変数が宣言されている場合
                    Case Else
                        
                        '変数名として取得
                        DimName = T_Word
                        
                        '変数の型を取得
                        DimType = fCode_Dim_Type(WordAry)
                        
                End Select
                
                '対象だった場合
                If DimName <> "" Then
                    
                    If Flg_Public = True Then
                        
                        '辞書に追加登録
                        If .Dic_Dim_Pub.Exists(DimName) = False Then
                            Call .Dic_Dim_Pub.Add(DimName, DimType)
                        End If
                        
                    ElseIf Flg_Private = True Then
                        
                        '辞書に追加登録
                        If .Dic_Dim_Prv.Exists(DimName) = False Then
                            Call .Dic_Dim_Prv.Add(DimName, DimType)
                        End If
                        
                    End If
                    
                End If
                
            End If
            
        Next
        
    End With
    
End Function


Private Function prClass_Convert_Line_for_ClassJudge(T_Line As String) As String
'クラスが含まれる文字列を,クラス.メソッドを判定できる形に変換する

'括弧内にさらに括弧があるケースが考えられるので,以下のような変換をかける
'→括弧内は右側に出し,括弧を除去
'1.SC_New(SC_New(0, Ary(1, 2)).Prc(3), Ary(1, 2)).Prc
'2.SC_New.Prc SC_New(0, Ary(1, 2)).Prc(3), Ary(1, 2)
'3.SC_New.Prc SC_New.Prc(3), Ary(1, 2) 0, Ary(1, 2)
'n.SC_New.Prc SC_New.Prc, Ary 0, Ary 3 1, 2 1, 2
    
    'フラグの設定
    Dim Flg_At_S    As Long
    Dim Flg_At_E    As Long
    Flg_At_S = 1
    Flg_At_E = 2
    
    '括弧の開始位置を取得
    Dim At_Deli_S       As Long
    At_Deli_S = InStr(1, T_Line, "(")
    
    '括弧がない場合,終了
    If At_Deli_S = 0 Then
        prClass_Convert_Line_for_ClassJudge = T_Line
        Exit Function
    End If
    
    '文字列の長さを取得
    Dim Len_Line    As Long
    Len_Line = Len(T_Line)
        
    '括弧の位置フラグ配列を調整
    ReDim AtAry_S(1 To Len_Line)
    ReDim AtAry_E(1 To Len_Line)
    
    '開始位置を全てフラグ配列に格納
    At_Deli_S = 0
    Dim i   As Long
    For i = 1 To Len_Line
        At_Deli_S = InStr(At_Deli_S + 1, T_Line, "(")
        If At_Deli_S = 0 Then Exit For
        AtAry_S(At_Deli_S) = Flg_At_S
    Next
    
    '終了位置を全てフラグ配列に格納
    Dim At_Deli_E       As Long
    At_Deli_E = 0
    For i = 1 To Len_Line
        At_Deli_E = InStr(At_Deli_E + 1, T_Line, ")")
        If At_Deli_E = 0 Then Exit For
        AtAry_E(At_Deli_E) = Flg_At_E
    Next
    
    '括弧の数をカウント
    Dim Cnt_Split   As Long
    Cnt_Split = 0
    For i = 1 To Len_Line
        Cnt_Split = Cnt_Split + AtAry_S(i)
    Next
    
    '格納調整(必要十分量を先に用意しておく)
    Dim SpAry() As String
    ReDim SpAry(0 To Cnt_Split * 2)
    
    '各文字列で
    At_Deli_S = 1
    At_Deli_E = 1
    Dim Cnt_Dir     As Long
    Cnt_Dir = 0
    For i = 1 To Len_Line
        
        Select Case AtAry_S(i) + AtAry_E(i)
        
        '開始位置があった場合
        Case Flg_At_S
            
            '終了位置を取得
            At_Deli_E = i - 1
            
            'それまでの文字列を該当の階層に格納
            SpAry(Cnt_Dir) = SpAry(Cnt_Dir) & Mid$(T_Line, At_Deli_S, At_Deli_E - At_Deli_S + 1)
            
            '開始位置を格納
            At_Deli_S = i + 1
            
            '階層を1つ進める
            Cnt_Dir = Cnt_Dir + 1
            
            
        '終了位置があった場合
        Case Flg_At_E
            
            '終了位置を取得
            At_Deli_E = i - 1
            
            If At_Deli_S <= At_Deli_E Then
                
                '開始位置までの文字列を,該当の階層に格納
                SpAry(Cnt_Dir) = SpAry(Cnt_Dir) & Mid$(T_Line, At_Deli_S, At_Deli_E - At_Deli_S + 1)
                
            End If
            
            '格納場所に区切りを入れる
            SpAry(Cnt_Dir) = SpAry(Cnt_Dir) & " "
            
            '開始位置を調整
            At_Deli_S = i + 1
            
            '階層を1つ戻す
            Cnt_Dir = Cnt_Dir - 1
            
        End Select
                    
    Next
    
    If Right$(T_Line, 1) <> ")" Then
        SpAry(Cnt_Dir) = SpAry(Cnt_Dir) & Mid$(T_Line, At_Deli_S)
    End If
    
    '括弧が無い形に調整して返す
    prClass_Convert_Line_for_ClassJudge = Join(SpAry, " ")
     
End Function

Private Function prClass_Replace(Line As String, NewName As String, ClassName As String) As String
    
    '判定簡略用にスペースを前後に付けて取得
    Dim RetStr  As String
    RetStr = " " & Line & " "
    
    '判定に邪魔な文字をスペースに変換
    RetStr = Replace(RetStr, "(", " ")
    RetStr = Replace(RetStr, ")", " ")
    RetStr = Replace(RetStr, ",", " ")
    
    'ドット無しの変換
    RetStr = Replace(RetStr, " " & NewName & " ", " " & ClassName & " ")
    
    'ドット有りの変換
    RetStr = Replace(RetStr, " " & NewName & ".", " " & ClassName & ".")
    
    '不要スペースを除去
    RetStr = fCode_Trim_LongSpace(Trim$(RetStr))
    
    '2つ目以上のドットを分離する
    'クラスのプロパティがオブジェクトで,更にメソッドを使用している場合の対応
    Dim SpAry1() As String
    SpAry1 = Split(RetStr, " ")
    
    Dim i   As Long
    For i = LBound(SpAry1, 1) To UBound(SpAry1, 1)
        
        '初期化
        Dim Flg_Conv    As Boolean
        Flg_Conv = False
        
        If InStr(1, SpAry1(i), ClassName & ".") <> 0 Then
            
            Dim SpAry2() As String
            SpAry2 = Split(SpAry1(i), ".")
            If 3 <= UBound(SpAry2, 1) - LBound(SpAry2, 1) + 1 Then
                
                If SpAry2(0) = ClassName Then
                        
                    Dim Flg_Exist   As Boolean
                    Flg_Exist = True
                    Flg_Conv = True
                    
                    SpAry2(1) = SpAry2(1) & " "
                    
                End If
                
            End If
            
            If Flg_Conv = True Then
                SpAry1(i) = Join(SpAry2, ".")
            End If
            
        End If
        
    Next
    
    If Flg_Exist = True Then
        RetStr = Join(SpAry1, " ")
    End If
    
    '戻り値
    prClass_Replace = RetStr
    
End Function

Private Function prClass_Unknown_Update(Dic_Unkown As Scripting.Dictionary, T_Line As String, _
                                        DicAry_Dim() As Scripting.Dictionary, Name_Dim As String, Type_Dim As String)
    
    '対象:配列にセット,辞書に登録
    'いずれも,Set単独とNew
    '入れ物と入れる物が異なる場合に判定
    
    If Left$(T_Line, Len("If ")) = "If " Then Exit Function
    
    '配列にクラスが丸ごと格納されている場合
    If InStr(1, T_Line, " = ") <> 0 Then
        
        '格納されているのが、クラスの場合、不明辞書に格納
        Dim WordAry()   As String
        WordAry = fCode_Split(T_Line, Keep_Dot:=True)
        
        '[Set][変数名][配列要素][=][クラス名]
        If WordAry(0) = "Set" Then
            
            Dim Flg_Set As Boolean
            Flg_Set = True
            
            Dim Val As String
            Val = Mid$(T_Line, Len("Set ") + 1)
            Val = Replace(Val, " New ", " ")
            
            Dim SpAry() As String
            SpAry = Split(Val, " = ")
            
            '何かの変数に、クラスをセットしている場合
            If SpAry(1) = Name_Dim Or SpAry(1) = Type_Dim Then
            
                '左側のドットを数えて複数あった場合
                '継承の可能性に対応
                Dim Cnt_Dot         As Long
                Cnt_Dot = String_Count(SpAry(0), ".")
                If Cnt_Dot <> 0 Then
                    Dim Flg_Unknown As Boolean
                    Flg_Unknown = True
                Else
                    
                    '左辺の変数名を取得
                    '配列要素を除去
                    Dim Words_Let() As String
                    Words_Let = fCode_Split(SpAry(0), Keep_Dot:=True)
                    If IsArray(Words_Let) = True Then
                        
                        'Setで左右の型が異なる場合
                        '同系のクラス型配列以外にセットされている場合に対応
                        Dim Name_Dim_Let    As String
                        Name_Dim_Let = Words_Let(0)
                        
                        Dim Idx_Dic As Long
                        For Idx_Dic = LBound(DicAry_Dim, 1) To UBound(DicAry_Dim, 1)
                            
                            If DicAry_Dim(Idx_Dic).Exists(Name_Dim_Let) = True Then
                                
                                Dim Type_Dim_Let  As String
                                Type_Dim_Let = DicAry_Dim(Idx_Dic).Item(Name_Dim_Let)
                                
                                If Type_Dim_Let <> Type_Dim Then
                                    
                                    '不明フラグを立てる
                                    Flg_Unknown = True
                                    Exit For
                                    
                                End If
                                
                            End If
                            
                        Next
                        
                    End If
                    
                End If
                    
            End If
            
        End If
        
    End If
    
    '[Set ~]ではない場合
    If Flg_Set = False Then
        
        '辞書にAdd/登録されている場合
        'Call T_Dic.Add([Class],[Class])
        'T_Dic.Add [Class],[Class]
        
        'T_Dic.Item(Key) = [Class]
        'T_Dic(Key) = [Class]
        
        '対象に辞書が含まれるか判定する
        Val = Replace(T_Line, "Call ", " ", 1, 1)
        
        WordAry = fCode_Split(Val, False)
        
        If 4 <= UBound(WordAry, 1) - LBound(WordAry, 1) + 1 Then
            
            Name_Dim_Let = WordAry(0)
            
            For Idx_Dic = LBound(DicAry_Dim, 1) To UBound(DicAry_Dim, 1)
                
                If DicAry_Dim(Idx_Dic).Exists(Name_Dim_Let) = True Then
                    
                    Type_Dim_Let = DicAry_Dim(Idx_Dic).Item(Name_Dim_Let)
                    
                    Select Case Type_Dim_Let
                    
                    Case "Dictionary", "Scripting.Dictionary"
                        Dim Flg_Dic As Boolean
                        Flg_Dic = True
                        
                    End Select
                    
                End If
                
            Next
            
            If Flg_Dic = True Then
                
                '辞書の[Item]の場合
                If InStr(1, Val, " = ") <> 0 Then
                    
                    SpAry = Split(Val, " = ")
                    
                    Dim Words_R As Variant
                    Words_R = fCode_Split(SpAry(1), False)
                    If IsArray(Words_R) = True Then
                        
                        Dim i   As Long
                        For i = LBound(Words_R, 1) To UBound(Words_R, 1)
                            
                            If Words_R(i) = Name_Dim Then
                                
                                '不明フラグを立てる
                                Flg_Unknown = True
                                Exit For
                                
                            End If
                            
                        Next
                        
                    End If
                    
                '辞書の[Add]の場合
                ElseIf InStr(1, Val, ".Add") <> 0 Then
                    
                    Val = Replace(Val, ".Add(", ".Add ")
                    
                    '格納されているのが、クラスの場合、不明辞書に格納
                    SpAry = Split(Val, ".Add ")
                    
                    Dim Words_L As Variant
                    Words_L = fCode_Split(SpAry(0), False)
                    If IsArray(Words_L) = True Then
                        
                        Name_Dim_Let = Words_L(0)
                        
                        For Idx_Dic = LBound(DicAry_Dim, 1) To UBound(DicAry_Dim, 1)
                            
                            If DicAry_Dim(Idx_Dic).Exists(Name_Dim_Let) = True Then
                                
                                Type_Dim_Let = DicAry_Dim(Idx_Dic).Item(Name_Dim_Let)
                                
                                Select Case Type_Dim_Let
                                
                                Case "Dictionary", "Scripting.Dictionary"
                                    
                                    If Type_Dim_Let <> Type_Dim Then
                                        
                                        '不明フラグを立てる
                                        Flg_Unknown = True
                                        Exit For
                                        
                                    End If
                                    
                                End Select
                                
                            End If
                            
                        Next
                        
                    End If
                    
                End If
                
            End If
            
        End If
        
        'クラスのプロパティにセットされている場合,無視
        
        
        
    End If
    
    '不明要素が発見された場合、辞書に登録
    If Flg_Unknown = True Then
        
        If Dic_Unkown.Exists(Type_Dim) = False Then
            Call Dic_Unkown.Add(Type_Dim, Empty)
        End If
        
    End If
    
End Function
 

 

  2020/10/12   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください