Examining Annotations (1) Example for Visual Basic
Private Sub ExamineAnnotations1(objPresStateDS As LEADDicomDS)
Dim sMsg As String
' Get the attributes that describe the "Presentation State Module"
If objPresStateDS.GetPresStateAttributes (0) = DICOM_SUCCESS Then
' Display some
With objPresStateDS.PresStateAttributes
sMsg = "Instance Number: " & .InstanceNumber & vbNewLine & _
"Presentation Label: " & .PresLabel & vbNewLine & _
"Presentation Description: " & .PresDescription & vbNewLine & _
"Presentation Creator’s Name: " & .PresCreatorName
End With
MsgBox sMsg, , "Presentation State Attributes"
End If
Dim lCount As Long, I As Long, J As Long
' Display the SOP Instance UIDs of all the images referenced in the
' "Presentation State Module"
If objPresStateDS.FindFirstPresStateRefSeriesItem () = DICOM_SUCCESS Then
sMsg = ""
Do
lCount = objPresStateDS.GetPresStateImageRefCount ()
For I = 0 To lCount - 1
sMsg = sMsg & _
objPresStateDS.GetPresStateImageRefInstanceUID (I) & _
vbNewLine
Next
sMsg = sMsg & vbNewLine
Loop While objPresStateDS.MoveNextPresStateRefSeriesItem () = DICOM_SUCCESS
MsgBox sMsg, , "Referenced SOP Instance UID(s)"
End If
' Enumerate all the layers defined
lCount = objPresStateDS.LayerCount
MsgBox "Layer Count: " & lCount
For I = 0 To lCount - 1
' Display some of the attributes
If objPresStateDS.GetLayerAttributes (I) = DICOM_SUCCESS Then
With objPresStateDS.LayerAttributes
sMsg = "Graphic Layer: " & .LayerName & vbNewLine & _
"Graphic Layer Order: " & .LayerOrder & vbNewLine & _
"Graphic Layer Description: " & .LayerDescription
End With
MsgBox sMsg, , "Graphic Layer Attributes"
End If
Next
Dim lGraphicObjectCount As Long, lTextObjectCount As Long
' Enumerate all the Graphic Annotation Items
If objPresStateDS.FindFirstGraphicAnnItem () = DICOM_SUCCESS Then
Do
lGraphicObjectCount = objPresStateDS.GetGraphicObjectCount ()
' Or:
'lGraphicObjectCount = objPresStateDS.GetLayerGraphicObjectCount ()
lTextObjectCount = objPresStateDS.GetTextObjectCount ()
' Or:
'lTextObjectCount = objPresStateDS.GetLayerTextObjectCount()
sMsg = "Graphic Layer: " & objPresStateDS.GetLayerName () & vbNewLine & _
"Graphic object count: " & lGraphicObjectCount & vbNewLine & _
"Text object count: " & lTextObjectCount & vbNewLine & vbNewLine
lCount = objPresStateDS.GetLayerImageRefCount ()
If lCount = 0 Then
sMsg = sMsg & _
"The annotations defined in this Item apply to all the " & _
"images listed in the ""Presentation State Module""."
Else
sMsg = sMsg & "Referenced SOP Instance UID(s):" & vbNewLine
For I = 0 To lCount - 1
sMsg = sMsg & " " & _
objPresStateDS.GetLayerImageRefInstanceUID (I) & vbNewLine
Next
End If
MsgBox sMsg, , "Graphic Annotation Item"
' Enumerate all the graphic objects in the current Item
For I = 0 To lGraphicObjectCount - 1
objPresStateDS.GetGraphicObjectAttributes I
With objPresStateDS.GraphicObjectAttributes
sMsg = "Graphic Annotation Units: "
Select Case .Units
Case DICOM_UNIT_PIXEL
sMsg = sMsg & "PIXEL" & vbNewLine
Case DICOM_UNIT_DISPLAY
sMsg = sMsg & "DISPLAY" & vbNewLine
End Select
sMsg = sMsg & "Graphic Type: "
Select Case .Type
Case DICOM_GRAPHIC_OBJECT_TYPE_POINT
sMsg = sMsg & "POINT" & vbNewLine
Case DICOM_GRAPHIC_OBJECT_TYPE_POLYLINE
sMsg = sMsg & "POLYLINE" & vbNewLine
Case DICOM_GRAPHIC_OBJECT_TYPE_INTERPOLATED
sMsg = sMsg & "INTERPOLATED" & vbNewLine
Case DICOM_GRAPHIC_OBJECT_TYPE_CIRCLE
sMsg = sMsg & "CIRCLE" & vbNewLine
Case DICOM_GRAPHIC_OBJECT_TYPE_ELLIPSE
sMsg = sMsg & "ELLIPSE" & vbNewLine
End Select
If .Filled Then
sMsg = sMsg & "Graphic Filled: Y" & vbNewLine
Else
sMsg = sMsg & "Graphic Filled: N" & vbNewLine
End If
lCount = .PointCount
sMsg = sMsg & "Number of Graphic Points: " & lCount & vbNewLine
If lCount < 10 Then
sMsg = sMsg & "Graphic Data: " & vbNewLine
For J = 0 To lCount - 1
sMsg = sMsg & " " & _
"X" & J + 1 & ", Y" & J + 1 & " = " & _
.PointsX (J) & ", " & .PointsY (J) & vbNewLine
Next
End If
MsgBox sMsg, , "Graphic Annotation Object"
End With
Next
' Enumerate all the text objects in the current Item
For I = 0 To lTextObjectCount - 1
objPresStateDS.GetTextObjectAttributes I
With objPresStateDS.TextObjectAttributes
If .BoundingBoxUsed Then
sMsg = "Unformatted Text Value: " & .TextValue & vbNewLine
sMsg = sMsg & "Bounding Box Annotation Units: "
Select Case .BoundingBoxUnits
Case DICOM_UNIT_PIXEL
sMsg = sMsg & "PIXEL" & vbNewLine
Case DICOM_UNIT_DISPLAY
sMsg = sMsg & "DISPLAY" & vbNewLine
End Select
sMsg = sMsg & _
"Bounding Box Top Left Hand Corner: " & _
.BoundingBoxTLHCornerX & ", " & _
.BoundingBoxTLHCornerY & vbNewLine
sMsg = sMsg & _
"Bounding Box Bottom Right Hand Corner: " & _
.BoundingBoxBRHCornerX & ", " & _
.BoundingBoxBRHCornerY & vbNewLine
sMsg = sMsg & "Bounding Box Text Horizontal Justification: "
Select Case .BoundingBoxTextJustification
Case DICOM_TEXT_JUSTIFICATION_LEFT
sMsg = sMsg & "LEFT" & vbNewLine
Case DICOM_TEXT_JUSTIFICATION_RIGHT
sMsg = sMsg & "RIGHT" & vbNewLine
Case DICOM_TEXT_JUSTIFICATION_CENTER
sMsg = sMsg & "CENTER" & vbNewLine
End Select
Else
sMsg = "Unformatted Text Value: " & .TextValue & vbNewLine
sMsg = sMsg & "Anchor Point Annotation Units: "
Select Case .AnchorPointUnits
Case DICOM_UNIT_PIXEL
sMsg = sMsg & "PIXEL" & vbNewLine
Case DICOM_UNIT_DISPLAY
sMsg = sMsg & "DISPLAY" & vbNewLine
End Select
sMsg = sMsg & "Anchor Point: " & _
.AnchorPointX & ", " & _
.AnchorPointY & vbNewLine
If .AnchorPointVisible Then
sMsg = sMsg & "Anchor Point Visibility: Y"
Else
sMsg = sMsg & "Anchor Point Visibility: N"
End If
End If
MsgBox sMsg, , "Text Annotation Object"
End With
Next
Loop While objPresStateDS.MoveNextGraphicAnnItem () = DICOM_SUCCESS
End If
End Sub