IMcOMGlobalMcInterpolateValues Method

Function McInterpolateValues ( 
	ArrayToInterpolate As Object,
	NewDim0Size As Integer,
	Optional bInterpolateCounts As Boolean = false
) As McObject

'This is InterplolateValuesSamples.bas
'
'These samples illustrate use of the McOMGlobal.McInterplateValues method.

Option Explicit

Sub InterplolateArrayValues()
    Output.Show "Output"
    Output.Clear
        'Interpolate to longer array's
    Output.PrintMessage "Length 2 1-D array 1,5 to length 5: " & _
        McToText(McInterpolateValues(Array(1, 5), 5))

    Output.PrintMessage "Length 2 2-D array 1,1 and 5,9 to length 5: " & vbCrLf & _
        McToText(McInterpolateValues(Array(Array(1, 1), Array(5, 9)), 5))

        'Interpolate to shorter array
    Dim mcobjRamp As McObject
    Set mcobjRamp = McOpFillIn(0, 9) 'array of values from 0 through 8
    Output.PrintMessage "Length 9 1-D array " & McToText(mcobjRamp) & " to length 3 array: " & _
        McToText(McInterpolateValues(mcobjRamp, 3))

End Sub 'InterplolateArrayValues

Sub InterplolateArrayCounts()
    Output.Show "Output"
    Output.Clear
        'Interpolate counts to longer array's
    Output.PrintMessage "Length 2 1-D array counts 1,5 to length 5: " & _
        McToText(McInterpolateValues(Array(1, 5), 5, True))

    Output.PrintMessage "Length 2 2-D array counts 1,1 and 5,9 to length 5: " & vbCrLf & _
        McToText(McInterpolateValues(Array(Array(1, 1), Array(5, 9)), 5, True))

        'Interpolate counts to shorter array
    Dim mcobjRamp As McObject
    Set mcobjRamp = McOpFillIn(0, 9) 'array of counts from 0 through 8
    Output.PrintMessage "Length 9 1-D counts array " & McToText(mcobjRamp) & " to length 3 array: " & _
        McToText(McInterpolateValues(mcobjRamp, 3, True))

End Sub 'InterplolateArrayCounts

Sub InterplolatePoints()
        'Create a new image
    Images.Add "InterpolateTest", 250, 200, 1, mciqtGray
        'interpolate between two given points
    Dim twoPoints(0 To 1) As SINGLEPOINT
    twoPoints(0).x = 10
    twoPoints(0).y = 15
    twoPoints(1).x = 220
    twoPoints(1).y = 180

    Dim InterPts As Variant
    Set InterPts = McInterpolateValues(twoPoints, 15)

    ActiveImage.PointFeatures.SetFeaturePoints -1, InterPts

    MsgBox "Look at the interpolated points." & vbCrLf & _
        "The image will close when you press OK."
    ActiveWindow.Close
End Sub 'InterplolateArrayValues

Sub StretchHistogram()
        'Open a color image
    Images.Open Path + "Images\" + "NucStain.tif"
    If ActiveImage Is Nothing Then Exit Sub

    With ActiveImage.Histogram
        .BinCount = .MaxBinCount '256 bins
        .Interpretation = mciAnyInterp 'native, RGB interpretation
        If .NumberOfChannels <> 3 Then
            MsgBox "We need a color image for this one."
            Exit Sub
        End If
        Dim mcobjHist As McObject
        Set mcobjHist = McObjectTemp(.Values)  'get all values
    End With 'ActiveImage.Histogram
    If mcobjHist.Shape(mcobjSIC_SizeDim1) <> 256 Then
        MsgBox "The example wants a 24-bit RGB image."
        Exit Sub
    End If

    'Now get some statistics on the three unstretched histograms
    Dim varBasicStats As Variant 'will be length 3 1-D array of BASIC_STATISTICS
    varBasicStats = McHistogramStatistics(mcobjHist)
    Output.Show "Output"
    Output.Clear
    Dim strResults As String
    strResults = "Un Stretched Color Histograms:"
    Dim lC As Long, lMinIndex As Long, lMaxIndex As Long
    lMinIndex = 255
    lMaxIndex = 0
    For lC = 0 To 2
        Dim bs As BASIC_STATISTICS
        bs = varBasicStats(lC) 'get the stats for this profile and color
        strResults = strResults & McSprintf(McCStr("\n   Color: %d. N= %f" & _
            " Min: %f at index %f, Max: %f at index %f, Range: %f, Mean: %f, StdDev: %f"), _
                lC, bs.Count, bs.Minimum, bs.IndexOfMinimum, _
                bs.Maximum, bs.IndexOfMaximum, bs.Range, bs.Mean, bs.StdDev)
        If bs.IndexOfMinimum < lMinIndex Then lMinIndex = bs.IndexOfMinimum
        If bs.IndexOfMaximum > lMaxIndex Then lMaxIndex = bs.IndexOfMaximum
    Next lC

        'The histogram values are declared effectively as follows:
        ' Dim histValues(0 to 256, 0 to 2) As Double 'or in C/C++
        'double histValues[3],[256]; 'note that dimension ordering is reversed
        'We want to select values from the first non-zero index through
        'the last non-zero index for any color channel and stretch these out
        'to 256 values.
    Dim mcobjSelHist As McObject
        'Note that McObject selection uses C/C++ dimension ordering
    Set mcobjSelHist = mcobjHist.SelectedMcObject(, McOpFillIn(lMinIndex, lMaxIndex + 1))
        'Note: above McOpFillIn goes up to, but does not include the right hand value.

        'Now interpolate each of the three color channel histograms
        'to length 256.  To do this we need to make the bin dimension
        '(currently the fastest dimension) the slowest.  So transpose them:
    Set mcobjSelHist = McTranspose(mcobjSelHist) 'into array of RGB counts
        'Now do the interpolation of the histogram as counts
    Dim mcobjStretchedHist As McObject
    Set mcobjStretchedHist = McInterpolateValues(mcobjSelHist, 256, True) 'Interpolate Counts
        'And transpose it back into 3 arrays of 256 bin counts (areas) each
    Set mcobjStretchedHist = McTranspose(mcobjStretchedHist)

    'Now get some statistics on the three stretched histograms
    varBasicStats = McHistogramStatistics(mcobjStretchedHist)
    strResults = strResults & vbCrLf & vbCrLf & "Stretched Color Histograms:"
    For lC = 0 To 2
        bs = varBasicStats(lC) 'get the stats for this profile and color
        strResults = strResults & McSprintf(McCStr("\n   Color: %d. N= %f" & _
            " Min: %f at index %f, Max: %f at index %f, Range: %f, Mean: %f, StdDev: %f"), _
                lC, bs.Count, bs.Minimum, bs.IndexOfMinimum, _
                bs.Maximum, bs.IndexOfMaximum, bs.Range, bs.Mean, bs.StdDev)
    Next lC
    Output.PrintMessage strResults

    ActiveWindow.Close
End Sub 'SubSampleHistogram