McUserMeasure Interface

Class that implements a user-defined measurement

Namespace: MediaCy.IQL.Features
Assembly: MediaCy.IQL.Features (in MediaCy.IQL.Features.dll) Version: 10.0.6912.0

Syntax

Copy

Public Interface McUserMeasure
	Inherits IMcUserMeasure

Remarks

Users can define measurements that become fully integrated with other measurements in the object model. To do so, an instance of McUserMeasure is created and then passed to McEngine.RegisterUserMeasurement along with a name for the measurement. Subsequently, this measurement may be invoked by name on any parent object which it supports (usually a McFeatures object). An instance of this interface must be supplied to the McEngine.RegisterMeasurement method. The McUserMeasure's job is to supply all of the information necessary to describe and compute some measurement on a given McFeatures instance. The calling routines handle all of the heavy lifting with respect to exposing the McMeasure interface (that all measurements must expose) and implementing most of its methods. When your user-defined measurements are only needed temporarily and performance is not critical you can avoid fully implementing a McUserMeasure object, and use the one that is already defined. The predefined McUserMeasure object gets its measurement results via event notifications. You may create an instance of this class "WithEvents" to compute a user defined measurement. Using this notification approach means that you only have to implement a minimum of one "Sub" in VB to support a custom measurement. You must supply at least the ComputeValue event handler (see the EventBasedUserMeasure form sample). The "WithEvents" approach may be slightly easier than implementing an instance of the McUserMeasure class yourself (see the CUserMeasureCircularityMinCode.cls sample, which makes the same measurement as the EventBasedUserMeasure.frm sample). But the class implementation approach has much less overhead, is conceptually cleaner, does not require a form and is little, if any, extra work, so you should use a .CLS module except in very unusual circumstances. You should always use the class-based approach if you need your measurement to be available independent of a defining form, and you should always use this approach if you are adding a new generally accessable measurement. For IMcUserMeasure interfaces implemented by the caller, at the minimum, only the ComputeValue method must do anything. All other methods can just return without doing anything. However, for a measurement that you want to publish to other users, you should also support the the UserDisplayName and UserDescription and UserAttributes methods.

Examples

Copy

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} EventBasedUserMeasure 
   Caption         =   "Event Based User Measurement"
   ClientHeight    =   2280
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4710
   OleObjectBlob   =   "EventBasedUserMeasure.frx":0000
   ShowModal       =   0   'False
   StartUpPosition =   1  'CenterOwner
End






'**** EventBasedUserMeasure.frm ****

'This form illustrates how a user-defined measurement may be implemented with
'event handing.  The measurement defined here, mRgnUserEventsCircularity, will be
'available as a measurment on any McRegions object as long as this form is open.
'
' Note: Circularity as computed here is just the inverse of the built-in mRgnRoundness measurement.
'
'WARNING: the events-base approach to implementing a user-defined measurement
'that is illustrated here is not recommended except in very unusual
'circumstances.  Instead, use a CLS module that implements IMcUserMeasure.  The
'CLS-based approach is much faster, more transparent, can live without a form and
'is not much, if any, more work to implement.  See, for example,
'CUserMeasCircularityMinCode or CUserMeasCircularityFull which implement the same
'measurement defined here using a CLS module.  CUserMeasCircularityMinCode
'and CUserMeasCircularityFull are registered in the
'RegisterExampleUserMeasurements sub found in "McUserMeasure_Examples.bas".

Option Explicit

Dim WithEvents mywitheventsCircularityUserMeasure As McUserMeasure
Attribute mywitheventsCircularityUserMeasure.VB_VarHelpID = -1
Private Const strMeasureName As String = "mRgnUserEventsCircularity"

'***** User measurement supported via events *****

Private Sub mywitheventsCircularityUserMeasure_GetDescription(ByVal MeasurementObject As IMcMeasure, Description As String)
    Description = "Event Version:" + vbCrLf + "Circularity is (Area / Perimeter^2) * 4 * PI."
End Sub

Private Sub mywitheventsCircularityUserMeasure_ComputeValue(ByVal MeasurementObject As IMcMeasure, _
        ByVal ParentOperator As Object, vValue As Variant)
    Dim myRegions As McRegions
    Set myRegions = ParentOperator
    Dim mcobjVal As McObject
    Set mcobjVal = _
        McOpMul(McOpDiv(myRegions.mRgnPolygonialArea, McPow(myRegions.mRgnPerimeter, 2)), 4# * 3.1416)
    'Set results where perimeter or area is zero to missing
    mcobjVal.SelectedValues(McOpOR(McOpEQ(myRegions.mRgnPerimeter, 0#), McOpEQ(myRegions.mRgnPolygonialArea, 0#))) = McMissingDouble
    Set vValue = mcobjVal 'return the McObject itself
    'vValue = mcobjVal 'this also works, but is less efficient
End Sub 'ComputeValue event

'***** Measurement registration *****

Sub RegisterTheMeasurement()
    'Only register the measurement if it is not already registered
    If GetRegisteredUserMeasurement(strMeasureName) Is Nothing Then
        Set mywitheventsCircularityUserMeasure = New McUserMeasure
        RegisterUserMeasurement strMeasureName, mywitheventsCircularityUserMeasure, mcmpaChildOfRegions
    End If ' need to register
End Sub 'RegisterTheMeasurement

Sub UnRegisterTheMeasurement()
    RegisterUserMeasurement strMeasureName, Nothing 'unregister our measurement
    Set mywitheventsCircularityUserMeasure = Nothing 'and we are done with our event handling
End Sub 'UnRegisterTheMeasurement

'***** Form Load/Unload *****

Private Sub UserForm_Initialize()
    RegisterTheMeasurement
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    UnRegisterTheMeasurement
End Sub

'***** Buttons on the form ****

Private Sub OpenImageCB_Click()
    Images.Open Path + "Images\BoneBig.jpg"
        'find some regions
    ActiveImage.RegionFeatures.Threshold.Execute
End Sub 'OpenImageCB_Click

Private Sub ShowMeasurementCB_Click()
    If ActiveImage Is Nothing Then
        Results.Text = "No active image.  Open one and make some RegionFeatures."
        Exit Sub
    End If
    'Here, we show some measurement results
    RegisterTheMeasurement 'in case someone unregistered us, re-register
    Dim myM As McMeasure
    Set myM = ActiveImage.RegionFeatures.mRgnUserEventsCircularity
        'The below also works
    Set myM = ActiveImage.RegionFeatures.Measures(strMeasureName)

    Results.Text = myM.Description
    Results.Text = Results.Text + vbCrLf + "On " + Str(myM.Count) + " selected features." _
        + vbCrLf + "Mean: " + Str(myM.Mean) + vbCrLf _
        + "Min: " + Str(myM.Min) + vbCrLf _
        + "Max: " + Str(myM.Max)
End Sub 'ShowMeasurementCB_Click

Examples

Copy

'**** McUserMeasure_Examples.bas ****

'This module shows how to register and use a variety of example user-defined measurements.
'The example measurements range from bare-bones to full-featured.  Standard,
'per-feature measurements are illustrated as well as non-standard measurements.

'To see how to automatically register user-defined measurements at startup, look at the
'code in the "ThisProject" and "ThisSession" IQStudio Objects.

'See the help on the McMeasure class for a discussion of measurement naming conventions.
'
'Each measurement is implemented in a CLS module as described below:

'CUserMeasureTemplate does not actually implement a measurement, but is a template
'CLS file that you can modify to implement your own measurement.

'CUserMeasureCircularityMinCode implements a standard per-feature measurement of
'region circularity with only the absolute minimum necessary implementation code.
'This measurement is registered as a McRegions measurement named
'"mRgnUserCircularityMinCode" by the RegisterExampleUserMeasurements sub, below.

'CUserMeasCircularityFull implements a standard per-feature measurement of
'region circularity with everything necessary to create a new measurement
'indistiguishable from those built into the application.  This includes a
'localized Display Name and Description, as well as an illustration.
'This measurement is registered as a McRegions measurement named
'"mRgnUserCircularityFull" by the RegisterExampleUserMeasurements sub, below.

'CUserMeasureBoundingRect implements a measurement that has one fixed length array value per
'feature in the ancestor McFeatures object.  The measurement reports the
'bounding rect of each feature as a length-4 array of
'Double in the order Left, Top, Right, Bottom.  The results are
'in calibrated coordinates.
'This measurement is registered by the RegisterExampleUserMeasurements sub below
'under three names: as a McRegions measurement named
'"maRgnUserBoundingRect", as a McLines measurement named "maLnUserBoundingRect"
'and as a McRefFeatures measurement named "maRefUserBoundingRect"

'CUserMeasureCoordinates implements a measurement that results in a variable
'number of values per feature in the ancestor McFeatures object.  The measurement reports the
'coordinate points each feature as a length-N array of 2 Single X and Y values.
'The results are in calibrated coordinates.
'This measurement is registered by the RegisterExampleUserMeasurements sub below
'under two names to work as an immediate child of a McLines or McRegions
'with names mvLnUserCoordinates, mvRgnUserCoordinates, respectively.

'CUserMeasureConvexHull implements a measurement that returns a McRegions result.
'In this case, the result McRegions features are the convex hulls
'of the ancestor McRegions features.  The result McRegions is created
'as a child of the measured ancestor McRegions.
'This measurement is registered by the RegisterExampleUserMeasurements sub below
'as mrRgnUserConvexHull to work as an immediate child of a McRegions object.
'Note that this measurement is the same as the built-in mrRgnConvexHull measurement.

'CUserMeasureSortedIndices implements a measurement that illustrates several
'unusual measurement possiblitilits:
'
' 1.  The measurement results are based on an ancestor McFeatures, but
'the results are not one result associated with each feature the way that
'most measurements are.
'
' 2.  The measurement uses per-McMeasure data to do its work.  Remember
'that only one McUserMeasure instance is registered under a given name,
'so this one instance has to service all McMeasure instances that are
'created on legal parent objects (and there may be many such).
'
' 3.  The standard, automatically serviced dependencies are not
'adequate for this measurement, so it implements the UserIsValueStale
'method to determine when the measurement value needs to be recomputed.
'
' 4.  The measurement results are returned as Long integral values rather than
'as floating point values.

'The measurment result is a 1-dimensional array of feature indices
'showing the sorted order of some per-feature measurement.
'The length of the array is equal to the McFeatures.Count of the ancestor
'McFeatures upon which the measurement is being made, but instead of
'each value corresponding to a feature, it is instead an index of
'the feature that holds that sorted rank order for the measurement being
'sorted (e.g., the feature index with the median sorted-by measurement value
'will be the middle value of this array; see TestExampleUserMeasurements
'below for a couple of examples where this is done).

'The measurement will work with any ancestor McFeatures but it is registered
'under three names to work as an immediate child of a McLines or McRegions, or as
'a descendent of any McFeatures with names miLnUserSortedByLength, miRgnUserSortedByArea
'and miFeatUserSortedByAny, respectively.

Option Explicit

Public Sub RegisterExampleUserMeasurements()
    Dim nRegistered As Long
    nRegistered = 0
        'Turn off notifies from Engine, so only one registration notify can be fired.
        'We do this because repopulating lists of all available measurements can
        'be time consuming, and we only want notify sinks to have to do it once
        'for all of our registrations.
    Dim EngineHasObject As IMcHasObject
    Set EngineHasObject = Engine
    Dim bEntryNotifyState As Boolean
    bEntryNotifyState = EngineHasObject.FirePropertyChangeNotifies
    EngineHasObject.FirePropertyChangeNotifies = False

    'Only register measurements if they are not already registered
    If GetRegisteredUserMeasurement("mRgnUserCircularityMinCode") Is Nothing Then
        RegisterUserMeasurement "mRgnUserCircularityMinCode", New CUserMeasureCircularityMinCode, mcmpaChildOfRegions
        nRegistered = nRegistered + 1
    End If ' need to register mRgnUserCircularityMinCode

    If GetRegisteredUserMeasurement("mRgnUserCircularityFull") Is Nothing Then
        RegisterUserMeasurement "mRgnUserCircularityFull", New CUserMeasureCircularityFull, mcmpaChildOfRegions
        nRegistered = nRegistered + 1
    End If ' need to register mRgnUserCircularityFull

    'The measurement implemented by the CUserMeasureBoundingRect class
    'will work with any ancestor McFeatures but it is registered here
    'under three names to work as an immediate child of a McLines, McRegions or
    'a McRefFeatures with names maLnUserBoundingRect, maRgnUserBoundingRect
    'and maRefUserBoundingRect, respectively.

    If GetRegisteredUserMeasurement("maRgnUserBoundingRect") Is Nothing Then
        RegisterUserMeasurement "maRgnUserBoundingRect", New CUserMeasureBoundingRect, mcmpaChildOfRegions
        nRegistered = nRegistered + 1
    End If ' need to register maRgnUserBoundingRect

    If GetRegisteredUserMeasurement("maLnUserBoundingRect") Is Nothing Then
        RegisterUserMeasurement "maLnUserBoundingRect", New CUserMeasureBoundingRect, mcmpaChildOfLines
        nRegistered = nRegistered + 1
    End If ' need to register maLnUserBoundingRect

    If GetRegisteredUserMeasurement("maRefUserBoundingRect") Is Nothing Then
        RegisterUserMeasurement "maRefUserBoundingRect", New CUserMeasureBoundingRect, mcmpaChildOfRefFeatures
        nRegistered = nRegistered + 1
    End If ' need to register maRefUserBoundingRect

    'The measurement implemented by the CUserMeasureCoordinates class
    'will work with any ancestor McFeatures but it is registered here
    'under two names to work as an immediate child of a McLines or McRegions
    'with names mvLnUserCoordinates and mvRgnUserCoordinates, respectively.

    If GetRegisteredUserMeasurement("mvRgnUserCoordinates") Is Nothing Then
        RegisterUserMeasurement "mvRgnUserCoordinates", New CUserMeasureCoordinates, mcmpaChildOfRegions
        nRegistered = nRegistered + 1
    End If ' need to register mvRgnUserCoordinates

    If GetRegisteredUserMeasurement("mvLnUserCoordinates") Is Nothing Then
        RegisterUserMeasurement "mvLnUserCoordinates", New CUserMeasureCoordinates, mcmpaChildOfLines
        nRegistered = nRegistered + 1
    End If ' need to register mvLnUserCoordinates

    'The measurement implemented by the CUserMeasureConvexHull class
    'will work with any ancestor McRegions but it is registered here
    'named mrRgnUserConvexHull to work as an immediate child of a McRegions.

    If GetRegisteredUserMeasurement("mrRgnUserConvexHull") Is Nothing Then
        RegisterUserMeasurement "mrRgnUserConvexHull", New CUserMeasureConvexHull, mcmpaChildOfRegions
        nRegistered = nRegistered + 1
    End If ' need to register mrRgnUserConvexHull

    'The measurement implemented by the CUserMeasureSortedIndices class will work
    'with any ancestor McFeatures and associated sort-by measurement, but it is
    'registered here under three names.  Two names, "miLnUserSortedByLength" and
    '"miRgnUserSortedByArea", work as an immediate child of a McLines or McRegions,
    'automatically sorting features based on on mLnLength or mRgnArea, respectively.
    'The class is also registered as "miFeatUserSortedByAny" to work as a descendent of
    'any McFeatures and sort based on a measurement assigned to the UserData property
    '(see TestExampleUserMeasurements).  The CUserMeasureSortedIndices parses the
    'registered name to see if it can automatically figure out what measurement to
    'sort on.

    If GetRegisteredUserMeasurement("miLnUserSortedByLength") Is Nothing Then
        RegisterUserMeasurement "miLnUserSortedByLength", New CUserMeasureSortedIndices, mcmpaChildOfLines
        nRegistered = nRegistered + 1
    End If ' need to register miLnUserSortedByLength

    If GetRegisteredUserMeasurement("miRgnUserSortedByArea") Is Nothing Then
        RegisterUserMeasurement "miRgnUserSortedByArea", New CUserMeasureSortedIndices, mcmpaChildOfRegions
        nRegistered = nRegistered + 1
    End If ' need to register miRgnUserSortedByArea

    If GetRegisteredUserMeasurement("miFeatUserSortedByAny") Is Nothing Then
        RegisterUserMeasurement "miFeatUserSortedByAny", New CUserMeasureSortedIndices, mcmpaDescendentOfFeatures
        nRegistered = nRegistered + 1
    End If ' need to register miFeatUserSortedByAny

        'Restore Engine notifies
    EngineHasObject.FirePropertyChangeNotifies = bEntryNotifyState

    If nRegistered <> 0 Then 'were any registered?
        EventLog.WriteEntry Str(nRegistered) + " user measurements registered.", mceleInformation, 0, mcelcFromUser
            'We fire just one "PropertyChanged" notify for all of the registrations
        EngineHasObject.DoFirePropertyChangeNotify ID_IMcEngine_RegisterUserMeasurement
    End If 'any were registered
End Sub 'RegisterExampleUserMeasurements

'Here is an example of using some of the user measurements registered above
Public Sub TestExampleUserMeasurements()
        'Register our example measurements, if necessary
    RegisterExampleUserMeasurements
        'Open BoneBig.jpg as a test image
    Images.Open Path + "Images\BoneBig.jpg"

    With ActiveImage
            'set an AOI
        .Aoi.SetBox -1, 0, 0, 150, 150
        ActiveWindow.View.Magnification = 2#  'and show it bigger
        ActiveWindow.View.Pan = 0
        ActiveWindow.View.Scroll = 0
        Output.Show "Output" 'make sure the Output window's "Output" page is showing
        Output.Clear 'and empty
        With .RegionFeatures
            .Threshold.Execute 'create some regions
            .CleanUpBordersAndNoise , mcrbNoBorder, 200 'get rid of small features
            Output.PrintMessage "*****" + Str(.Count) + " large region features found."
            Output.PrintMessage "Circularities = " + McToText( _
                .mRgnUserCircularityFull, "%0.4f")
            Output.PrintMessage "Bounding Rectangles: " + vbCrLf + McToText( _
                .maRgnUserBoundingRect, "%.2f")
            Output.PrintMessage "First 3 coordinate X,Y values of each region feature: " + vbCrLf + McToText( _
                .Measures("mvRgnUserCoordinates").ValueMcObject.SelectedMcObject(, Array(0, 1, 2)))
            'Note that measurements may be accessed directly by .Name or by .Measures("Name").
            'Both approaches are equally efficient, but the Measures approach has the advantage of
            'allowing you to use intellisense on the McMeasure object's properties and methods.
            'The disadvantage is that it is not as clean looking and so may be more difficult to
            'maintain.
                'Show the convex hulls in yellow
            Dim myConvexHulls As McRegions
            Set myConvexHulls = .mrRgnUserConvexHull.value
            myConvexHulls.AutoDisplay = True 'display the convex hulls
            myConvexHulls.DisplayedObjects.SetColors &HFFFF&

                'Show the biggest region and the median circularity in a different color
            Dim mcobjSortedFeatures As McObject
            Set mcobjSortedFeatures = .miRgnUserSortedByArea.ValueMcObject
            Dim lFeatOfInterest As Long
                'get feature index with highest mRgnArea
            lFeatOfInterest = mcobjSortedFeatures.SelectedValues(mcobjSortedFeatures.VectorLength - 1)
            Dim DisplayedObj As McDisplayedObjects
            Set DisplayedObj = .DisplayedObjects(lFeatOfInterest)
            DisplayedObj.SetColors &HFF00FF 'Magenta
            DisplayedObj.SetBorderWidth 2
            DisplayedObj.SetLabelText "Biggest"
                'get feature index with the median mRgnUserCircularityFull value
            .miFeatUserSortedByAny.UserData = .mRgnUserCircularityFull 'assign the sort-by measurement!
            Set mcobjSortedFeatures = .miFeatUserSortedByAny.ValueMcObject 'get sorted indices
                'get the median feature index
            lFeatOfInterest = mcobjSortedFeatures.SelectedValues(mcobjSortedFeatures.VectorLength / 2)
            Set DisplayedObj = .DisplayedObjects(lFeatOfInterest)
            DisplayedObj.SetColors &HFFFF00 'Cyan
            DisplayedObj.SetBorderWidth 2
            DisplayedObj.SetLabelText McCStr("Median\r\ncircularity")

                'Now wait for the user to look at things before continuing
            MsgBox "The Convex Hull shows in yellow." + vbCrLf + _
                "Largest region shows in magenta." + vbCrLf + _
                "Region with median circularity shows in cyan." + vbCrLf + _
                "When you press OK, the regions will disappear."
            'Clear the regions
            .Reset 'clear .RegionFeatures
            myConvexHulls.AutoDisplay = False 'hide convex hulls
            Set myConvexHulls = Nothing 'release our hold on the mrRgnUserConvexHull
                'Note that the .mrRgnUserConvexHull.Value is cached, so the result
                'McRegions object will not be fully released until the measurement
                'is recomputed.
        End With 'ActiveImage.RegionFeatures

            'Now do a line measurement
        With .LineFeatures
            .SetFromMaskMethod = mcsfmmLinesMajorAxisAlignedAvg
            .Threshold.Execute 'create some lines
            .CleanUpBordersAndNoise , mcrbNoBorder, 25 'get rid of short lines
            Output.PrintMessage vbCrLf + "*****" + Str(.Count) + " long line features found."
            Output.PrintMessage "Bounding Rectangles: " + vbCrLf + McToText( _
                .maLnUserBoundingRect, "%.2f")

                'Show the median length line in a different color
            Set mcobjSortedFeatures = .miLnUserSortedByLength.ValueMcObject
            lFeatOfInterest = mcobjSortedFeatures.SelectedValues(mcobjSortedFeatures.VectorLength / 2)
            Set DisplayedObj = .DisplayedObjects(lFeatOfInterest)
            DisplayedObj.SetColors &HFF00FF 'Magenta
            DisplayedObj.SetBorderWidth 2
            DisplayedObj.SetLabelText McSprintf(McCStr("Median\r\nlength = %.0f"), .mLnLength(lFeatOfInterest))

            MsgBox "Line with median length shows in magenta." + vbCrLf + _
                "When you press OK, the lines will disappear and the image will close." + vbCrLf + _
                "A measurement result report is in the Output window."
            'Clear the lines
            .Reset 'clear .LineFeatures
        End With 'ActiveImage.LineFeatures
        ActiveWindow.Close 'and finally, close the test image
    End With 'ActiveImage
End Sub 'TestExampleUserMeasurements


'You would generally not want to unregister your measurements, but if you needed to
'for some reason, this sub will do the job.
Public Sub UnregisterExampleUserMeasurements()
    Dim nUnregistered As Long
    nUnregistered = 0
        'Turn off notifies from Engine, so only one registration notify can be fired.
        'We do this because repopulating lists of all available measurements can
        'be time consuming, and we only want notify sinks to have to do it once
        'for all of our un-registrations.
    Dim EngineHasObject As IMcHasObject
    Set EngineHasObject = Engine
    Dim bEntryNotifyState As Boolean
    bEntryNotifyState = EngineHasObject.FirePropertyChangeNotifies
    EngineHasObject.FirePropertyChangeNotifies = False

    If Not GetRegisteredUserMeasurement("mRgnUserCircularityMinCode") Is Nothing Then
        RegisterUserMeasurement "mRgnUserCircularityMinCode", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("mRgnUserCircularityFull") Is Nothing Then
        RegisterUserMeasurement "mRgnUserCircularityFull", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("maRgnUserBoundingRect") Is Nothing Then
        RegisterUserMeasurement "maRgnUserBoundingRect", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("maLnUserBoundingRect") Is Nothing Then
        RegisterUserMeasurement "maLnUserBoundingRect", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("maRefUserBoundingRect") Is Nothing Then
        RegisterUserMeasurement "maRefUserBoundingRect", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("mvRgnUserCoordinates") Is Nothing Then
        RegisterUserMeasurement "mvRgnUserCoordinates", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("mvLnUserCoordinates") Is Nothing Then
        RegisterUserMeasurement "mvLnUserCoordinates", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("mrRgnUserConvexHull") Is Nothing Then
        RegisterUserMeasurement "mrRgnUserConvexHull", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("miLnUserSortedByLength") Is Nothing Then
        RegisterUserMeasurement "miLnUserSortedByLength", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("miRgnUserSortedByArea") Is Nothing Then
        RegisterUserMeasurement "miRgnUserSortedByArea", Nothing
        nUnregistered = nUnregistered + 1
    End If
    If Not GetRegisteredUserMeasurement("miFeatUserSortedByAny") Is Nothing Then
        RegisterUserMeasurement "miFeatUserSortedByAny", Nothing
        nUnregistered = nUnregistered + 1
    End If

        'Restore Engine notifies
    EngineHasObject.FirePropertyChangeNotifies = bEntryNotifyState

    If nUnregistered <> 0 Then 'were any registered?
        EventLog.WriteEntry Str(nUnregistered) + " user measurements un-registered.", mceleInformation, 0, mcelcFromUser
            'We fire just one "PropertyChanged" notify for all of the un-registrations
        EngineHasObject.DoFirePropertyChangeNotify ID_IMcEngine_RegisterUserMeasurement
    End If 'any were registered
End Sub 'UnregisterExampleUserMeasurements

Examples

Copy

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END





'**** CUserMeasureTemplate.cls ****

'This CLS module is a template for you to modify and fill in to implement your own measurement.
'Replace all occurances of CUserMeasureTemplate with your class module name.

'Some results are shown returning Localized strings and reference "MyLocModuleName".  This
'module should be a .LOC file (e.g., CUserMeasureTemplate.loc), copies of which are to be
'placed in Path + "Resources\1033" (for English) and in other Path + "Resources\1NNN" directories
'for other languages.  If such a file is missing for the current localization, then no translation is done.
'Look at the existing .LOC files for how to specify translations.

Option Explicit

Implements McRegionLib.IMcUserMeasure

Private Function IMcUserMeasure_ComputeValue(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
    ByVal ParentOperator As Object) As Variant
        'This is the only method that is required to do anything.  This method must
        'return a Variant result that agrees with the Attributes of the measurement
        'with respect to type and shape.  The default Attributes call for one value
        'per feature of a McFeatures ParentOperator to be returned as a 1-D array of Double.
        'Below are two examples of such measurements.  One uses a For loop to
        'compute the result for each feature.  The other uses McOMGlobal array operations.

    On Error GoTo IMcUserMeasure_ComputeValue_Error

'    'Example 1: measure the number of vertices on each feature using a For loop
'    Dim myFeat As McFeatures, lF As Long
'    Set myFeat = ParentOperator
'    If myFeat.Count = 0 Then 'no features?
'        IMcUserMeasure_ComputeValue = Empty
'        Exit Function
'    End If 'no features, so return an Empty result
'    'ELSE we have at least one feature
'    ReDim dResultArray(myFeat.Count - 1) As Double
'    For lF = 0 To myFeat.Count - 1
'        Dim lVertexCount As Long
'        lVertexCount = myFeat.GetFeaturePoints(lF)
'        dResultArray(lF) = lVertexCount
'    Next lF
'    IMcUserMeasure_ComputeValue = dResultArray

'    'Example 2: measure the ratio of polygon perimeter to chain-code perimeter using array operations
'    Dim myR As McRegions
'    Set myR = ParentOperator
'    Set IMcUserMeasure_ComputeValue = _
'        McOpDiv(myR.mRgnPerimeter.ValueMcObject, myR.mRgnPerimeter2.ValueMcObject)
'   'McOpDiv correctly handles zero-length arrays, so no test for myR.Count=0 is needed.

    On Error GoTo 0
    Exit Function
IMcUserMeasure_ComputeValue_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_ComputeValue of Class Module CUserMeasureTemplate"
End Function

Private Function IMcUserMeasure_UserDisplayName(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The display name should be less than 32 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDisplayName = _
        Localized("Display Name", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserDescription(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The description should be less than 128 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDescription = _
        Localized("Measurement description of less than 128 characters.", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserAttributes(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        ByVal AttributeId As McRegionLib.mcMeasurementAttributeID) As Variant
    On Error GoTo IMcUserMeasure_UserAttributes_Error

    Select Case AttributeId

        Case mcmaidDependencies
                'Here you can specify the standard dependencies for your measurement and
                'arrange to have the UserIsValue stale method called if you have some
                'non-standard dependency.  In addition, this Attribute case is called only
                'once for each measurement supported, so you should do any per McMeasure
                'object initialization here.  The default dependencies are generally overkill,
                'so you can usually avoid unnecessary recomputations by specifying a more
                'restricted set of dependencies.  Also, if you want the UserIsValue
                'method to be called, you must return mcmdfOther among your dependencies.

                'Set RangeMin/Max for this measurement, if necessary
'            MeasurementObject.RangeMin = 0# 'for example
'            MeasurementObject.RangeMax = 1#
'               'Other initialization goes here, if needed (often none is needed).
'            IMcUserMeasure_UserAttributes = _
'                mcmdfFeatureData Or mcmdfSpatialCalib  'e.g., if the measure has no luminance dependence

        Case mcmaidDisconnectMeasure
                'This Attribute case is called once for each measurement supported
                'at the time that the measurement is disconnected from its McMeasure,
                'so you should do any per McMeasure object cleanup here.  Be especially
                'sure to release any object references that you are holding, so that you
                'do not create a "cross-lock" situation that prevents objects from being
                'freed.
                'You never need to return anything.

        Case mcmaidAllowedParent
                'This will usually be mcmpChildOfPoints, mcmpChildOfLines, mcmpChildOfRegions
                'or mcmpChildOfRefFeatures.  Only in rare cases will it be anything else.
                'The default is mcmpChildOfFeatures, which means that your measurement is
                'allowed to be created as a child of any McPoints, McLines or McRegions
                'object.  This default might be suitable for a few measurements that
                'could work on any type of McFeatures (e.g., one that computed the center
                'of the bounding rectangle of each feature), but in most cases measurements
                'are specific to
'            IMcUserMeasure_UserAttributes = _
'                mcmpChildOfRegions  'for example

        Case mcmaidCategories
                'Categories are OR'ed together from the mcMeasurementCategoryFlags
                'Only measurements with the mcmcfManualMeasure flag set will be available
                'as part of manual measurements; these must be 1-dimensional, one-feature
                'per measurement measurements (mcmaidPerFeatureMeasurement returns True
                'and mcmaidNofDimensions returns 1).  The mcmcfUserDefined flag is
                'automatically included, so you don't have to supply it here.
                'Note that if your measurement returns angular results, you should set the
                'mcmcfAngleResult bit, and if the measurement results ignore calibrations,
                'you should set the mcmcfUncalibratedResult bit.  These bits affect how
                'unit names are generated for the mcmaidUnitsAbbrev and mcmaidUnitsName
                'attributes (see below).
'            IMcUserMeasure_UserAttributes = _
'                  mcmcfFeatureShape Or mcmcfIgnoresHoles Or mcmcfManualMeasure 'for example

        Case mcmaidPerFeatureMeasurement
                'True is the default.  Only supply this (as False) if you have some
                'non-feature based measurement, or if the measurement is not
                'one-result-per-feature.

        Case mcmaidNofDimensions
                'The default value is 1.  Only supply this if you have some scalar result
                '(return 0) or a multidimensional result.  Note that measurements with
                'variable second dimensions are returned as a 1-D array of Variant, but
                'you still need to report 2 dimensions (see mcmaidShape).
'            IMcUserMeasure_UserAttributes = _
'                2  'for example for a 2-dimensional result

        Case mcmaidShape
                'Shape is reported using C/C++ dimension ordering; that is, the
                'slowest moving dimension first. VB/VBA dimension ordering is the
                'reverse of this. Default is all dimension sizes 0, meaning
                'variable, which is suitable for 1-D per-feature measurements and
                '2-D per-feature measurements where the size of the second,
                'fastest moving, dimension varies for each feature (e.g., like
                'the mvRgnBranchLengths built-in measurement).  For 2-D
                'per-feature measurements where the second dimension is of fixed
                'size, you supply that here.
'            IMcUserMeasure_UserAttributes = _
'                Array( 0, 4)  'for example a measurement returning a RECT for each feature.

        Case mcmaidResultType
                'The default is mcmrtNumeric.  Only if your measurement returns a McPoints,
                'McLines or McRegions as its value should this be mcmrtMcPoints,
                'mcmrtMcLines or mcmrtMcRegions respectively.
'            IMcUserMeasure_UserAttributes = _
'                mcmrtMcPoints 'for example a measurement returning McPoints object.

        Case mcmaidResultValueType
                'You not will need to set this unless you are not creating Double numeric
                'results.  It is recommended that all numeric results be Double, even for
                'integral results such as counts; this allows client code to handle all measurements
                'symmetrically.  The default is vbDouble, which applies only to
                'measurements where Attributes(mcmaidResultType) is mcmrtNumeric; for
                'all the other result types, the Value property is a McFeatures object and
                'this case should be left blank or return vbObject.

        Case mcmaidResultMcObjectType
                'You not will need to set this unless you are not creating Double numeric
                'results.  It is recommended that all numeric results be Double, even for
                'integral results such as counts; this allows client code to handle all measurements
                'symmetrically.  The default is mcobjTypeREAL, which applies only to
                'measurements where Attributes(mcmaidResultType) is mcmrtNumeric; for
                'all other the result types, the ValueMcObject property is Nothing and
                'this case should be left blank or return mcobjTypeUNKNOWN.

        Case mcmaidIllustration
                'An optional illustration for your measurement.  If you supply this it should
                'be an 80 pixels wide by 60 high high Picture object.  Use the supplied
                'examples to start so that your illustration resembles the ones for the
                'built-in measurement.
'            Dim ProjectPath As String
'            ProjectPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(VBE.VBProjects(ThisProject.Name).FileName)
'            Dim myPict As New StdPicture
'            Set myPict = LoadPicture(ProjectPath + "MyProject\MyIllustration.bmp")
'            Set IMcUserMeasure_UserAttributes = myPict

        Case mcmaidDefaultRangeMin
                'The minimum value that your measurement values can be.  The default is
                'a huge negative number.  The value is used to set the intial value of
                'the RangeMin property, which is used only for the Filter method'
'            IMcUserMeasure_UserAttributes = _
'                0# 'for example, some measurement that cannot take on negative values

        Case mcmaidDefaultRangeMax
                'The maximum value that your measurement values can be.  The default is
                'a huge postive number.  The value is used to set the intial value of
                'the RangeMax property, which is used only for the Filter method'
'            IMcUserMeasure_UserAttributes = _
'                1# 'for example, some measurement that cannot exceed 1.0

        Case mcmaidSpatialUnitExponent
                'As Long. If no spatial calibration unit applies to this measurement result,
                'then this value is zero (which is the default). Otherwise this is the exponent
                'to apply to the SpatialCalibration.UnitAbbrev or UnitName (or Pixels if the
                'mcmcfUncalibratedResult bit of Attributes(mcmaidCategories) is set). For
                'example, Attributes(mcmaidSpatialUnitExponent) mRgnHeterogeneity is
                'unitless, so the value is zero; mRgnDensity has no spatial dependence, so
                'its value is also zero; for mLnLength the value is 1; for mRgnArea the value
                'is 2, and for mRgnIntegratedOD (density/area) the value is -2.  The value of
                'Attributes(mcmaidIntensityUnitExponent) for these measurments are zero, 1,
                '0, 0 and 1, respectively. The value for measurements that return angle
                'results is zero, but in this case Attributes(mcmaidCategories) needs to have the
                'mcmcfAngleResult bit set.
'            IMcUserMeasure_UserAttributes = _
'                2& 'for example, some measurement needing units of area

        Case mcmaidIntensityUnitExponent
                'As Long. If no intensity calibration unit applies to this measurement result,
                'then this value is zero (which is the default). Otherwise this is the exponent
                'to apply to the IntensityCalibration.UnitAbbrev or UnitName (or raw pixel
                'luminance values if the mcmcfUncalibratedResult bit of Attributes(mcmaidCategories) is set).
                'For example, Attributes(mcmaidIntensityUnitExponent) mRgnHeterogeneity is
                'unit-less, so the value is 0; mLnLength has no intensity dependence, so its
                'value is zero; for mRgnDensity the value is 1, and for mRgnIntegratedOD
                '(density/area) the value is 1.  The value of Attributes(mcmaidSpatialUnitExponent)
                'for these measurements are zero, 1, 0, -2, respectively.
'            IMcUserMeasure_UserAttributes = _
'                1& 'for example, some measurement needing units of density

        Case mcmaidUnitsAbbrev
                'You will generally not need to return this attribute if you have properly handled the
                'mcmaidSpatialUnitExponent and mcmaidIntensityUnitExponent attributes, above, because
                'they are used to compute the proper units by default.  However, in rare circumstances
                'you may wish to supply your own units; you will have to do so if your result is an
                'angular measure that returns radians instead of degrees.
'            IMcUserMeasure_UserAttributes = _
'                Localized("rad", "MyLocModuleName") 'e.g., for an angle measure returning radians rather than degrees


        Case mcmaidUnitsName
                'You will generally not need to return this attribute if you have properly handled the
                'mcmaidSpatialUnitExponent and mcmaidIntensityUnitExponent attributes, above, because
                'they are used to compute the proper units by default.  However, in rare circumstances
                'you may wish to supply your own units; you will have to do so if your result is an
                'angular measure that returns radians instead of degrees.
'            IMcUserMeasure_UserAttributes = _
'                Localized("radians", "MyLocModuleName") 'e.g., for an angle measure returning radians rather than degrees

        Case mcmaidAbbreviation
                'You will almost always want to return this attribute to give your measurement a short
                'abbreviation, suitable for labeling measurements on the image.  Try to keep it to 5
                'characters or less.
'            IMcUserMeasure_UserAttributes = _
'                Localized("Nvrts", "MyLocModuleName") 'e.g., for a "Number of vertices" measurement


        Case Else

    End Select 'AttributeId

    On Error GoTo 0
    Exit Function
IMcUserMeasure_UserAttributes_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_UserAttributes of Class Module CUserMeasureTemplate"
End Function

Private Function IMcUserMeasure_UserIsValueStale(ByVal MeasurementObject As McRegionLib.IMcMeasure) As Boolean
    On Error GoTo IMcUserMeasure_UserIsValueStale_Error
        'This method will only be called if the IMcUserMeasure_UserAttributes mcmaidDependencies
        'case returns mcmdfOther among the mcMeasurementDependencyFlags.  In that case, then
        'this method will be called before any Value access to see if the value needs to
        'be recomputed.  The method must return True if the measurement is stale for some
        'reason beyond the standard mcMeasurementDependencyFlags returned
        '(which are already taken care of automatically, and so do not need to be tested for
        'here).

'    'Example: see if the maRgnRadii measurement is stale or has a ValueSequence greater than
'    'ours.  The maRgnRadii measurement can go stale if its NumAngles property is assigned-to,
'    'and no standard dependency can detect this automatically.
'    '
'    Dim myParentRegions As McRegions
'    Set myParentRegions = MeasurementObject.Attributes(mcmaidParent)
'    IMcUserMeasure_UserIsValueStale = _
'        (myParentRegions.maRgnRadii.ValueSequence(MeasurementObject.ValueSequence) = 0)

    On Error GoTo 0
    Exit Function
IMcUserMeasure_UserIsValueStale_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_UserIsValueStale of Class Module CUserMeasureTemplate"
End Function

Examples

Copy

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END






'***** CUserMeasureCircularityMinCode.cls ******

'This class module shows the absolute minimum code necessary to implement a measurement
'with a result that has one scalar value per feature in the parent McFeatures object.
'In this case you only need to return a 1-dimensional array of values from the
'ComputeValue method.  See the CUserMeasureCircularityFull.cls module for a more
'complete implementation of this measurement.
'
' Note: Circularity as computed here is just the inverse of the built-in mRgnRoundness measurement.

Option Explicit

Implements McRegionLib.IMcUserMeasure

Private Function IMcUserMeasure_ComputeValue(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        ByVal ParentOperator As Object) As Variant
    Dim myRegions As McRegions
    Set myRegions = ParentOperator
    Dim mcobjVal As McObject
    Set mcobjVal = _
        McOpMul(McOpDiv(myRegions.mRgnPolygonialArea, McPow(myRegions.mRgnPerimeter, 2)), 4# * 3.1416)
    'Set results where perimeter or area is zero to missing
    mcobjVal.SelectedValues(McOpOR(McOpEQ(myRegions.mRgnPerimeter, 0#), McOpEQ(myRegions.mRgnPolygonialArea, 0#))) = McMissingDouble
    Set IMcUserMeasure_ComputeValue = mcobjVal 'return the McObject result
    'IMcUserMeasure_ComputeValue = mcobjVal 'this also works, but is less efficient
End Function

Private Function IMcUserMeasure_UserDisplayName(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
End Function

Private Function IMcUserMeasure_UserDescription(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
End Function

Private Function IMcUserMeasure_UserAttributes(ByVal MeasurementObject As McRegionLib.IMcMeasure, ByVal AttributeId As McRegionLib.mcMeasurementAttributeID) As Variant
End Function

Private Function IMcUserMeasure_UserIsValueStale(ByVal MeasurementObject As McRegionLib.IMcMeasure) As Boolean
End Function

Examples

Copy

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END






'***** CUserMeasureCircularityFull.cls ******

'This class module shows the code necessary to implement a measurement that is
'indistinguishable from a built-in measurement.  This example implements a
'measurement that has one scalar value per feature in the parent McFeatures
'object, which is typical of most measurements.
'
' See McUserMeasure_Examples.bas for how to register this measurement.
'
' Note: Circularity as computed here is just the inverse of the built-in mRgnRoundness measurement.

Option Explicit

Implements McRegionLib.IMcUserMeasure

Private Function IMcUserMeasure_ComputeValue(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        ByVal ParentOperator As Object) As Variant
    On Error GoTo IMcUserMeasure_ComputeValue_Error

    Dim myRegions As McRegions
    Set myRegions = ParentOperator
    Dim mcobjVal As McObject
    Set mcobjVal = _
        McOpMul(McOpDiv(myRegions.mRgnPolygonialArea, McPow(myRegions.mRgnPerimeter, 2)), 4# * 3.1416)
    'Set results where perimeter or area is zero to missing
    mcobjVal.SelectedValues(McOpOR(McOpEQ(myRegions.mRgnPerimeter, 0#), McOpEQ(myRegions.mRgnPolygonialArea, 0#))) = McMissingDouble
    Set IMcUserMeasure_ComputeValue = mcobjVal 'return the McObject result
    'IMcUserMeasure_ComputeValue = mcobjVal 'this also works, but is less efficient

    On Error GoTo 0
    Exit Function
IMcUserMeasure_ComputeValue_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_ComputeValue of Class Module CUserMeasureCircularityFull"
End Function

Private Function IMcUserMeasure_UserDisplayName(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The display name should be less than 32 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDisplayName = _
        Localized("Circularity", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserDescription(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The description should be less than 128 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDescription = _
        Localized("Circularity is (Area / Perimeter^2) * 4 * PI.", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserAttributes(ByVal MeasurementObject As McRegionLib.IMcMeasure, ByVal AttributeId As McRegionLib.mcMeasurementAttributeID) As Variant

    Select Case AttributeId

        Case mcmaidDependencies
            'Here is where we do any required intialization, but none is needed for this measurement.
                'We do NOT return mcmdfOther, because the below cover all our dependencies
            IMcUserMeasure_UserAttributes = _
                mcmdfFeatureData Or mcmdfSpatialCalib

'        Case mcmaidDisconnectMeasure
'                'No cleanup needed for this measurement.

        Case mcmaidAllowedParent
            IMcUserMeasure_UserAttributes = _
                mcmpChildOfRegions

        Case mcmaidCategories
            IMcUserMeasure_UserAttributes = _
                  mcmcfFeatureShape Or mcmcfIgnoresHoles Or mcmcfManualMeasure

'        Case mcmaidPerFeatureMeasurement
'                'True is the default, which works for us.

'        Case mcmaidNofDimensions
'                'The default value is 1, which is OK by us.

'        Case mcmaidShape
'                'Default is all dimension sizes 0, which is OK by us

'        Case mcmaidResultType
'                'The default is mcmrtNumeric which is OK by us.

'        Case mcmaidResultValueType
'                The default is vbDouble, which is OK by us.

'        Case mcmaidResultMcObjectType
'               'The default is mcobjTypeREAL, which is OK by us.

        Case mcmaidIllustration
                'An optional 80 by 60 illustration for the measurement.
            Dim ProjectPath As String
            ProjectPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(VBE.VBProjects(ThisProject.Name).FileName)
            Dim myPict As New StdPicture
            Set myPict = LoadPicture(ProjectPath + "\Circularity.bmp")
            Set IMcUserMeasure_UserAttributes = myPict

        Case mcmaidDefaultRangeMin
            IMcUserMeasure_UserAttributes = _
                0# 'Circularity ranges from 0 to 1

        Case mcmaidDefaultRangeMax
            IMcUserMeasure_UserAttributes = _
                1# 'Circularity ranges from 0 to 1

'        Case mcmaidSpatialUnitExponent
'               'The default is zero, which is OK since this result in unit-less.

'        Case mcmaidIntensityUnitExponent
'               'The default is zero, which is OK since this result in unit-less.

'        Case mcmaidUnitsAbbrev
'        Case mcmaidUnitsName
'               'The default handles this properly based on mcmaidSpatialUnitExponent and mcmaidIntensityUnitExponent.

        Case mcmaidAbbreviation
            IMcUserMeasure_UserAttributes = "Circ" 'measurement abbreviated name

        Case Else

    End Select 'AttributeId
End Function

Private Function IMcUserMeasure_UserIsValueStale(ByVal MeasurementObject As McRegionLib.IMcMeasure) As Boolean
        'Nothing needs to be done here, as the automatically detected dependencies
        'are suffiecient (see the mcmaidDependencies Case, above).
End Function

Examples

Copy

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END






'***** CUserMeasureBoundingRect.cls ******

'Note: this a more advanced and unusual example than that shown in
'CUserMeasureCircularityFull, so you should be familiar with that
'one first.

'This example implements a measurement that has one fixed length array value per
'feature in the ancestor McFeatures object.  The measurement reports the
'bounding rect of each feature as a length-4 array of
'Double in the order Left, Top, Right, Bottom.  The results are
'in calibrated coordinates.
'
'See McUserMeasure_Examples.bas for how to register this measurement.  The
'measurement will work with any ancestor McFeatures but it is registered
'under three names to work as an immediate child of a McLines, McRegions or
'a McRefFeatures with names maLnUserBoundingRect, maRgnUserBoundingRect
'and maRefUserBoundingRect, respectively.
'

Option Explicit

Implements McRegionLib.IMcUserMeasure

Private Function IMcUserMeasure_ComputeValue(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        ByVal ParentOperator As Object) As Variant
   On Error GoTo IMcUserMeasure_ComputeValue_Error

        'Measurement works with any ancestor McFeatures
    Dim myFeat As McFeatures, lF As Long
    Set myFeat = AncestorOfOperator(MeasurementObject, "McFeatures")
    If myFeat.Count = 0 Then 'no features?
        IMcUserMeasure_ComputeValue = Empty
        Exit Function
    End If 'no features, so return an Empty result
    'ELSE we have at least one feature
    ReDim d2DResultArray(3, myFeat.Count - 1) As Double
    For lF = 0 To myFeat.Count - 1
        Dim rectB As SINGLERECT
        rectB = myFeat.BoundingRect(lF)
            'calibrate the results, if necessary
        If Not myFeat.SpatialCalibration Is Nothing Then
            myFeat.SpatialCalibration.CalibrateFloatPoints rectB
        End If
        d2DResultArray(0, lF) = rectB.Left
        d2DResultArray(1, lF) = rectB.Top
        d2DResultArray(2, lF) = rectB.Right
        d2DResultArray(3, lF) = rectB.Bottom
    Next lF
    IMcUserMeasure_ComputeValue = d2DResultArray

    On Error GoTo 0
    Exit Function
IMcUserMeasure_ComputeValue_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_ComputeValue of Class Module CUserMeasureBoundingRect"
End Function

Private Function IMcUserMeasure_UserDisplayName(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The display name should be less than 32 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDisplayName = _
        Localized("Bounding Rectangle", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserDescription(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The description should be less than 128 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDescription = _
        Localized("Bounding rectangle as an array in the order Left, Top, Right, Bottom", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserAttributes(ByVal MeasurementObject As McRegionLib.IMcMeasure, ByVal AttributeId As McRegionLib.mcMeasurementAttributeID) As Variant

    Select Case AttributeId

        Case mcmaidDependencies
            'Here is where we do any required intialization, but none is needed for this measurement.
                'We do NOT return mcmdfOther, because the below cover all our dependencies
            IMcUserMeasure_UserAttributes = _
                mcmdfFeatureData Or mcmdfSpatialCalib

'        Case mcmaidDisconnectMeasure
'                'No cleanup needed for this measurement.

        Case mcmaidAllowedParent
            IMcUserMeasure_UserAttributes = _
                mcmpDescendentOfFeatures        'works with any ancestor McFeatures

        Case mcmaidCategories
            IMcUserMeasure_UserAttributes = _
                  mcmcfFeatureShape Or mcmcfIgnoresHoles Or mcmcfSize Or mcmcfPosition

'        Case mcmaidPerFeatureMeasurement
'                'True is the default, which works for us.

        Case mcmaidNofDimensions
            IMcUserMeasure_UserAttributes = 2

        Case mcmaidShape
                'Shape is reported using C/C++ dimension ordering; that is,
                'the slowest moving dimension first (which in this case
                'is the variable each-feature dimensions and so is reported
                'as zero).  Note that VB/VBA dimension ordering is the
                'reverse of this (e.g., see the ComputeValue method above).
            IMcUserMeasure_UserAttributes = Array(0, 4)

'        Case mcmaidResultType
'                'The default is mcmrtNumeric which is OK by us.

'        Case mcmaidResultValueType
'                The default is vbDouble, which is OK by us.

'        Case mcmaidResultMcObjectType
'               'The default is mcobjTypeREAL, which is OK by us.

        Case mcmaidIllustration
                'An optional 80 by 60 illustration for the measurement.
            Dim ProjectPath As String
            ProjectPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(VBE.VBProjects(ThisProject.Name).FileName)
            Dim myPict As New StdPicture
            Set myPict = LoadPicture(ProjectPath + "\BoundingRect.bmp")
            Set IMcUserMeasure_UserAttributes = myPict

'        Case mcmaidDefaultRangeMin
'        Case mcmaidDefaultRangeMin
'                'Attributes(mcmaidCanFilter) is False for this measurement (because it is not a
'                'one-value-per-feature measurement), so the RangeMin and RangeMax have no use
'                'and can just be left alone.

        Case mcmaidSpatialUnitExponent
            IMcUserMeasure_UserAttributes = 1&   'values are coordinates

'        Case mcmaidIntensityUnitExponent
'               'The default is zero, which is OK since this result has no luminance unit

'        Case mcmaidUnitsAbbrev
'        Case mcmaidUnitsName
'               'The default handles this properly based on mcmaidSpatialUnitExponent and mcmaidIntensityUnitExponent.

        Case mcmaidAbbreviation
            IMcUserMeasure_UserAttributes = "Brect" 'measurement abbreviated name

        Case Else

    End Select 'AttributeId
End Function

Private Function IMcUserMeasure_UserIsValueStale(ByVal MeasurementObject As McRegionLib.IMcMeasure) As Boolean
        'Nothing needs to be done here, as the automatically detected dependencies
        'are suffiecient (see the mcmaidDependencies Case, above).
End Function

Examples

Copy

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END






'***** CUserMeasureCoordinates.cls ******

'Note: this a more advanced and unusual example than that shown in
'CUserMeasureCircularityFull or CUserMeasureBoundingRect, so you should be familiar
'with those first.

'This example implements a measurement that results in a variable number of values
'per feature in the ancestor McFeatures object.  The measurement reports the
'coordinate points each feature as a length-N array of 2 Single (!) X and Y values.
'The results are in calibrated coordinates.  This measurement is unusual in that
'it returns measurements as Single rather than Double type (see the
'mcmaidResultValueType and mcmaidResultMcObjectType cases in the UserAttributes method).
'
'See McUserMeasure_Examples.bas for how to register this measurement.  The
'measurement will work with any ancestor McFeatures but it is registered
'under two names to work as an immediate child of a McLines or McRegions
'with names mvLnUserCoordinates, mvRgnUserCoordinates, respectively.
'

Option Explicit

Implements McRegionLib.IMcUserMeasure

Private Function IMcUserMeasure_ComputeValue(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        ByVal ParentOperator As Object) As Variant
    On Error GoTo IMcUserMeasure_ComputeValue_Error

        'Measurement works with any ancestor McFeatures
    Dim myFeat As McFeatures, lF As Long
    Set myFeat = AncestorOfOperator(MeasurementObject, "McFeatures")
    If myFeat.Count = 0 Then 'no features?
        IMcUserMeasure_ComputeValue = Empty
        Exit Function
    End If 'no features, so return an Empty result
    'ELSE we have at least one feature
    ReDim f1DVariantArray(myFeat.Count - 1) As Variant
    For lF = 0 To myFeat.Count - 1
            'Find number of coordinates for this feature
        Dim lNcoords As Long
        lNcoords = myFeat.GetFeaturePoints(lF)
        If lNcoords = 0 Then GoTo NextLoop 'if no coordinates, leave this feature's result Empty
            'Note: results are Single rather than the usual Double type
        ReDim farrayFeatCoords(1, lNcoords - 1) As Single
        lNcoords = myFeat.GetFeaturePoints(lF, farrayFeatCoords)
            'calibrate the results, if necessary
        If Not myFeat.SpatialCalibration Is Nothing Then
            myFeat.SpatialCalibration.CalibrateFloatPoints farrayFeatCoords
        End If
        f1DVariantArray(lF) = farrayFeatCoords
NextLoop:
    Next lF
    IMcUserMeasure_ComputeValue = f1DVariantArray

    On Error GoTo 0
    Exit Function
IMcUserMeasure_ComputeValue_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_ComputeValue of Class Module CUserMeasureCoordinates"
End Function

Private Function IMcUserMeasure_UserDisplayName(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The display name should be less than 32 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDisplayName = _
        Localized("Coordinates", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserDescription(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The description should be less than 128 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDescription = _
        Localized("Feature coordinates as an array of 2 values, X and Y.", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserAttributes(ByVal MeasurementObject As McRegionLib.IMcMeasure, ByVal AttributeId As McRegionLib.mcMeasurementAttributeID) As Variant

    Select Case AttributeId

        Case mcmaidDependencies
            'Here is where we do any required intialization, but none is needed for this measurement.
                'We do NOT return mcmdfOther, because the below cover all our dependencies
            IMcUserMeasure_UserAttributes = _
                mcmdfFeatureData Or mcmdfSpatialCalib

'        Case mcmaidDisconnectMeasure
'                'No cleanup needed for this measurement.

        Case mcmaidAllowedParent
            IMcUserMeasure_UserAttributes = _
                mcmpDescendentOfFeatures        'works with any ancestor McFeatures

        Case mcmaidCategories
            IMcUserMeasure_UserAttributes = _
                  mcmcfFeatureShape Or mcmcfIgnoresHoles Or mcmcfSize Or mcmcfPosition

'        Case mcmaidPerFeatureMeasurement
'                'True is the default, which works for us.

        Case mcmaidNofDimensions
                'Even though the result Value is a 1-D array of Variant, we report
                'our result as having 3 dimensions.  This is because each Variant
                'in the result Value array has 2 dimensions (N X,Y coordinate pairs).
            IMcUserMeasure_UserAttributes = 3

        Case mcmaidShape
                'Shape is reported using C/C++ dimension ordering; that is,
                'the slowest moving dimension first (which in this case
                'is the variable each-feature dimensions and so is reported
                'as zero).  Note that VB/VBA dimension ordering is the
                'reverse of this (e.g., see the ComputeValue method above).
                'In this case our measurement is a 1-D array of Variant, each
                'holding a 2-D array of values.  Below is how we report this
                'shape; the second 0 signals that the result is an array of Variant.
            IMcUserMeasure_UserAttributes = Array(0, 0, 2)

'        Case mcmaidResultType
'                'The default is mcmrtNumeric which is OK by us.

        Case mcmaidResultValueType
                'This measurement in unusual in that it returns Single rather than Double type
            IMcUserMeasure_UserAttributes = vbSingle

        Case mcmaidResultMcObjectType
                'This measurement in unusual in that it returns Single rather than Double type
            IMcUserMeasure_UserAttributes = mcobjTypeFLOAT

        Case mcmaidIllustration
                'An optional 80 by 60 illustration for the measurement.
            Dim ProjectPath As String
            ProjectPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(VBE.VBProjects(ThisProject.Name).FileName)
            Dim myPict As New StdPicture
            Set myPict = LoadPicture(ProjectPath + "\Coordinates.bmp")
            Set IMcUserMeasure_UserAttributes = myPict

'        Case mcmaidDefaultRangeMin
'        Case mcmaidDefaultRangeMin
'                'Attributes(mcmaidCanFilter) is False for this measurement (because it is not a
'                'one-value-per-feature measurement), so the RangeMin and RangeMax have no use
'                'and can just be left alone.

        Case mcmaidSpatialUnitExponent
            IMcUserMeasure_UserAttributes = 1&   'values are coordinates

'        Case mcmaidIntensityUnitExponent
'               'The default is zero, which is OK since this result has no luminance unit

'        Case mcmaidUnitsAbbrev
'        Case mcmaidUnitsName
'               'The default handles this properly based on mcmaidSpatialUnitExponent and mcmaidIntensityUnitExponent.

        Case mcmaidAbbreviation
            IMcUserMeasure_UserAttributes = "XY" 'measurement abbreviated name

        Case Else

    End Select 'AttributeId
End Function

Private Function IMcUserMeasure_UserIsValueStale(ByVal MeasurementObject As McRegionLib.IMcMeasure) As Boolean
        'Nothing needs to be done here, as the automatically detected dependencies
        'are suffiecient (see the mcmaidDependencies Case, above).
End Function

Examples

Copy

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END






'***** CUserMeasureConvexHull.cls ******

'Note: this a more advanced and unusual example than that shown in
'CUserMeasureCircularityFull, so you should be familiar with that
'one first.

'This example implements a measurement that returns a McRegions result.
'In this case, the result McRegions features are the convex hulls
'of the ancestor McRegions features.  The result McRegions is created
'as a child of the measured ancestor McRegions.
'
'See McUserMeasure_Examples.bas for how to register this measurement.  The
'measurement is registered as mrRgnUserConvexHull to work as an immediate
'child of a McRegions object.
'
'Note that this measurement is the same as the built-in mrRgnConvexHull measurement.
'

Option Explicit

Implements McRegionLib.IMcUserMeasure

Private Function IMcUserMeasure_ComputeValue(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        ByVal ParentOperator As Object) As Variant
   On Error GoTo IMcUserMeasure_ComputeValue_Error

        'Works with nearest ancestor McRegions, not just the immediate parent
    Dim myAncestorRegions As McRegions, lF As Long
    Set myAncestorRegions = AncestorOfOperator(MeasurementObject, "McRegions")
        'Create empty result McRegions as a child of myAncestorRegions
    Dim myResultRegions As McRegions
    Set myResultRegions = CreateOperator("McRegions", myAncestorRegions)
    For lF = 0 To myAncestorRegions.Count - 1
        Dim varConvexHull As Variant
        varConvexHull = Empty 'start empty
        myAncestorRegions.GetFeaturePointsEx lF, varConvexHull, mcotConvex
        myResultRegions.SetFeaturePoints lF, varConvexHull
    Next lF
    Set IMcUserMeasure_ComputeValue = myResultRegions

    On Error GoTo 0
    Exit Function
IMcUserMeasure_ComputeValue_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_ComputeValue of Class Module CUserMeasureConvexHull"
End Function

Private Function IMcUserMeasure_UserDisplayName(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The display name should be less than 32 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDisplayName = _
        Localized("Convex Hull as Regions", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserDescription(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The description should be less than 128 characters and it should be localized to
        'the current language.
    IMcUserMeasure_UserDescription = _
        Localized("Convex hulls of region boundaries, exposed as a McRegions object.", "MyLocModuleName")
End Function

Private Function IMcUserMeasure_UserAttributes(ByVal MeasurementObject As McRegionLib.IMcMeasure, ByVal AttributeId As McRegionLib.mcMeasurementAttributeID) As Variant

    Select Case AttributeId

        Case mcmaidDependencies
            'Here is where we do any required intialization, but none is needed for this measurement.
                'We do NOT return mcmdfOther, because the below cover all our dependencies
            IMcUserMeasure_UserAttributes = _
                mcmdfFeatureData ' Or mcmdfSpatialCalib 'no need for calibration dependency

'        Case mcmaidDisconnectMeasure
'                'No cleanup needed for this measurement.

        Case mcmaidAllowedParent
            IMcUserMeasure_UserAttributes = _
                mcmpDescendentOfFeatures   'works with any ancestor McRegions

        Case mcmaidCategories
            IMcUserMeasure_UserAttributes = _
                  mcmcfFeatureShape Or mcmcfIgnoresHoles Or mcmcfSize Or mcmcfPosition

'        Case mcmaidPerFeatureMeasurement
'                'True is the default, which works for us.

'        Case mcmaidNofDimensions
'                'This Attribute applies only to numeric measurements

'        Case mcmaidShape
'                'This Attribute applies only to numeric measurements

        Case mcmaidResultType
                'This is the key attribute that tells the caller that the result
                'will be a McRegions object instead of some mcmrtNumeric result.
            IMcUserMeasure_UserAttributes = mcmrtMcRegions

'        Case mcmaidResultValueType
'                'This Attribute applies only to numeric measurements

'        Case mcmaidResultMcObjectType
'                'This Attribute applies only to numeric measurements

        Case mcmaidIllustration
                'An optional 80 by 60 illustration for the measurement.
            Dim ProjectPath As String
            ProjectPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(VBE.VBProjects(ThisProject.Name).FileName)
            Dim myPict As New StdPicture
            Set myPict = LoadPicture(ProjectPath + "\ConvexHull.bmp")
            Set IMcUserMeasure_UserAttributes = myPict

'        Case mcmaidDefaultRangeMin
'        Case mcmaidDefaultRangeMin
'                'Attributes(mcmaidCanFilter) is False for this measurement (because it is not a
'                'numeric measurement), so the RangeMin and RangeMax have no use
'                'and can just be left alone.

'        Case mcmaidSpatialUnitExponent
'        Case mcmaidIntensityUnitExponent
'               'The default is zero, which is OK since this result is not a numeric measurement

'        Case mcmaidUnitsAbbrev
'        Case mcmaidUnitsName
'               'The default handles this properly based on mcmaidSpatialUnitExponent and mcmaidIntensityUnitExponent.

        Case mcmaidAbbreviation
            IMcUserMeasure_UserAttributes = "CvHull" 'measurement abbreviated name

        Case Else

    End Select 'AttributeId
End Function

Private Function IMcUserMeasure_UserIsValueStale(ByVal MeasurementObject As McRegionLib.IMcMeasure) As Boolean
        'Nothing needs to be done here, as the automatically detected dependencies
        'are suffiecient (see the mcmaidDependencies Case, above).
End Function

Examples

Copy

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END






'***** CUserMeasureSortedIndices.cls ******

'Note: this a more advanced and unusual example than that shown in
'CUserMeasureCircularityFull or any of the other example classes,
'so you should be familiar with all of the others first.

'This example illustrates several unusual measurement possiblitilits:
'
' 1.  The measurement results are based on an ancestor McFeatures, but
'the results are not one result associated with each feature the way that
'most measurements are.  Thus, for this measurement
'Attributes(mcmaidPerFeatureMeasurement) is False.
'
' 2.  The measurement uses per-McMeasure data to do its work.  Remember
'that only one McUserMeasure instance is registered under a given name,
'so this one instance has to service all McMeasure instances that are
'created on legal parent objects (and there may be many such).  For
'this measurement, per-McMeasure data is stored in the McMeasure.UserData
'property designed for this purpose.
'
' 3.  The standard, automatically serviced dependencies are not
'adequate for this measurement, so it implements the UserIsValueStale
'method to determine when the measurement value needs to be recomputed.
'
' 4.  The measurement results are returned as Long integral values rather than
'as floating point values.

'The measurment result is a 1-dimensional array of feature indices
'showing the sorted order of some per-feature measurement.
'The length of the array is equal to the McFeatures.Count of the ancestor
'McFeatures upon which the measurement is being made, but instead of
'each value corresponding to a feature, it is instead an index of
'the feature that holds that sort order for the measurement being sorted on.
'
'A per feature measurement showing the rank order of each feature might
'also be useful (that is where the measurement result associated with
'the zero'th feature is its rank among all features for the sorted
'measurement).  You might name such a class something like
'"CUserMeasureValueRank".  We leave it to you as an exercise; comments
'in the ComputeValue method show you one way to do the ranking.

'The class determines which measurement it is to sort by in one of two
'ways.  It can analyse the name of the connected McMeasure object and deduce the
'desired desired measurement to use for sorting.  Or it can use a McMeasure
'instance assigned to McMeasure.UserData as the sort measurement. See the
'UserAttributes mcmaidDependencies case for the automatic detection code.  If the
'measurement name starts with the substring "miPt...SortedBy", "miLn...SortedBy",
'"miRgn...SortedBy" or "miRef...SortedBy" then anything after that is appended to
'either "mPt", "mLn", "mRgn" or "mRef" respectively. For example the following
'measurement names: "miLnUserSortedByLength", "miRefUserSortedByDistance" or
'"miRgnUserSortedByArea" will automatically sort on mLnLength, mRefDistance or
'mRgnArea, respectively. By contrast, a measurement named "miFeatUserSortedByAny"
'would need to have a statement such as the following:
'   With ActiveImage.PointFeatures
'       Set .miFeatUserSortedByAny.UserData = .mPtDensity
'   End With
'in order for miFeatUserSortedByAny to sort on the mPtDensity measurement.
'
'The DisplayName, Description, certain Attributes and of course the
'computed value all depend on the sort-by measurement held in the
'McMeasure.UserData property.
'
'See McUserMeasure_Examples.bas for how to register this measurement.  The
'measurement will work with any ancestor McFeatures but it is registered
'under three names to work as an immediate child of a McLines or McRegions, or as
'a descendent of any McFeatures with names miLnUserSortedByLength, miRgnUserSortedByArea
'and miFeatUserSortedByAny, respectively.  Examples of using these measurements are
'shown in the TestExampleUserMeasurements sub.
'

Option Explicit

Implements McRegionLib.IMcUserMeasure

'Note: utility function's fGetOurSortedByMeasure and fAnalyseOurName are at the end of this module

Private Function IMcUserMeasure_ComputeValue(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        ByVal ParentOperator As Object) As Variant
   On Error GoTo IMcUserMeasure_ComputeValue_Error

    Dim OurSortedByMeasure As McRegionLib.McMeasure
    Set OurSortedByMeasure = fGetOurSortedByMeasure(MeasurementObject)

    Dim mcobjSortOrder As McObject
    Set mcobjSortOrder = McSort(OurSortedByMeasure.ValueMcObject)

    Set IMcUserMeasure_ComputeValue = mcobjSortOrder 'that's all folks!

'    '********
'    'To implement the "CUserMeasureValueRank" class suggested in the introductory comments,
'    'all we would need to do is the following, starting from the above:
'    '
'    Dim nFeatures As Long
'    nFeatures = mcobjSortOrder.VectorLength
'        'Make a ramp of feature indicies, 0 to nFeatures-1
'    Dim mcobjFeatureRanks As McObject
'    Set mcobjFeatureRanks = McOpCast(McOpFillIn(0&, nFeatures), "REAL")
'        'For the "CUserMeasureValueRank", we keep the mcmaidResultValueType the standard vbDouble
'        'and the mcmaidResultMcObjectType the standard mcobjTypeREAL.  McOpCast, above, casts
'        'the LONG type result from the McOpFillIn to mcobjTypeREAL.
'
'        'And the ranked result is just the ramp of feature indices selected in sorted order
'    IMcUserMeasure_ComputeValue = mcobjFeatureRanks.SelectedValues(mcobjSortOrder)
'        'Note that we do not use a Set assignment for the return value above.  This is
'        'because the SelectedValues property returns a numeric Variant, not a McObject instance.

    On Error GoTo 0
    Exit Function
IMcUserMeasure_ComputeValue_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_ComputeValue of Class Module CUserMeasureSortedIndices"
End Function

Private Function IMcUserMeasure_UserDisplayName(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The display name should be less than 32 characters and it should be localized to
        'the current language.
    On Error GoTo IMcUserMeasure_UserDisplayName_Error

    Dim OurSortedByMeasure As McRegionLib.McMeasure
    Set OurSortedByMeasure = fGetOurSortedByMeasure(MeasurementObject, False)
    If OurSortedByMeasure Is Nothing Then 'don't know what we will be sorting by?
        IMcUserMeasure_UserDisplayName = _
            Localized("Sorted Indices", "MyLocModuleName") 'then use generic name
    Else 'we have a sort-by measurement
        Dim strBase As String
        strBase = Localized("Sorted by ", "MyLocModuleName")
        IMcUserMeasure_UserDisplayName = _
            strBase + OurSortedByMeasure.DisplayName 'something like "Sorted by Pixel Area"
    End If 'we have a sort-by measurement

    On Error GoTo 0
    Exit Function
IMcUserMeasure_UserDisplayName_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_UserDisplayName of Class Module CUserMeasureSortedIndices"
End Function

Private Function IMcUserMeasure_UserDescription(ByVal MeasurementObject As McRegionLib.IMcMeasure) As String
        'The description should be less than 128 characters and it should be localized to
        'the current language.
    On Error GoTo IMcUserMeasure_UserDescription_Error

    Dim OurSortedByMeasure As McRegionLib.McMeasure
    Set OurSortedByMeasure = fGetOurSortedByMeasure(MeasurementObject, False)
    Dim strBase As String
    strBase = Localized("Feature indices sorted by ", "MyLocModuleName")
    If OurSortedByMeasure Is Nothing Then 'don't know what we will be sorting by?
        IMcUserMeasure_UserDescription = _
            strBase + Localized(" another measurement", "MyLocModuleName") 'then use generic description
    Else 'we have a sort-by measurement
        IMcUserMeasure_UserDescription = _
            strBase + OurSortedByMeasure.DisplayName 'something like "... sorted by Pixel Area"
    End If 'we have a sort-by measurement

    On Error GoTo 0
    Exit Function
IMcUserMeasure_UserDescription_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_UserDescription of Class Module CUserMeasureSortedIndices"
End Function

Private Function IMcUserMeasure_UserAttributes(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        ByVal AttributeId As McRegionLib.mcMeasurementAttributeID) As Variant
    On Error GoTo IMcUserMeasure_UserAttributes_Error

    Select Case AttributeId

        Case mcmaidDependencies
                'Here we intialize for the measurement to sort on, if we can get it from our name
            Dim strSortMeasure As String, OurParentType As mcMeasurementParent
            OurParentType = fAnalyseOurName(MeasurementObject, strSortMeasure)
            If Len(strSortMeasure) <> 0 Then 'got our sort measurement from our name?
                Dim siblingMeasures As McMeasures, sortMeasure As McMeasure
                Set siblingMeasures = ParentOfOperator(MeasurementObject).Measures
                Set sortMeasure = siblingMeasures(strSortMeasure) 'look it up by name
                If Not sortMeasure Is Nothing Then
                    MeasurementObject.UserData = sortMeasure 'set our UserData to our measurement
                        'And we know that our dependencies are the same as our sort measurement's
                    IMcUserMeasure_UserAttributes = _
                        sortMeasure.Attributes(mcmaidDependencies)
                    Exit Function
                End If 'sortMeasure Is Not Nothing
                'ELSE sortMeasure Is Nothing
                    'Tell the caller that we could not get their measurement
                MsgBox MeasurementObject.Attributes(mcmaidName) + _
                    " resolved to a sort-by measurement name (" + strSortMeasure + _
                    ") but no measurement by that name could be found."
            End If 'we could get our sort measurement from our name
            'Else just leave MeasurementObject.UserData Empty
                'We don't know our sort-by measurement as yet, so we return
                'mcmdfOther, because we will need to determine our stale state in UserIsValueStale
            IMcUserMeasure_UserAttributes = mcmdfOther

        Case mcmaidDisconnectMeasure
                'For cleanup, we just empty our UserData, thereby freeing our sort-by McMeasure object
            MeasurementObject.UserData = Empty

        Case mcmaidCanBeEnabled
                'We can only be enabled if we have a sort-by measurement
            IMcUserMeasure_UserAttributes = _
                Not fGetOurSortedByMeasure(MeasurementObject, False) Is Nothing

        Case mcmaidAllowedParent
                'Just return the default of mcmpDescendentOfFeatures
            IMcUserMeasure_UserAttributes = mcmpDescendentOfFeatures

        Case mcmaidCategories
            IMcUserMeasure_UserAttributes = _
                  mcmcfFeatureShape Or mcmcfIgnoresHoles Or mcmcfSize Or mcmcfPosition

        Case mcmaidPerFeatureMeasurement
                'Since the measurement value at index N is not associated with feature index N,
                'this measurement is NOT a per-feature measurement.  Were you to
                'implement the "CUserMeasureValueRank" class suggested in the introductory
                'remarks, then this would be a per-feature measurement, so you would return True.
            IMcUserMeasure_UserAttributes = False

        Case mcmaidNofDimensions
            IMcUserMeasure_UserAttributes = 1 'results are a 1-D array of feature indices

        Case mcmaidShape
                'The result is a 1-dimensional array where the number of values in the array
                'depends on the number of values in the sort-by measurement Value
            IMcUserMeasure_UserAttributes = 0

'        Case mcmaidResultType
'                'The default is mcmrtNumeric which is OK by us.

        Case mcmaidResultValueType
                'We compute our Value as an array of Long rather than the usual Double type
            IMcUserMeasure_UserAttributes = vbLong

        Case mcmaidResultMcObjectType
                'We compute our ValueMcObject as mcobjTypeINTEGER rather than the usual mcobjTypeREAL type
            IMcUserMeasure_UserAttributes = mcobjTypeINTEGER

        Case mcmaidIllustration
                'An optional 80 by 60 illustration for the measurement.
            Dim ProjectPath As String
            ProjectPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(VBE.VBProjects(ThisProject.Name).FileName)
            Dim myPict As New StdPicture
            Set myPict = LoadPicture(ProjectPath + "\SortedIndices.bmp")
            Set IMcUserMeasure_UserAttributes = myPict

'        Case mcmaidDefaultRangeMin
'        Case mcmaidDefaultRangeMin
'                'Attributes(mcmaidCanFilter) is False for this measurement (because it is not a
'                'one-value-per-feature measurement), so the RangeMin and RangeMax have no use
'                'and can just be left alone.

'        Case mcmaidSpatialUnitExponent
'        Case mcmaidIntensityUnitExponent
'               'The default is zero, which is OK since this result is not a numeric measurement

'        Case mcmaidUnitsAbbrev
'        Case mcmaidUnitsName
'               'The default handles this properly based on mcmaidSpatialUnitExponent and mcmaidIntensityUnitExponent.

        Case mcmaidAbbreviation
            Dim OurSortedByMeasure As McRegionLib.McMeasure
            Set OurSortedByMeasure = fGetOurSortedByMeasure(MeasurementObject, False)
            If OurSortedByMeasure Is Nothing Then 'don't know what we will be sorting by?
                IMcUserMeasure_UserAttributes = Localized("SrtdI", "MyLocModuleName") 'then use generic name
            Else 'we have a sort-by measurement
                Dim strBase As String
                strBase = Localized("Srtd", "MyLocModuleName")
                IMcUserMeasure_UserAttributes = strBase + _
                     OurSortedByMeasure.Attributes(mcmaidAbbreviation)  'something like "SrtdA"
            End If 'we have a sort-by measurement

        Case Else

    End Select 'AttributeId

    On Error GoTo 0
    Exit Function
IMcUserMeasure_UserAttributes_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_UserAttributes of Class Module CUserMeasureSortedIndices"
End Function

Private Function IMcUserMeasure_UserIsValueStale(ByVal MeasurementObject As McRegionLib.IMcMeasure) As Boolean
    On Error GoTo IMcUserMeasure_UserIsValueStale_Error

        'We may or may not get called here, depending on what we had to do in the mcmaidDependencies
        'case of the UserAttributes method above.  However, if we are called, then we need to figure
        'out if our measurement value is older than the current measurement value of our
        'sort-by measurement, or if our sort-by measurement is currently stale.  The single
        'statement below does this whole job by comparing the ValueSequence of our connected
        'MeasurementObject with the ValueSequence of the sort-by measurement upon which we depend.
        'Note that the ValueSequence of the sort-by measurement will be zero if that measurement
        'is stale.

    IMcUserMeasure_UserIsValueStale = _
        (fGetOurSortedByMeasure(MeasurementObject).ValueSequence(MeasurementObject.ValueSequence) = 0)

    On Error GoTo 0
    Exit Function
IMcUserMeasure_UserIsValueStale_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure IMcUserMeasure_UserIsValueStale of Class Module CUserMeasureSortedIndices"
End Function


'**** Utility Sub's ******

Private Function fGetOurSortedByMeasure(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        Optional ByVal bShowErrorMsg = True) As McRegionLib.McMeasure
    Dim SortedByMeasure As McRegionLib.McMeasure
    If Not MeasurementObject Is Nothing Then
        On Error Resume Next
        Set SortedByMeasure = MeasurementObject.UserData 'will throw Error if not set
        On Error GoTo fGetOurSortedByMeasure_Error
        If SortedByMeasure Is Nothing And bShowErrorMsg Then
            MsgBox MeasurementObject.Attributes(mcmaidName) + _
                " does not have a McMeasure object set as its UserData property."
        End If 'cannot get a McMeasure from the UserData
    End If 'we have a MeasurementObject
    'else just return Nothing without complaining
    Set fGetOurSortedByMeasure = SortedByMeasure

    On Error GoTo 0
    Exit Function
fGetOurSortedByMeasure_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure fGetOurSortedByMeasure of Class Module CUserMeasureSortedIndices"
End Function 'fGetOurSortedByMeasure

Private Function fAnalyseOurName(ByVal MeasurementObject As McRegionLib.IMcMeasure, _
        ByRef strSortMeasure As String) As mcMeasurementParent
    On Error GoTo fAnalyseOurName_Error
        'get our connected McMeasure's name
    Dim strOurName As String, strTrailer As String

    If MeasurementObject Is Nothing Then
        strSortMeasure = "" 'don't know the sort measurement name
        fAnalyseOurName = mcmpDescendentOfFeatures 'assume it will work with any McFeatures ancestor
        Exit Function 'and quit
    End If 'no MeasurementObject
    'ELSE we do have a MeasurementObject

    strOurName = MeasurementObject.Attributes(mcmaidName)
        'Figure if it has one of our special leaders
    Dim nNameStart As Long, nNameLen As Long, nSBLen As Long
    nSBLen = Len(strOurName) - Len("SortedBy")
    If InStr(1, strOurName, "miPt", vbTextCompare) = 1 Then 'Points?
        nNameStart = InStr(1, strOurName, "SortedBy", vbTextCompare)
        If nNameStart > 0 Then
            nNameLen = nSBLen - nNameStart + 1
            strTrailer = Right(strOurName, nNameLen)
            strSortMeasure = "mPt" + strTrailer
        Else
            strSortMeasure = "" 'don't know the sort measurement name
        End If 'have a name
        fAnalyseOurName = mcmpChildOfPoints
        Exit Function
    End If 'a point measurement

    If InStr(1, strOurName, "miLn", vbTextCompare) = 1 Then 'Lines?
        nNameStart = InStr(1, strOurName, "SortedBy", vbTextCompare)
        If nNameStart > 0 Then
            nNameLen = nSBLen - nNameStart + 1
            strTrailer = Right(strOurName, nNameLen)
            strSortMeasure = "mLn" + strTrailer
        Else
            strSortMeasure = "" 'don't know the sort measurement name
        End If 'have a name
        fAnalyseOurName = mcmpChildOfLines
        Exit Function
    End If 'a line measurement

    If InStr(1, strOurName, "miRgn", vbTextCompare) = 1 Then 'Regions?
        nNameStart = InStr(1, strOurName, "SortedBy", vbTextCompare)
        If nNameStart > 0 Then
            nNameLen = nSBLen - nNameStart + 1
            strTrailer = Right(strOurName, nNameLen)
            strSortMeasure = "mRgn" + strTrailer
        Else
            strSortMeasure = "" 'don't know the sort measurement name
        End If 'have a name
        fAnalyseOurName = mcmpChildOfRegions
        Exit Function
    End If 'a region measurement

    If InStr(1, strOurName, "miRef", vbTextCompare) = 1 Then 'Reference features?
        nNameStart = InStr(1, strOurName, "SortedBy", vbTextCompare)
        If nNameStart > 0 Then
            nNameLen = nSBLen - nNameStart
            strTrailer = Right(strOurName, nNameLen)
            strSortMeasure = "mRef" + strTrailer
        Else
            strSortMeasure = "" 'don't know the sort measurement name
        End If 'have a name
        fAnalyseOurName = mcmpChildOfRefFeatures
        Exit Function
    End If 'a reference features measurement

    'ELSE some other kind of measurement name
    strSortMeasure = "" 'don't know the sort measurement name
    fAnalyseOurName = mcmpDescendentOfFeatures 'so it will work with any McFeatures ancestor

    On Error GoTo 0
    Exit Function
fAnalyseOurName_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure fAnalyseOurName of Class Module CUserMeasureSortedIndices"
End Function 'fAnalyseOurName

Reference

MediaCy.IQL.Features Namespace

MediaCy.IQL.FeaturesIMcUserMeasureEvents

RegisterUserMeasurement