refactor so singleton like objects used for pdf obj and their references in the pdf files (vba objects with a non-zero id) when loading existing pdf documents. Allows simple renumbering of objects (all references automatically updated).

Author: PerditionC

dist/CombinePDF.xlsm

@@ -23,7 +23,7 @@ Public Property Get Length() As Long
     ' Length is stored in meta
     ' it should be same as size of data
     If Meta.Exists("/Length") Then
-        Length = CLng(Meta.Item("/Length").Value)
+        Length = CLng(Meta.Item("/Length").value)
     End If
 
     On Error Resume Next
@@ -39,7 +39,7 @@ End Property
 
 ' this will add/update /Length property in meta and resize data()
 Public Property Let Length(ByVal Count As Long)
-    Meta("/Length").Value = Count ' add or replace
+    Meta("/Length").value = Count ' add or replace
 
     On Error Resume Next
     Dim dataLen As Long
@@ -54,7 +54,7 @@ End Property
 
 ' returns stream data [as stored, ie. compressed] as a Byte array
 Public Property Get data() As Byte()
-    data = stream_data.Value
+    data = stream_data.value
 End Property
 
 ' returns stream data in uncompressed form as Byte array
@@ -66,13 +66,13 @@ Public Property Get udata() As Byte()
         If Meta.Exists("/Filter") Then
             ' TODO support all /Filter types
             Dim filter As String
-            filter = Meta.Item("/Filter").Value
+            filter = Meta.Item("/Filter").value
             Select Case LCase(filter)
                 Case "/flatedecode"
                     Dim startIndex As Long: startIndex = 2 ' skip past zlib wrapper to raw Deflate data
                     Dim outSize As Long ' as count of bytes -- should be 0 on entry so will be size on output
                     Dim estBufSize As Long ' if known, uncompressed size
-                    If Meta.Exists("/DL") Then estBufSize = CLng(Meta.Item("/DL").Value) ' only a hint
+                    If Meta.Exists("/DL") Then estBufSize = CLng(Meta.Item("/DL").value) ' only a hint
                     Erase m_udata
 
                     ' Note: libdeflate_inflate arguments are byVal, we expect them be byRef
@@ -90,15 +90,15 @@ Public Property Get udata() As Byte()
                         Dim pdfV As pdfValue
                         Set pdfV = Meta.Item("/DecodeParms")
                         Dim decodeParms As Dictionary
-                        Set decodeParms = pdfV.Value
+                        Set decodeParms = pdfV.value
                         If decodeParms.Exists("/Predictor") Then
                             Set pdfV = decodeParms.Item("/Predictor")
-                            predictor = pdfV.Value
+                            predictor = pdfV.value
                         End If
                         ' should only be supplied if predictor > 1, but we can load value regardless, only used if predictor > 1
                         If decodeParms.Exists("/Columns") Then
                             Set pdfV = decodeParms.Item("/Columns")
-                            columns = pdfV.Value
+                            columns = pdfV.value
                         End If
                         Set pdfV = Nothing
                     End If
@@ -184,7 +184,7 @@ End Property
 
 ' returns meta data as a VBA Dictionary object
 Public Property Get Meta() As Dictionary
-    Set Meta = stream_meta.Value
+    Set Meta = stream_meta.value
 End Property
 
 Public Sub Init(ByRef Meta As pdfValue, ByRef data As pdfValue)

src/pdfLib.xlsm/Class Modules/Dictionary.cls

@@ -5,38 +5,85 @@ END
 Attribute VB_Name = "pdfValue"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
+Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = True
 ' stores a PDF value type
 Option Explicit
 
-Public id As Long
-Public generation As Long
+Private m_id As Long
+Private m_generation As Long
 Public valueType As PDF_ValueType
-Public Value As Variant
+Public value As Variant
 
+' to help maintain id across indirect references, PDF_Object provides a PDF_Reference object to be used by others
+Private m_referenceObj As pdfValue
 
+
+' keep our referencObj in sync
+Public Property Let id(ByVal newId As Long)
+    m_id = newId
+    If valueType = PDF_ValueType.PDF_Object Then
+        If Not referenceObj Is Nothing Then
+            referenceObj.value = m_id
+        End If
+    End If
+End Property
+Public Property Get id() As Long
+    id = m_id
+End Property
+
+' keep our referencObj in sync
+Public Property Let generation(ByVal newGeneration As Long)
+    m_generation = newGeneration
+    If valueType = PDF_ValueType.PDF_Object Then
+        If Not m_referenceObj Is Nothing Then
+            m_referenceObj.generation = m_generation
+        End If
+    End If
+End Property
+Public Property Get generation() As Long
+    generation = m_generation
+End Property
+
+
+' returns an indirect reference object to self
+Friend Property Set referenceObj(ByRef refObj As pdfValue)
+    Set m_referenceObj = refObj
+End Property
+Public Property Get referenceObj() As pdfValue
+    ' create if not already exists
+    If m_referenceObj Is Nothing Then
+        Set m_referenceObj = pdfValue.NewValue(Me, "/Reference")
+    End If
+    
+    ' always return same object so all references updated if id changes
+    Set referenceObj = m_referenceObj
+End Property
+
+
+#If False Then
 ' is this merely an object containing a pdf dictionary? i.e. is Value a pdfValue of PDF_Dictionary
 Function isDictionaryObject() As Boolean
-    If (valueType = PDF_ValueType.PDF_Object) And (Not Value Is Nothing) Then
-        Dim pdfDict As pdfValue: Set pdfDict = Value
+    If (valueType = PDF_ValueType.PDF_Object) And (Not value Is Nothing) Then
+        Dim pdfDict As pdfValue: Set pdfDict = value
         isDictionaryObject = (pdfDict.valueType = PDF_ValueType.PDF_Dictionary)
     End If
 End Function
+#End If
 
 ' returns vba Dictionary instance contained in pdf dictionary
-' Warning: returns Nothing if object lacks dictionary to return
+' Warning: returns Nothing if object lacks dictionary to return, hasKey()
 Function asDictionary() As Dictionary
     On Error GoTo errHandler
     If ((valueType = PDF_ValueType.PDF_Object) Or (valueType = PDF_ValueType.PDF_Dictionary) Or (valueType = PDF_ValueType.PDF_Trailer)) _
-    And (Not IsEmpty(Value)) Then
+    And (Not IsEmpty(value)) Then
         Dim pdfDict As pdfValue
         If (valueType = PDF_ValueType.PDF_Dictionary) Then
             Set pdfDict = Me
         Else
-            Set pdfDict = Value
+            Set pdfDict = value
         End If
-        Set asDictionary = pdfDict.Value
+        Set asDictionary = pdfDict.value
     End If
     Exit Function
 errHandler:
@@ -45,6 +92,20 @@ errHandler:
     Resume
 End Function
 
+' returns True if Dictionary object contains key
+Function hasKey(ByRef key As Variant) As Boolean
+    On Error GoTo errHandler
+    Dim dict As Dictionary
+    Set dict = asDictionary()
+    If Not dict Is Nothing Then hasKey = dict.Exists(key)
+    'Else return False
+    Exit Function
+errHandler:
+    Debug.Print Err.Description & " (" & Err.Number & ")"
+    Stop
+    Resume
+End Function
+
 
 ' Helper function to convert pdf string to byte array (0..N-1)
 ' escaping values as needed
@@ -111,41 +172,41 @@ End Function
 
 
 ' convert pdf Value (Me) into a Byte() array as stored in pdf file
-Function serialize(Optional ByVal baseId As Long = 0) As Byte()
+Public Function serialize(Optional ByVal baseId As Long = 0) As Byte()
     On Error GoTo errHandler
-    Dim Value As pdfValue: Set Value = Me
+    Dim value As pdfValue: Set value = Me
     Dim objStr As String: objStr = vbNullString
     Dim objBytes() As Byte
     Dim IsBytes As Boolean ' for most we convert at end, but stream we leave as Byte()
     Dim v As Variant
     Dim pv As pdfValue
     Dim firstPass As Boolean
 
-    Select Case Value.valueType
+    Select Case value.valueType
         Case PDF_ValueType.PDF_Null
             objStr = "null"
         Case PDF_ValueType.PDF_Name
-            objStr = Value.Value
+            objStr = value.value
         Case PDF_ValueType.PDF_Boolean
-            If Value.Value Then
+            If value.value Then
                 objStr = "true"
             Else
                 objStr = "false"
             End If
         Case PDF_ValueType.PDF_Integer
-            objStr = Format(CLng(Value.Value), "0")
+            objStr = Format(CLng(value.value), "0")
         Case PDF_ValueType.PDF_Real
-            objStr = CDbl(Value.Value) ' dont' format as we want all current digits stored, it won't add extra 0s anyway
+            objStr = CDbl(value.value) ' dont' format as we want all current digits stored, it won't add extra 0s anyway
             ' ensure has .0 if whole number
             If InStr(1, objStr, ".", vbBinaryCompare) < 1 Then objStr = objStr & ".0"
         Case PDF_ValueType.PDF_String
             ' convert to bytes and escape values as needed
             IsBytes = True
-            objBytes = pdfStringToBytes(Value.Value)
+            objBytes = pdfStringToBytes(value.value)
         Case PDF_ValueType.PDF_Array
             objStr = "[ "
             firstPass = True
-            For Each v In Value.Value
+            For Each v In value.value
                 Set pv = v
                 If Not firstPass Then objStr = objStr & " "
                 firstPass = False
@@ -155,44 +216,50 @@ Function serialize(Optional ByVal baseId As Long = 0) As Byte()
         Case PDF_ValueType.PDF_Dictionary
             objStr = "<<" & vbLf
             Dim dict As Dictionary
-            Set dict = Value.Value
+            Set dict = value.value
             firstPass = True
             For Each v In dict.Keys
-                Set pv = dict.Item(v)
                 If Not firstPass Then objStr = objStr & vbLf
                 firstPass = False
-                objStr = objStr & CStr(v) & " "
+                Dim key As String
+                If TypeName(v) = "String" Then
+                    key = CStr(v)
+                Else ' assume pdfValue with valueType=PDF_Name
+                    key = CStr(v.value)
+                End If
+                Set pv = dict.Item(key)
+                objStr = objStr & key & " "
                 objStr = objStr & BytesToString(pv.serialize(baseId))
             Next v
             If Right(objStr, 1) <> vbLf Then objStr = objStr & vbLf
             objStr = objStr & ">>" & vbLf
         Case PDF_ValueType.PDF_Stream       ' actual stream object with dictionary and data
             Dim stream As pdfStream
-            Set stream = Value.Value
+            Set stream = value.value
             IsBytes = True
             objBytes = stream.stream_meta.serialize(baseId)
             CopyBytes stream.stream_data.serialize(baseId), objBytes, 0, UBound(objBytes) + 1
         Case PDF_ValueType.PDF_StreamData   ' represents only stream ... endstream portion
             IsBytes = True
             objBytes = StringToBytes("stream" & vbLf)
-            CopyBytes Value.Value, objBytes, 0, UBound(objBytes) + 1
+            CopyBytes value.value, objBytes, 0, UBound(objBytes) + 1
             CopyBytes StringToBytes(vbLf & "endstream" & vbLf), objBytes, 0, UBound(objBytes) + 1
 
     ' to simplify processing, not one of 9 basic types either
         Case PDF_ValueType.PDF_Object       ' id generation obj << dictionary >> endobj
             IsBytes = True
-            objBytes = StringToBytes(baseId + Value.id & " " & Value.generation & " obj" & vbLf)
-            Dim pdfObj As pdfValue: Set pdfObj = Value.Value
+            objBytes = StringToBytes(baseId + value.id & " " & value.generation & " obj" & vbLf)
+            Dim pdfObj As pdfValue: Set pdfObj = value.value
             CopyBytes pdfObj.serialize(baseId), objBytes, 0, UBound(objBytes) + 1
             If objBytes(UBound(objBytes)) <> 10 Then CopyBytes StringToBytes(vbLf), objBytes, 0, UBound(objBytes) + 1
             CopyBytes StringToBytes("endobj" & vbLf), objBytes, 0, UBound(objBytes) + 1
         Case PDF_ValueType.PDF_Reference    ' indirect object
             ' Note: if indirect reference to /Parent and that obj is not in current set, will have wrong id, offset correct id by -baseId in Reference object prior to saving
-            objStr = baseId + Value.Value & " " & Value.generation & " R"
+            objStr = baseId + value.value & " " & value.generation & " R"
         Case PDF_ValueType.PDF_Comment
-            objStr = Value.Value & vbLf
+            objStr = value.value & vbLf
         Case PDF_ValueType.PDF_Trailer
-            Dim pdfTrailer As pdfValue: Set pdfTrailer = Value.Value
+            Dim pdfTrailer As pdfValue: Set pdfTrailer = value.value
             objStr = "trailer" & vbLf
             objStr = objStr & BytesToString(pdfTrailer.serialize(baseId))
         Case Else
@@ -212,3 +279,87 @@ errHandler:
     Resume
 End Function
 
+
+
+' construction methods, these return new instances of pdfValue
+' can be used by predeclared object, e.g. pdfValue.NewValueObj("/MyName", "/Name")
+
+' returns a name as a pdfValue /Name obj
+Function NewNameValue(ByVal name As String) As pdfValue
+    Set NewNameValue = NewValue(name, "/Name")
+End Function
+
+
+' returns value as a pdfValue obj
+' Note: if value is String then valueType can be used if want a PDF_Name or PDF_Trailer object instead of PDF_String
+' a Dictionary returns a PDF_Dictionary and a Collection returns as PDF_Array
+Function NewValue(ByRef value As Variant, Optional ByRef valueType As String = vbNullString, Optional ByVal id As Long = 0) As pdfValue
+    Dim obj As pdfValue
+    Set obj = New pdfValue
+    
+    ' initialize indirect reference object instance to be shared
+    If id <> 0 Then
+        obj.id = id
+        Set obj.referenceObj = NewValue(obj, "/Reference")
+    End If
+    
+    ' set obj's value and type information
+    Select Case VarType(value)
+        Case vbNull
+            ' always return same instance for Null
+            Static NullValue As pdfValue
+            If NullValue Is Nothing Then
+                obj.valueType = PDF_ValueType.PDF_Null
+                Set NullValue = obj
+            Else
+                Set obj = NullValue
+            End If
+        Case vbLong, vbInteger
+            obj.valueType = PDF_ValueType.PDF_Integer
+            obj.value = CLng(value)
+        Case vbSingle, vbDouble
+            obj.valueType = PDF_ValueType.PDF_Real
+            obj.value = CDbl(value)
+        Case vbBoolean
+            obj.valueType = PDF_ValueType.PDF_Boolean
+            obj.value = CBool(value)
+        Case vbString
+            Select Case valueType
+                Case "/Name"
+                    obj.valueType = PDF_ValueType.PDF_Name
+                    ' ensure /Name object begin with a /
+                    If Left(value, 1) <> "/" Then value = "/" & value
+                    obj.value = value
+                Case Else
+                    obj.valueType = PDF_ValueType.PDF_String
+                    obj.value = CStr(value)
+            End Select
+        Case vbObject
+            Select Case TypeName(value)
+                Case "Dictionary"
+                    obj.valueType = PDF_ValueType.PDF_Dictionary
+                    Set obj.value = value
+                Case "Collection"
+                    obj.valueType = PDF_ValueType.PDF_Array
+                    Set obj.value = value
+                Case "pdfValue"
+                    Select Case valueType
+                        Case "/Trailer"
+                            obj.valueType = PDF_ValueType.PDF_Trailer
+                            Set obj.value = value
+                        Case "/Reference"
+                            obj.valueType = PDF_ValueType.PDF_Reference
+                            obj.value = value.id
+                            obj.generation = value.generation
+                        Case Else ' default to "/Object"
+                            obj.valueType = PDF_ValueType.PDF_Object
+                            Set obj.value = value
+                    End Select
+                Case Else
+                    Stop ' ???
+            End Select
+    End Select
+        
+    Set NewValue = obj
+End Function
+