IMcRegions2SetFromMask Method

Sub SetFromMask ( 
	SourceBitMask As McBitMask,
	Optional Method As mcSetFromMaskMethod = mcSetFromMaskMethod.mcsfmmDefault
)

'**** BitMaskSamples.bas ****

Option Explicit

'Note: the BoneBig.jpg example image is a good one for these examples
Private Function uLoadExampleImage(Optional strImage As String = "BoneBig.jpg") As Boolean
    If MsgBox("Open example image?", vbYesNo) = vbYes Then
        Images.Open Path + "Images\" + strImage
    End If 'user wants to open an example image
    'Else leave the ActiveImage alone
    If ActiveImage Is Nothing Then
        MsgBox "There is no ActiveImage, so the example cannot run."
    Else
        Output.Show "Output"
        Output.Clear
        ActiveImage.RegionFeatures.Reset
        ActiveImage.LineFeatures.Reset
    End If
    uLoadExampleImage = ActiveImage Is Nothing
End Function 'uLoadExampleImage

'This function gets a bit mask of the thresholded
'foreground bits within the AOI of the ActiveImage
Private Function fGetBitMaskFromAOI() As McBitMask
    Dim myBitMask As McBitMask
    Set myBitMask = CreateOperator("McBitMask", ActiveImage)
    myBitMask.Threshold.Execute 'fill the bit mask with foreground bits
    Output.PrintMessage "The mask has " & myBitMask.BlobCount & " blobs."
    Output.PrintMessage "It is " & myBitMask.Width & " wide by " & myBitMask.Height & " high."
    Set fGetBitMaskFromAOI = myBitMask
End Function 'fGetBitMaskFromAOI

'This function gets a bit mask of thresholded regions within the AOI
' of the ActiveImage that are larger than 200 pixels in size
Private Function fGetBitMaskFromBigRegions() As McBitMask
    With ActiveImage
        .RegionFeatures.Threshold.Execute 'get some regions
        Dim selBigOnes As McObject
        Set selBigOnes = McOpGT(.RegionFeatures.mRgnArea, 200)  'larger than 200 pixels
        Dim myBitMask As McBitMask
        Set myBitMask = .RegionFeatures.CreateFeatureMask(mcfmfReturnMcBitMask, selBigOnes, .Aoi.BoundingRect)
        Output.PrintMessage "The mask of big regions has " & myBitMask.BlobCount & " blobs."
        Output.PrintMessage "It is " & myBitMask.Width & " wide by " & myBitMask.Height & " high."
        myBitMask.BoundsRect = Empty 'set bounds to minimal bounds
        Output.PrintMessage "Minimal bounds are " & myBitMask.Width & " wide by " & myBitMask.Height & " high."
        Set fGetBitMaskFromBigRegions = myBitMask
    End With 'ActiveImage
End Function 'fGetBitMaskFromBigRegions

'Erode the regions within the AOI horizontally by 6 pixels.  Segments are
'NOT allowed to disappear if they are shorter than 7 pixels wide.
Public Sub HorizontalErodeBy6KeepShort()
    If uLoadExampleImage Then Exit Sub
    Dim myBitMask As McBitMask
    Set myBitMask = fGetBitMaskFromAOI 'Threshold and get bit mask of the AOI
    If myBitMask.BlobCount = 0 Then
        Output.PrintMessage "No regions were found."
        Exit Sub
    End If 'no regions found
    Dim rectMask As LONGRECT
    rectMask = myBitMask.BoundsRect
    Dim rngAllSegsSrc() As LONGRANGE
    rngAllSegsSrc = myBitMask.AllSegments
    Dim lSegCountsByLineSrc() As Long
    lSegCountsByLineSrc = myBitMask.SegmentCountsByLine
       'Loop through each scan line and each segment on each line
    Dim lSegCount As Long, lY As Long
    For lY = rectMask.Top To rectMask.Bottom
        Dim SegIndexByLineSrc As Long
        lSegCount = myBitMask.GetLineIndexAndCount(lY, SegIndexByLineSrc)
        If lSegCount = 0 Then GoTo NextY
        'else we have at least one segment on this line
        Dim lSeg As Long
        For lSeg = 0 To lSegCount - 1
            Dim rngNewSeg As LONGRANGE
            rngNewSeg = rngAllSegsSrc(SegIndexByLineSrc + lSeg)
            If (rngNewSeg.End - rngNewSeg.Start) > 6 Then 'segment is 7 or more wide?
                rngNewSeg.Start = rngNewSeg.Start + 3
                rngNewSeg.End = rngNewSeg.End - 3
            Else 'segment is 6 or less, we keep 1 pixel of it
                Dim lAvg As Long
                lAvg = (rngNewSeg.End - rngNewSeg.Start) / 2 + rngNewSeg.Start
                rngNewSeg.Start = lAvg
                rngNewSeg.End = lAvg
            End If 'segment is short, so we keep the central pixel only
                'Put the new segment back into the original segment array.  We can
                'use the original segment array, because we are not allowing any
                'segments to be deleted (or added).
            rngAllSegsSrc(SegIndexByLineSrc + lSeg) = rngNewSeg
        Next lSeg
NextY:
    Next lY 'each scan line in the bit mask
        'Now reassign the bit mask from the modified segments.  We can use the
        'original array of segment counts, because we did not remove or add
        'any segments.
    myBitMask.SetFromSegments lSegCountsByLineSrc, rngAllSegsSrc, rectMask.Top, myBitMask.Connect8
        'Finally, show the horizontally eroded regions
    ActiveImage.RegionFeatures.SetFromMask myBitMask
End Sub 'HorizontalErodeBy6KeepShort

'Erode the regions within the AOI horizontally by 6 pixels.  Segments are
'removed if they are shorter than 7 pixels wide.
Public Sub HorizontalErodeBy6RemoveShort()
    If uLoadExampleImage Then Exit Sub
    Dim myBitMask As McBitMask
    Set myBitMask = fGetBitMaskFromAOI 'Threshold and get bit mask of the AOI
    If myBitMask.BlobCount = 0 Then
        Output.PrintMessage "No regions were found."
        Exit Sub
    End If 'no regions found
    Dim rectMask As LONGRECT
    rectMask = myBitMask.BoundsRect
    Dim rngAllSegsSrc() As LONGRANGE
    rngAllSegsSrc = myBitMask.AllSegments
        'Set up destination segments and counts by line arrays
        'We overallocate the destination segments array
    ReDim rngAllSegsDst(UBound(rngAllSegsSrc)) As LONGRANGE
    ReDim lSegCountsByLineDst(myBitMask.Height - 1) As Long
       'Loop through each scan line and each segment on each line
    Dim lSegCountSrc As Long, lY As Long
    Dim lSegCountDst As Long, lCumulativeSegsDst As Long
    lCumulativeSegsDst = 0
    For lY = rectMask.Top To rectMask.Bottom
        Dim SegIndexByLineSrc As Long
        lSegCountSrc = myBitMask.GetLineIndexAndCount(lY, SegIndexByLineSrc)
        lSegCountDst = 0
        If lSegCountSrc = 0 Then GoTo NextY
        'else we have at least one segment on this line
        Dim lSeg As Long
        For lSeg = 0 To lSegCountSrc - 1
            Dim rngNewSeg As LONGRANGE
            rngNewSeg = rngAllSegsSrc(SegIndexByLineSrc + lSeg)
            If (rngNewSeg.End - rngNewSeg.Start) > 6 Then 'segment is 7 or more wide?
                rngNewSeg.Start = rngNewSeg.Start + 3 'shorten it
                rngNewSeg.End = rngNewSeg.End - 3
                    'Put the new segment into a new segment array.
                rngAllSegsDst(lCumulativeSegsDst + lSegCountDst) = rngNewSeg
                lSegCountDst = lSegCountDst + 1
            End If 'segment is wide enough to keep
            ' else segment is too short to keep, so don't save it
        Next lSeg
NextY:
            'Keep track of destination segment counts on each line
        lSegCountsByLineDst(lY - rectMask.Top) = lSegCountDst
        lCumulativeSegsDst = lCumulativeSegsDst + lSegCountDst
    Next lY 'each scan line in the bit mask
        'Now reassign the bit mask from the modified segments.
    myBitMask.SetFromSegments lSegCountsByLineDst, rngAllSegsDst, rectMask.Top, myBitMask.Connect8
        'Show the horizontally eroded regions, some of them may be gone
    ActiveImage.RegionFeatures.SetFromMask myBitMask
End Sub 'HorizontalErodeBy6RemoveShort

'Draw a line along the left border of regions.
Public Sub ShowLineOnLeftBorder()
    If uLoadExampleImage Then Exit Sub
    Dim myBitMask As McBitMask
    Set myBitMask = fGetBitMaskFromAOI 'Threshold and get bit mask of the AOI
    If myBitMask.BlobCount = 0 Then
        Output.PrintMessage "No regions were found."
        Exit Sub
    End If 'no regions found
    Dim rectMask As LONGRECT
    rectMask = myBitMask.BoundsRect
    Dim rngAllSegsSrc() As LONGRANGE
    rngAllSegsSrc = myBitMask.AllSegments
    Dim lSegCountsByLineSrc() As Long
    lSegCountsByLineSrc = myBitMask.SegmentCountsByLine
       'Loop through each scan line and each segment on each line
    Dim lSegCount As Long, lY As Long
    For lY = rectMask.Top To rectMask.Bottom
        Dim SegIndexByLineSrc As Long
        lSegCount = myBitMask.GetLineIndexAndCount(lY, SegIndexByLineSrc)
        If lSegCount = 0 Then GoTo NextY
        'else we have at least one segment on this line
        Dim lSeg As Long
        For lSeg = 0 To lSegCount - 1
            Dim rngNewSeg As LONGRANGE
            rngNewSeg = rngAllSegsSrc(SegIndexByLineSrc + lSeg)
                'replace each segment by a length-1 segment at the start point
            rngNewSeg.End = rngNewSeg.Start
            rngAllSegsSrc(SegIndexByLineSrc + lSeg) = rngNewSeg
        Next lSeg
NextY:
    Next lY 'each scan line in the bit mask
        'Now reassign the bit mask from the modified segments.  We can use the
        'original array of segment counts, because we did not remove or add
        'any segments.
    myBitMask.SetFromSegments lSegCountsByLineSrc, rngAllSegsSrc, rectMask.Top, myBitMask.Connect8
        'Finally, temporarily show the lines along the left borders
    Dim linesT As McLines
    Set linesT = CreateOperator("McLines", ActiveImage)
        'Note that McLines mcofConnect8 OptionFlags is ON by default.
        'This is important here, because SetFromMask will create one line
        'for each source "blob", each of which has now been eroded to
        'a series of single pixel segments, many of which will be 8-connected
        'to their neighbors.  Occasionally, a line will break where it jumps
        'more than one pixel horizonally, even with an 8-connected test.
        'Output.PrintMessage "Connect8 = " & linesT.OptionFlags(mcofConnect8)
    linesT.SetFromMask myBitMask, mcsfmmLinesExtremeBoundaryAvg
    linesT.AutoDisplay = True
    linesT.DisplayedObjects.SetColors &HFF00FF  'make the color magenta
    linesT.DisplayedObjects.SetLineEnding mcgweStart, mcgleNothing 'no line start
    linesT.DisplayedObjects.SetLineEnding mcgweEnd, mcgleSmallarrow 'small arrow line end
    MsgBox "Look at the lines.  They will disappear when you press OK."
    Set linesT = Nothing 'make those lines go away
End Sub 'ShowLineOnLeftBorder

'Draw a horizontal line across the widest segment of each region.  Note that
'this line will not necessarily traverse the bounding box (e.g., consider
'a crescent moon shape).
'This sample illustrates the use of the AllBlobTags property
Public Sub MarkWidestSection()
    If uLoadExampleImage Then Exit Sub
    Dim myBitMask As McBitMask
    Set myBitMask = fGetBitMaskFromAOI 'Threshold and get bit mask of the AOI
    If myBitMask.BlobCount = 0 Then
        Output.PrintMessage "No regions were found."
        Exit Sub
    End If 'no regions found
    Dim rectMask As LONGRECT
    rectMask = myBitMask.BoundsRect
    Dim rngAllSegsSrc() As LONGRANGE
    rngAllSegsSrc = myBitMask.AllSegments
    Dim lAllBlobTags() As Long
    lAllBlobTags = myBitMask.AllBlobTags
        'Set up per-blob (i.e., per-region) data arrays
    Dim lBlobCount As Long
    lBlobCount = myBitMask.BlobCount
    ReDim rngWidestSeg(lBlobCount - 1) As LONGRANGE
    ReDim lWidestSegY(lBlobCount - 1) As Long
    ReDim bTagHasBeenEncountered(lBlobCount - 1) As Boolean
       'Loop through each scan line and each segment on each line
    Dim lSegCount As Long, lY As Long
    For lY = rectMask.Top To rectMask.Bottom
        Dim SegIndexByLineSrc As Long
        lSegCount = myBitMask.GetLineIndexAndCount(lY, SegIndexByLineSrc)
        If lSegCount = 0 Then GoTo NextY
        'else we have at least one segment on this line
        Dim lSeg As Long
        For lSeg = 0 To lSegCount - 1
            Dim rngNextSeg As LONGRANGE
            rngNextSeg = rngAllSegsSrc(SegIndexByLineSrc + lSeg)
            Dim lBlobTag As Long
            lBlobTag = lAllBlobTags(SegIndexByLineSrc + lSeg)
            If Not bTagHasBeenEncountered(lBlobTag) Then 'First time for this tag?
                rngWidestSeg(lBlobTag) = rngNextSeg
                lWidestSegY(lBlobTag) = lY
                bTagHasBeenEncountered(lBlobTag) = True
            Else 'not first time for this tag
                Dim lSegWidth As Long, lCurrentMaxWidth As Long
                lSegWidth = rngNextSeg.End - rngNextSeg.Start
                lCurrentMaxWidth = rngWidestSeg(lBlobTag).End - rngWidestSeg(lBlobTag).Start
                If lSegWidth > lCurrentMaxWidth Then
                    rngWidestSeg(lBlobTag) = rngNextSeg
                    lWidestSegY(lBlobTag) = lY
                End If 'a new max width for this blob
            End If 'not first time for this tag
        Next lSeg
NextY:
    Next lY 'each scan line in the bit mask

        'Finally, temporarily show a line across each widest segment
    Dim linesT As McLines
    Set linesT = CreateOperator("McLines", ActiveImage)
    Dim lR As Long
    For lR = 0 To myBitMask.BlobCount - 1
        Dim ptsWidest(0 To 1) As LONGPOINT
        ptsWidest(0).x = rngWidestSeg(lR).Start
        ptsWidest(0).y = lWidestSegY(lR)
        ptsWidest(1).x = rngWidestSeg(lR).End
        ptsWidest(1).y = lWidestSegY(lR)
        linesT.SetFeaturePoints lR, ptsWidest
    Next lR
    linesT.AutoDisplay = True
    linesT.DisplayedObjects.SetColors &HFFFF00  'make the color cyan
    linesT.DisplayedObjects.SetLineEnding mcgweStart, mcgleNothing 'no line start
    linesT.DisplayedObjects.SetLineEnding mcgweEnd, mcgleSmallarrow 'small arrow line end
    MsgBox "Look at the lines.  They will disappear when you press OK."
    Set linesT = Nothing 'make those lines go away
End Sub 'MarkWidestSection

'**** CleanUpBordersAndNoiseSamples.bas ****

Option Explicit

'Note: the BoneBig.jpg example image is a good one for these examples
Private Function uLoadExampleImage(Optional strImage As String = "BoneBig.jpg") As Boolean
    If MsgBox("Open example image?", vbYesNo) = vbYes Then
        Images.Open Path + "Images\" + strImage
    End If 'user wants to open an example image
    'Else leave the ActiveImage alone
    If ActiveImage Is Nothing Then
        MsgBox "There is no ActiveImage, so the example cannot run."
    End If
    uLoadExampleImage = ActiveImage Is Nothing
End Function 'uLoadExampleImage


'Utility sub to remove any existing features
Public Sub ResetAllStandardFeatures()
    If ActiveImage Is Nothing Then Exit Sub
    With ActiveImage
        .PointFeatures.Reset
        .LineFeatures.Reset
        .RegionFeatures.Reset
    End With 'ActiveImage
End Sub 'ResetAllStandardFeatures

'Remove region features touching the AOI and ones with area smaller than 25 square pixels
Public Sub RemoveSmallAndTouchingRegions()
    ResetAllStandardFeatures 'remove any existing features
    If uLoadExampleImage Then Exit Sub
    With ActiveImage
        .Aoi.SetBox -1, 100, 100, 250, 250
        .RegionFeatures.Threshold.Execute
        .RegionFeatures.CleanUpBordersAndNoise .Aoi, mcrbAllBorders, 25
    End With 'ActiveImage
End Sub 'RemoveSmallAndTouchingRegions

'Detect blob centers and remove points marking small blobs (< 100 square pixels)
Public Sub DetectNonSmallPoints()
    ResetAllStandardFeatures 'remove any existing features
    If uLoadExampleImage Then Exit Sub
    With ActiveImage
        .Aoi.SetBox -1, 100, 100, 250, 250
        .PointFeatures.SetFromMaskMethod = mcsfmmPointsCentroid
        .PointFeatures.Threshold.Execute 'mark centers of blobs
        .PointFeatures.CleanUpBordersAndNoise .Aoi, mcrbNoBorder, 100
    End With 'ActiveImage.
End Sub 'DetectNonSmallPoints

'Another way to do the above that does not mark any blob touching an AOI boundary
Public Sub DetectNonTouchingCentroids()
    ResetAllStandardFeatures 'remove any existing features
    If uLoadExampleImage Then Exit Sub
    With ActiveImage
        .Aoi.SetBox -1, 100, 100, 250, 250
        Dim mcregionsT As McRegions
        Set mcregionsT = CreateOperator("McRegions", ActiveImage)
        mcregionsT.Threshold.Execute 'find blobs
            'get rid of touching and small blobs
        mcregionsT.CleanUpBordersAndNoise .Aoi, mcrbAllBorders, 100
            'now set PointFeatures from the region centroids
        .PointFeatures.CopyFrom mcregionsT.mpRgnCentroidAsPoint.value
        Set mcregionsT = Nothing 'all done with our temp McRegions
    End With 'ActiveImage.
End Sub 'DetectNonTouchingCentroids

'Remove region features touching each border in turn
Public Sub RemoveTouchingRegionsInTurn()
    ResetAllStandardFeatures 'remove any existing features
    If uLoadExampleImage Then Exit Sub
    With ActiveImage
        .Aoi.SetBox 0, 25, 25, 200, 200
        .Aoi.SetEllipse 1, 250, 270, 250, 100
        .Aoi.SetBox 2, 250, 100, 350, 200
        .RegionFeatures.Threshold.Execute
        MsgBox "OK to remove North regions"
        .RegionFeatures.CleanUpBordersAndNoise .Aoi, mcrbNorth
        MsgBox "OK to remove South regions"
        .RegionFeatures.CleanUpBordersAndNoise .Aoi, mcrbSouth
        MsgBox "OK to remove West regions"
        .RegionFeatures.CleanUpBordersAndNoise .Aoi, mcrbWest
        MsgBox "OK to remove East regions"
        .RegionFeatures.CleanUpBordersAndNoise .Aoi, mcrbEast
        MsgBox "OK to clear all regions"
        .RegionFeatures.Reset
    End With 'ActiveImage
End Sub 'RemoveTouchingRegionsInTurn

'Detect lines and remove ones shorter than 30 pixels
Public Sub DetectNonShortLines()
    ResetAllStandardFeatures 'remove any existing features
    If uLoadExampleImage Then Exit Sub
    With ActiveImage
        .Aoi.Reset 'whole image
        .LineFeatures.SetFromMaskMethod = mcsfmmLinesMajorAxisAlignedAvg
        .LineFeatures.Threshold.Execute 'draw lines across blobs
        .LineFeatures.CleanUpBordersAndNoise .Aoi, mcrbNoBorder, 30
    End With 'ActiveImage.
End Sub 'DetectNonShortLines

'Another way to do the above that does not draw a line on any
'blob touching an AOI boundary.  Lines shorter than 20 pixels are removed.
Public Sub DetectNonTouchingNonShortLines()
    ResetAllStandardFeatures 'remove any existing features
    If uLoadExampleImage Then Exit Sub
    With ActiveImage
        .Aoi.SetBox -1, 20, 20, 300, 300
        Dim mcregionsT As McRegions
        Set mcregionsT = CreateOperator("McRegions", ActiveImage)
        mcregionsT.Threshold.Execute 'find blobs
            'get rid of very small and touching blobs
        mcregionsT.CleanUpBordersAndNoise .Aoi, mcrbAllBorders, 20
            'now set LineFeatures from the cleaned regions' BitMask
        Dim regionsBitMask As McBitMask
        Set regionsBitMask = mcregionsT.CreateFeatureMask(mcfmfReturnMcBitMask)
        Set mcregionsT = Nothing 'all done with our temp McRegions
        .LineFeatures.SetFromMask regionsBitMask, mcsfmmLinesMajorAxisAlignedAvg
            'finally, we get rid of short lines
        .LineFeatures.CleanUpBordersAndNoise .Aoi, mcrbNoBorder, 20
    End With 'ActiveImage.
End Sub 'DetectNonTouchingNonShortLines