+ Event declaration

Author: josef-poetzl

Tests/ACLibDeclarationDict/DeclarationDictTestCodemodule.cls

@@ -18,30 +18,46 @@ Private m_AccUnitInfo As String
 Private Enum TestEnum
    TestEnum_P1 = 2
 End Enum
-Private Type TypTest1
+Private Type TestType1
    FldA As Long
    FldB As String
+   FldC As Boolean
 End Type
 
 Private Enum TestEnum2
    TestEnum2_P1 = 2
    TestEnum2_P2 = 3
 End Enum
 
-Private Type TypTest2
+Private Type TestType2
    Fld2A As Long
    Fld2B As String
+   FldC As Date
 End Type
 
+Public Event RaiseSomething(ByVal EventParam1 As Variant)
+
 Private Sub Class_Initialize()
 '
 End Sub
 
 Public Function AccUnitTestFunct(ByVal FuncParam1 As Variant, FuncParam2() As String) As Variant
 
-   Dim FuncVar1 As Variant
-   Dim FuncVar2
-   
+   Dim FuncVar1 As Variant, FuncVar2
    Dim FuncVar3()
+   
+   Dim FuncVar4 As Long: FuncVar4 = 5
 
 End Function
+
+' Declaration of a property procedure in one line:
+Friend Property Get Name1() As String: Name1 = "TestName": End Property
+
+Friend Property Let Name2(ByVal NewValue As String)
+'
+End Property
+
+Friend Property Set Formatter(ByVal ObjRef As Object)
+'
+End Property
+

Tests/ACLibDeclarationDict/DeclarationDictTests.cls

@@ -45,6 +45,7 @@ End Sub
 'AccUnit:Row("Private Function Func1(a(), b) As String()", "Func1|a|b")
 'AccUnit:Row("Private Function Func1(a(), b()) As String()", "Func1|a|b")
 'AccUnit:Row("Dim Abc() As String, b(), C As Long", "Abc|b|C")
+'AccUnit:Row("Function Abc(ByVal X as Long) as Long: Abc = X*X: End Function", "Abc|X")
 Public Sub ImportCode_InsertCodeLine_CheckKeysExists(ByVal Code As String, ByVal Expected As String)
 
    Dim Actual As String
@@ -120,18 +121,28 @@ Public Sub ImportCodeModule_CheckKeys()
    Dim ExpectedKeys() As Variant
    ExpectedKeys = Array("AccUnitX", "m_AccUnitInfo", _
                         "TestEnum", "TestEnum_P1", _
-                        "TypTest1", "FldA", "FldB", _
+                        "TestType1", "FldA", "FldB", "FldC", _
                         "TestEnum2", "TestEnum2_P1", "TestEnum2_P2", _
-                        "TypTest2", "Fld2A", "Fld2B", _
+                        "TestType2", "Fld2A", "Fld2B", _
+                        "RaiseSomething", "EventParam1", _
                         "Class_Initialize", _
-                        "AccUnitTestFunct", "FuncParam1", "FuncParam2", "FuncVar1", "FuncVar2", "FuncVar3")
-   
+                        "AccUnitTestFunct", "FuncParam1", "FuncParam2", "FuncVar1", "FuncVar2", "FuncVar3", "FuncVar4", _
+                        "Name1", "Name2", "NewValue", _
+                        "Formatter", "ObjRef")
+                        
+   '
    m_DeclDict.ImportVBComponent CurrentVbProject.VBComponents("DeclarationDictTestCodemodule")
 
    Set ActualDict = m_DeclDict.Dict
 
+'   Dim k As Long
+'   For k = 0 To m_DeclDict.Count - 1
+'      Debug.Print m_DeclDict.Dict.Keys(k)
+'   Next
+   
    Assert.That ActualDict.Count, Iz.EqualTo(UBound(ExpectedKeys) + 1), "Count of items"
 
+   
    Dim i As Long
    For i = 0 To UBound(ExpectedKeys)
       Assert.IsTrue ActualDict.Exists(ExpectedKeys(i)), ExpectedKeys(i) & " not exists"

source/forms/DeclarationDictForm.cls

@@ -6,6 +6,7 @@ Option Compare Database
 Option Explicit
 
 Private WithEvents m_DeclarationDict As DeclarationDict
+Attribute m_DeclarationDict.VB_VarHelpID = -1
 
 Private m_InsertRecordset As DAO.Recordset
 

source/modules/DeclarationDict.cls

@@ -143,18 +143,21 @@ Public Sub ImportCode(ByVal Code As String)
 
    Code = PrepareCode(Code, RegEx)
 
-   Dim Patterns(2) As String
    Const ProcIndex As Long = 0
-   Const EnumTypeIndex As Long = 1
+   Const EventIndex As Long = 1
+   Const EnumTypeIndex As Long = 2
 
-   Patterns(ProcIndex) = "(?:\r|\n|^)\s*(?:Sub|Function|Property Get|Property Let)\s+(.*)\s*"
+   Dim Patterns(3) As String
+
+   Patterns(ProcIndex) = "(?:\r|\n|^)\s*(?:Sub|Function|Property Get|Property Let|Property Set)\s+(.*)\s*"
+   Patterns(EventIndex) = "(?:\r|\n|^)\s*(?:Event)\s+(.*)\s*"
    Patterns(EnumTypeIndex) = "(?:\r|\n|^)\s*(?:Enum|Type)([\s\S]*?)(?:End\s+(?:Enum|Type))"
-   Patterns(2) = "(?:\r|\n|^)\s*(?:Dim|Private|Friend|Public|Const)\s+(.*)"
+   Patterns(3) = "(?:\r|\n|^)\s*(?:Dim|Private|Friend|Public|Const)\s+(.*)"
 
    Dim i As Long
    For i = 0 To UBound(Patterns)
       RegEx.Pattern = Patterns(i)
-      AddFromCode Code, RegEx, i = ProcIndex, i = EnumTypeIndex
+      AddFromCode Code, RegEx, i = ProcIndex Or i = EventIndex, i = EnumTypeIndex
    Next
 
 End Sub
@@ -177,12 +180,19 @@ Private Function PrepareCode(ByVal Code As String, ByVal RegEx As RegExp) As Str
 
    With RegEx
 
+      ' clear all strings
       .Pattern = """[^""\r\n]*"""
       Code = .Replace(Code, "")
 
+      ' remove comments
       .Pattern = "'(.*)[\r\n]"
       Code = .Replace(Code, "")
 
+      ' dim a as String: a = 5  => insert line break
+      .Pattern = "(\:\s)"
+      Code = .Replace(Code, vbNewLine)
+
+      ' API declaration => rename to normal procedure declaration
       .Pattern = "(?:Declare PtrSafe)\s(Function|Sub)\s"
       Code = .Replace(Code, "Declare $1 ")
 
@@ -192,7 +202,8 @@ Private Function PrepareCode(ByVal Code As String, ByVal RegEx As RegExp) As Str
       .Pattern = "(?:Declare)\s(Function|Sub)\s(.*)Lib\s*[(]"
       Code = .Replace(Code, "$1 $2(")
 
-      .Pattern = "(?:Public|Private|Friend)\s(Function|Sub|Property|Enum|Type|Const)\s"
+      ' remove Public, Private, Friend before Function, Sub, Property, ..
+      .Pattern = "(?:Public|Private|Friend)\s(Function|Sub|Property|Event|Enum|Type|Const)\s"
       Code = .Replace(Code, "$1 ")
 
    End With
@@ -207,6 +218,7 @@ Private Sub AddFromCode(ByVal Code As String, ByVal RegEx As RegExp, ByVal IsPro
    Dim i As Long
 
    For Each Match In RegEx.Execute(Code)
+      If IsProcedure Then Debug.Print Match.Value
       For i = 0 To Match.SubMatches.Count - 1
          AddWordFromDeclaration Match.SubMatches(i), IsProcedure, IsEnumTypeBlock
       Next
@@ -226,7 +238,6 @@ Private Sub AddWordFromDeclaration(ByRef Declarations As String, ByVal IsProcedu
    If IsEnumTypeBlock Then
       Declarations = Replace(Declarations, vbCr, ",")
       Declarations = Replace(Declarations, vbLf, vbNullString)
-      Debug.Print Declarations
    Else
       Declarations = Replace(Declarations, vbCr, vbNullString)
       Declarations = Replace(Declarations, vbLf, vbNullString)
@@ -235,6 +246,7 @@ Private Sub AddWordFromDeclaration(ByRef Declarations As String, ByVal IsProcedu
    Declarations = Trim(Declarations)
 
    If IsProcedure Then
+     ' Debug.Print Declarations
       Declarations = Replace(Declarations, "()", vbNullString)
       Declarations = Replace(Declarations, "Optional ", vbNullString)
       Declarations = Replace(Declarations, "ByRef ", vbNullString)
@@ -246,7 +258,7 @@ Private Sub AddWordFromDeclaration(ByRef Declarations As String, ByVal IsProcedu
       End If
       Declarations = Replace(Declarations, ")", vbNullString)
    ElseIf IsEnumTypeBlock Then
-      Debug.Print Declarations
+   '   Debug.Print Declarations
    End If
 
    Do While InStr(1, Declarations, "  ") > 0

source/modules/_config_Application.bas

@@ -18,7 +18,7 @@ Option Explicit
 Option Private Module
 
 'Version number
-Private Const APPLICATION_VERSION As String = "0.2.0.250304"
+Private Const APPLICATION_VERSION As String = "0.2.1.250304"
 
 Private Const APPLICATION_NAME As String = "ACLib Declaration Dictionary"
 Private Const APPLICATION_FULLNAME As String = "Access-CodeLib - Declaration Dictionary"