McBitMask Interface |
![]() |
Namespace: MediaCy.IQL.Features
Public Interface McBitMask Inherits IMcBitMask
'**** 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