Creating DICOM Annotations Example for Visual Basic

Private Sub CreateAnnotations(objPresStateDS As LEADDicomDS)
   ' Set the attributes that describe the "Presentation State Module"
   With objPresStateDS.PresStateAttributes
      .InstanceNumber = 1
      .PresLabel = "SOME_LABEL"
      .PresDescription = "Description of the presentation"
      With .PresCreationDate
         .Year = Year(Date)
         .Month = Month(Date)
         .Day = Day(Date)
      End With
      With .PresCreationTime
         .Hours = Hour(Time)
         .Minutes = Minute(Time)
         .Seconds = Second(Time)
         .Fractions = 0
      End With
      .PresCreatorName = "SomeOne"
   End With
   If objPresStateDS.SetPresStateAttributes () = DICOM_SUCCESS Then
      MsgBox "Presentation State attributes were set successfully."
   End If
   
   ' Add references to some images (under the "Presentation State Module")
   objPresStateDS.AddPresStateImageRef "C:\Image1.dic"
   objPresStateDS.AddPresStateImageRef "C:\Image2.dic"
   objPresStateDS.AddPresStateImageRef "C:\Image3.dic"
   
   Dim sLayerName As String
   
   ' Create a layer
   With objPresStateDS.LayerAttributes
      .LayerName = "LAYER_0" ' "Graphic Layer"
      .LayerOrder = 1
      .DisplayGrayscaleValue = -1
      .DisplayRedValue = -1
      .DisplayGreenValue = -1
      .DisplayRedValue = -1
      .LayerDescription = "Description of the layer"
   End With
   If objPresStateDS.CreateLayer () = DICOM_SUCCESS Then
      sLayerName = objPresStateDS.LayerAttributes.LayerName
      
      MsgBox "Layer '" & sLayerName & "' was created successfully."
      
      ' Change one of the attributes and update the layer
      objPresStateDS.LayerAttributes.LayerOrder = 0
      objPresStateDS.SetLayerAttributes objPresStateDS.NewLayerIndex
   End If
   
   Dim hGraphicAnnItem As Long
   
   ' Create a Graphic Annotation Item
   If objPresStateDS.CreateGraphicAnnItem (0, sLayerName) = DICOM_SUCCESS Then
      MsgBox "A Graphic Annotation Item was created successfully."
      
      objPresStateDS.FindFirstGraphicAnnItem
      hGraphicAnnItem = objPresStateDS.CurrentElement.hElement
   End If
   
   Dim sSOPInstanceUID As String
   
   ' The annotations defined in the Item hGraphicAnnItem will be applied
   ' only to one of the images listed in the Presentation State Module
   If objPresStateDS.FindFirstPresStateRefSeriesItem () = DICOM_SUCCESS Then
      If objPresStateDS.GetPresStateImageRefCount () > 0 Then
         sSOPInstanceUID = objPresStateDS.GetPresStateImageRefInstanceUID (0)
      End If
   End If
   objPresStateDS.SetCurrentElement hGraphicAnnItem
   objPresStateDS.AddLayerImageRef sSOPInstanceUID
   
   ' Let's create a graphic annotation object
   With objPresStateDS.GraphicObjectAttributes
      .LayerName = sLayerName
      .Units = DICOM_UNIT_PIXEL
      .Type = DICOM_GRAPHIC_OBJECT_TYPE_CIRCLE
      .Filled = True
      .PointCount = 2 ' "Number of Graphic Points"
      ' "Graphic Data":
      .PointsX (0) = 252.5
      .PointsY (0) = 252.5
      .PointsX (1) = 209.2
      .PointsY (1) = 199.6
   End With
   If objPresStateDS.CreateGraphicObject(True) = DICOM_SUCCESS Then
      MsgBox "A graphic annotation object was created successfully."
      
      ' Change one of the attributes and update the object
      objPresStateDS.GraphicObjectAttributes.Filled = False
      objPresStateDS.SetGraphicObjectAttributes 0
   End If
   
   ' Let's now create a text annotation object
   With objPresStateDS.TextObjectAttributes
      .LayerName = sLayerName
      .BoundingBoxUsed = True
      .AnchorPointUsed = False
      .BoundingBoxUnits = DICOM_UNIT_PIXEL
      .TextValue = "Text annotation (using a bounding box)"
      .BoundingBoxTLHCornerX = 176.7
      .BoundingBoxTLHCornerY = 117.7
      .BoundingBoxBRHCornerX = 320.3
      .BoundingBoxBRHCornerY = 136.1
      .BoundingBoxTextJustification = DICOM_TEXT_JUSTIFICATION_RIGHT
   End With
   If objPresStateDS.CreateTextObject(True) = DICOM_SUCCESS Then
      MsgBox "A text annotation object was created successfully."
      
      ' Change one of the attributes and update the object
      objPresStateDS.TextObjectAttributes.BoundingBoxTextJustification = DICOM_TEXT_JUSTIFICATION_LEFT
      objPresStateDS.SetTextObjectAttributes 0
   End If
   
   ' And another text annotation object
   With objPresStateDS.TextObjectAttributes
      .LayerName = sLayerName
      .AnchorPointUsed = True
      .BoundingBoxUsed = False
      .AnchorPointUnits = DICOM_UNIT_PIXEL
      .TextValue = "Text annotation (using an anchor point)"
      .AnchorPointX = 277.9
      .AnchorPointY = 382.7
      .AnchorPointVisible = True
   End With
   If objPresStateDS.CreateTextObject(True) = DICOM_SUCCESS Then
      MsgBox "Another text annotation object was created successfully."
   End If
End Sub