McColorComposite Interface

Public Interface McColorComposite
	Inherits IMcColorComposite

'This is McColorCompositeExamples.bas
Option Explicit


'**** Utility used by the below ****
Private Function lfProblemCodesAsString(ProblemCodes As mcCompositeInfoFlags) As String
    Dim strT As String
    strT = "Problem codes:"
    If ProblemCodes = mccpfNoFlags Then
        strT = strT + " No Flags"
    End If
    If ProblemCodes And mccpfMixedBitsPerChannel Then
        strT = strT + "MixedBitsPerChannel"
    End If
    If ProblemCodes And mccpfMixedPixelTypes Then
        strT = strT + " MixedPixelTypes"
    End If
    If ProblemCodes And mccpfMixedFrameCounts Then
        strT = strT + " MixedFrameCounts"
    End If
    If ProblemCodes And mccpfMixedSourceSizes Then
        strT = strT + " MixedSourceSizes"
    End If
    If ProblemCodes And mccpfEmptyIntersection Then
        strT = strT + " EmptyIntersection"
    End If
    If ProblemCodes And mccpfEmptyOffset Then
        strT = strT + " EmptyOffset"
    End If
    lfProblemCodesAsString = strT
End Function 'lfProblemCodesAsString

'The MakeColorCompositeFromImagesCollection sub composites all monochrome images
'in the Images collection, passing each one through an individual LUT.
'It also generates a report on the operation and places it in the output window.
Public Function MakeColorCompositeFromImagesCollection( _
    Optional bFakeSourceOffsets As Boolean = False, _
    Optional bFakeMagnifications As Boolean = False, _
    Optional bFakeDestOffset As Boolean = False, _
    Optional bFakeLutChange As Boolean = False _
    ) As McImage
    Dim nSources As Long
    nSources = Images.Count
    If nSources = 0 Then
        MsgBox "There are no images in the Images collection"
        Exit Function
    End If
    ReDim varSourceImages(0 To nSources - 1) As Variant
    ReDim larraySourceColors(0 To nSources - 1) As Long
    Dim nImage As Long, lColorIndex As Long
    ReDim larraySourceStartingFrames(0 To nSources - 1) As Long
    ReDim ptSourceOffsetsXY(0 To nSources - 1) As LONGPOINT
    Dim ptOffXY As LONGPOINT, iSign As Long
    iSign = 1
    ReDim dptMagnificationsXY(0 To nSources - 1) As DOUBLEPOINT

    Dim varColors As Variant 'Red, Green, Blue, Yellow, Cyan, Magenta
    varColors = Array(&HFF&, &HFF00&, &HFF0000, &HFFFF&, &HFFFF00, &HFF00FF)

    nSources = 0
    lColorIndex = 0 'Red
    For nImage = 0 To Images.Count - 1
        Dim imgNext As McImage
        Set imgNext = Images(nImage)
            'skip any color images (only monochrome sources are allowed)
        If imgNext.Type.Interpretation <> mciMonochrome Then GoTo NextImage
        Set varSourceImages(nSources) = imgNext

            'Set an optional fake source offset
        ptOffXY.x = nImage * iSign
        iSign = iSign * -1
        ptOffXY.y = nImage * iSign
        If bFakeSourceOffsets Then
            ptSourceOffsetsXY(nSources) = ptOffXY
        End If 'bFakeOffsets
        'else leave the offsets as 0,0

        If bFakeMagnifications Then
                'Magnify X and Y differently only
            dptMagnificationsXY(nSources).x = CDbl(nSources) * iSign * 0.1 + 1#
            dptMagnificationsXY(nSources).y = CDbl(nSources) * -iSign * 0.1 + 1#
        Else 'set magnification to 1,1
            dptMagnificationsXY(nSources).x = 1#
            dptMagnificationsXY(nSources).y = 1#
        End If 'no magnifications

            'Put in a starting frame for multiframe images
        If imgNext.FrameCount > 2 Then larraySourceStartingFrames(nSources) = imgNext.FrameCount / 2

            ' Set colors R, G, B, Magenta, Yellow, Cyan
        larraySourceColors(nSources) = varColors(lColorIndex)
        lColorIndex = lColorIndex + 1
        If lColorIndex > 5 Then lColorIndex = 0 'Recycle after 6 colors
        nSources = nSources + 1
NextImage:
    Next nImage

    If nSources = 0 Then
        MsgBox "There are no monochrome images in the Images collection"
        Exit Function
    End If

        'Resize source arrays to avoid any color images
    ReDim Preserve varSourceImages(0 To nSources - 1)
    ReDim Preserve larraySourceColors(0 To nSources - 1)
    ReDim Preserve larraySourceStartingFrames(0 To nSources - 1)
    ReDim Preserve ptSourceOffsetsXY(0 To nSources - 1)
    ReDim Preserve dptMagnificationsXY(0 To nSources - 1)

        'Set an optional fake destination offset
    Dim ptDestOffsetXY As LONGPOINT
    If bFakeDestOffset Then
        ptDestOffsetXY.x = -1
        ptDestOffsetXY.y = 1
    End If
    'else leave the destination offset as 0,0

        'Create an instance of the McColorComposite operator with no parent McImage
    Dim ColorComposite As McColorComposite
    Set ColorComposite = CreateOperator("McColorComposite") 'no parent

        'Create a McLookupTables instance for each source
    Dim objMcLookupTables() As Object
    objMcLookupTables = ColorComposite.GetMcLookupTablesForSources(varSourceImages)

        'Do something to each of the LUT's
    For nImage = 0 To nSources - 1
            'get the next source's McLookupTables instance
        Dim mclookuptablesNext As McLookupTables
        Set mclookuptablesNext = objMcLookupTables(nImage)
            'get the luminance LUT from the source's McLookupTables instance
        Dim mclookuptableNext As McLookupTable
        Set mclookuptableNext = mclookuptablesNext.Item(0)
        If bFakeLutChange Then
            'make some fake changes to the LUT
            mclookuptableNext.BlackLevel = CDbl(nImage) * 0.2 * 255#
        End If 'bFakeLutChange
    Next nImage

        'Now get the scaling LUT's
    Dim varSourceLookupTables As Variant
    varSourceLookupTables = ColorComposite.GetLutsFromMcLookupTables(objMcLookupTables)

        'Report the source LUT's
    Output.Show ("Output")
    Output.Clear
    Output.PrintMessage "Source LUT's every 32nd" + vbCrLf + _
        McToText(McOpSelect(varSourceLookupTables, , McOpMul(McOpFillIn(0, 8), 32)), "%0.2f")

    Dim ControlFlags As mcCompositeControlFlags
    ControlFlags = mcccfUseAoiAsSource + mcccfCacheResults + mcccfInterpolateIfMagnified + mcccfUseAoiAsDest

    Dim varBitsPerColorChannels As Variant
    Dim lMaxBitsPerColorChannel As Long
    Dim varIsFloatPixelDataTypes As Variant
    Dim bSomePixelDataTypeIsFloat As Boolean
    Dim varFrameCounts As Variant
    Dim lMinAdjustedFrameCount As Long
    Dim varSourceSizes As Variant
    Dim varMinAndMaxSourceSizes As Variant
    Dim varOffsetSourceRectangles As Variant
    Dim ProblemCodes As mcCompositeInfoFlags

    ProblemCodes = ColorComposite.GetSourcesInfo( _
        varSourceImages, _
        ControlFlags, _
        larraySourceStartingFrames, _
        ptSourceOffsetsXY, _
        dptMagnificationsXY, _
        ptDestOffsetXY, _
        varBitsPerColorChannels, _
        lMaxBitsPerColorChannel, _
        varIsFloatPixelDataTypes, _
        bSomePixelDataTypeIsFloat, _
        varFrameCounts, _
        lMinAdjustedFrameCount, _
        varSourceSizes, _
        varMinAndMaxSourceSizes, _
        varOffsetSourceRectangles)

        'Report the info on the sources
    Output.PrintMessage "Color Composite Info on" + Str(nSources) + " sources from the Images collection."
    Output.PrintMessage lfProblemCodesAsString(ProblemCodes)
    Output.PrintMessage "Bits per color channel: " + McToText(varBitsPerColorChannels)
    Output.PrintMessage "Max Bits per color channel: " + McToText(lMaxBitsPerColorChannel)
    Output.PrintMessage "Is Float Pixel Type :" + McToText(varIsFloatPixelDataTypes)
    Output.PrintMessage "Some pixel data type is float:" + Str(bSomePixelDataTypeIsFloat)
    Output.PrintMessage "Frame Counts: " + McToText(varFrameCounts)
    Output.PrintMessage "Min Adjusted Frame Count:" + Str(lMinAdjustedFrameCount)
    Output.PrintMessage "Source Sizes: " + vbCrLf + McToText(varSourceSizes)
    Output.PrintMessage "Min Source Size: " + McToText(varMinAndMaxSourceSizes(0)) + _
        " Max Source Size: " + McToText(varMinAndMaxSourceSizes(1))
    Output.PrintMessage "Source Offsets supplied: " + vbCrLf + McToText(ptSourceOffsetsXY)
    Output.PrintMessage "Minus Dest Offset of: " + McToText(ptDestOffsetXY)
    Output.PrintMessage "Offset Source Rectangles: " + vbCrLf + McToText(varOffsetSourceRectangles)


    Dim mcimageComposite As McImage
    Set mcimageComposite = ColorComposite.DoComposite( _
        varSourceImages, _
        larraySourceColors, _
        ControlFlags, _
        larraySourceStartingFrames, _
        varSourceLookupTables, _
        ptSourceOffsetsXY, _
        dptMagnificationsXY, _
        -1, _
        larraySourceStartingFrames, _
        0, _
        ptDestOffsetXY, _
        Empty, _
        Empty)

    Set MakeColorCompositeFromImagesCollection = mcimageComposite
    mcimageComposite.Visible = True
    mcimageComposite.Modified = False
End Function 'MakeColorCompositeFromImagesCollection

Public Sub MakeColorCompositeSample()
    Windows.CloseAll
    Images.Open Path + "\Images\DemoRed.tif"
    Images.Open Path + "\Images\DemoGrn.tif"
    Images.Open Path + "\Images\DemoBlue.tif"
    Dim imgComposite As McImage
    Set imgComposite = MakeColorCompositeFromImagesCollection
End Sub 'MakeColorCompositeSample

'***** Routines to test McColorComposite on well-defined images

Function lfCreateTwoWayGray() As McImage
    Dim mcobjRow As McObject
    Set mcobjRow = McOpFillIn(0, 128)
    Dim mcobj2D As McObject
    Set mcobj2D = McArrayTemp("SHORT", Array(128, 128))
    mcobj2D.OpSelfAssign mcobjRow 'assign all rows 0-127
    Dim mcobj2Dtranspose As McObject
    Set mcobj2Dtranspose = McTranspose(mcobj2D)
    mcobj2D.OpSelfAdd mcobj2Dtranspose
        'Now put the 2D array into an 8-bit grayscale image
    Dim mcimageT As McImage
    Set mcimageT = Images.Add("TwoWayGray", 128, 128)
    Dim var2D As Variant
    var2D = mcobj2D.Value
    mcimageT.PutArea var2D
    mcimageT.Modified = False
    Set lfCreateTwoWayGray = mcimageT
End Function 'lfCreateTwoWayGray

Public Function TestTwoWayGrayColorComposite( _
    Optional ByVal bTestSourceOffsets As Boolean = False, _
    Optional ByVal bTestMagnifications As Boolean = False, _
    Optional ByVal bTestDestAoi As Boolean = False, _
    Optional ByVal bTestDestOffset As Boolean = False, _
    Optional ByVal bTestDestRect As Boolean = False, _
    Optional ByVal bTestLutChange As Boolean = False, _
    Optional ByVal bTestCaching As Boolean = False, _
    Optional ByVal lBackgroundIndex As Long = -1)
'
    Windows.CloseAll

        'For testing caching, we turn off the AOI and the
    If bTestCaching Then
        bTestDestAoi = False
        bTestDestRect = True
    End If 'bTestCaching

    Dim nSources As Long
    nSources = 3
    ReDim varSourceImages(0 To nSources - 1) As Variant

    Dim mcimageTWG As McImage
    Set mcimageTWG = lfCreateTwoWayGray
    mcimageTWG.Name = "TWG_Red"
    Set varSourceImages(0) = mcimageTWG
    Set varSourceImages(1) = mcimageTWG.CopyToNewImage(, "TWG_Grn")
    Set varSourceImages(2) = mcimageTWG.CopyToNewImage(, "TWG_Blu")

    Dim varColors As Variant 'Red, Green, Blue, Yellow, Cyan, Magenta
    varColors = Array(&HFF&, &HFF00&, &HFF0000, &HFFFF&, &HFFFF00, &HFF00FF)

    Dim varMagnifications As Variant '1, 0.75, 1.5
    varMagnifications = Array(1#, 0.75, 1.5)

    Dim varOffsetsX As Variant
    varOffsetsX = Array(0&, 4&, -6&)

    Dim varOffsetsY As Variant
    varOffsetsY = Array(0&, 8&, -4&)

    Dim varSourceAoiSizes As Variant
    varSourceAoiSizes = Array(16, 12, 20)

    ReDim larraySourceColors(0 To nSources - 1) As Long
    ReDim larraySourceStartingFrames(0 To nSources - 1) As Long
    ReDim ptSourceOffsetsXY(0 To nSources - 1) As LONGPOINT
    Dim ptOffXY As LONGPOINT, iSign As Long
    iSign = 1
    ReDim dptMagnificationsXY(0 To nSources - 1) As DOUBLEPOINT

    Dim nImage As Long
    For nImage = 0 To nSources - 1
        Dim imgNext As McImage
        Set imgNext = varSourceImages(nImage)

            'We need to do the magnifications first
        If bTestMagnifications Then
            dptMagnificationsXY(nImage).x = varMagnifications(nImage)
            dptMagnificationsXY(nImage).y = varMagnifications(nImage)
        Else 'set magnification to 1,1
            dptMagnificationsXY(nImage).x = 1#
            dptMagnificationsXY(nImage).y = 1#
        End If 'no magnifications

            'Now descale the Base image if necessary
        If dptMagnificationsXY(nImage).x <> 1# Then
            Dim lNewSize As Long
            lNewSize = CLng((imgNext.Width / dptMagnificationsXY(nImage).x) + 0.5)  'Round size
            Dim imgResized As McImage
            Set imgResized = imgNext.Geometry.Resize(lNewSize, lNewSize, mcsmBilinear)
            imgResized.Modified = False
                'Replace the base image
            Set varSourceImages(nImage) = imgResized
            imgNext.Close
            Set imgNext = imgResized
            Set imgResized = Nothing
        End If 'We need a resized source image

            'Set an optional fake source offset
        ptOffXY.x = varOffsetsX(nImage)
        ptOffXY.y = varOffsetsY(nImage)
        If bTestSourceOffsets Then
            ptSourceOffsetsXY(nImage) = ptOffXY
        End If 'bTestOffsets
        'else leave the offsets as 0,0

            'Set an offset Aoi, descaled by the combine magnification
        Const c_lAoiOrigin = 16&
        Dim lrectAoi As LONGRECT 'left,top right,bottom
        lrectAoi.Left = CLng((c_lAoiOrigin + ptSourceOffsetsXY(nImage).x) / dptMagnificationsXY(nImage).x + 0.5)
        lrectAoi.Right = lrectAoi.Left + _
            CLng(varSourceAoiSizes(nImage) / dptMagnificationsXY(nImage).x + 0.5) - 1
        lrectAoi.Top = CLng((c_lAoiOrigin + ptSourceOffsetsXY(nImage).y) / dptMagnificationsXY(nImage).y + 0.5)
        lrectAoi.Bottom = lrectAoi.Top + _
            CLng(varSourceAoiSizes(nImage) / dptMagnificationsXY(nImage).y + 0.5) - 1
        imgNext.Aoi.SetBox -1, lrectAoi.Left, lrectAoi.Top, lrectAoi.Right, lrectAoi.Bottom

            'Put in a starting frame for multiframe images
        If imgNext.FrameCount > 2 Then larraySourceStartingFrames(nImage) = imgNext.FrameCount / 2

            ' Set colors R, G, B, Magenta, Yellow, Cyan
        larraySourceColors(nImage) = varColors(nImage)
        imgNext.Modified = False
NextImage:
    Next nImage

        'Set up the destination image
    Dim imgComposite As McImage
    Set imgComposite = Images.Add("TWG_Composite", 64, 64, 1, mciqtRGB, mcicfDefault)

    If bTestDestAoi Then
        imgComposite.Aoi.SetEllipse -1, 24, 24, 24, 20
    End If 'set a dest AOI

        'Set an optional fake destination offset
    Dim ptDestOffsetXY As LONGPOINT
    If bTestDestOffset Then
        ptDestOffsetXY.x = -4
        ptDestOffsetXY.y = 4
    End If
    'else leave the destination offset as 0,0

        'Set an optional destination rectangle
    Dim varDestRect As Variant
    If bTestDestRect Then
        varDestRect = Array(12, 12, 26, 24)
    End If
    'else leave the destination rectangle as Empty

        'Create an instance of the McColorComposite operator with no parent McImage
    Dim ColorComposite As McColorComposite
    Set ColorComposite = CreateOperator("McColorComposite") 'no parent

        'Create a McLookupTables instance for each source
    Dim objMcLookupTables() As Object
    objMcLookupTables = ColorComposite.GetMcLookupTablesForSources(varSourceImages)

        'Do something to each of the LUT's
    For nImage = 0 To nSources - 1
            'get the next source's McLookupTables instance
        Dim mclookuptablesNext As McLookupTables
        Set mclookuptablesNext = objMcLookupTables(nImage)
            'get the luminance LUT from the source's McLookupTables instance
        Dim mclookuptableNext As McLookupTable
        Set mclookuptableNext = mclookuptablesNext.Item(0)
        If bTestLutChange Then
            'make some fake changes to the LUT
            mclookuptableNext.WhiteLevel = 150#
        End If 'bTestLutChange
    Next nImage

        'Now get the scaling LUT's
    Dim varSourceLookupTables As Variant
    varSourceLookupTables = ColorComposite.GetLutsFromMcLookupTables(objMcLookupTables)

        'Report the source LUT's
    Output.Show ("Output")
    Output.Clear
    Output.PrintMessage "Source LUT's every 32nd" + vbCrLf + _
        McToText(McOpSelect(varSourceLookupTables, , McOpMul(McOpFillIn(0, 8), 32)), "%0.2f")

    Dim ControlFlags As mcCompositeControlFlags
    ControlFlags = mcccfUseAoiAsSource + mcccfCacheResults + _
        mcccfInterpolateIfMagnified + mcccfUseAoiAsDest + _
        mcccfDebugShowIntermediateImages

    Dim varBitsPerColorChannels As Variant
    Dim lMaxBitsPerColorChannel As Long
    Dim varIsFloatPixelDataTypes As Variant
    Dim bSomePixelDataTypeIsFloat As Boolean
    Dim varFrameCounts As Variant
    Dim lMinAdjustedFrameCount As Long
    Dim varSourceSizes As Variant
    Dim varMinAndMaxSourceSizes As Variant
    Dim varOffsetSourceRectangles As Variant
    Dim ProblemCodes As mcCompositeInfoFlags

    ProblemCodes = ColorComposite.GetSourcesInfo( _
        varSourceImages, _
        ControlFlags, _
        larraySourceStartingFrames, _
        ptSourceOffsetsXY, _
        dptMagnificationsXY, _
        ptDestOffsetXY, _
        varBitsPerColorChannels, _
        lMaxBitsPerColorChannel, _
        varIsFloatPixelDataTypes, _
        bSomePixelDataTypeIsFloat, _
        varFrameCounts, _
        lMinAdjustedFrameCount, _
        varSourceSizes, _
        varMinAndMaxSourceSizes, _
        varOffsetSourceRectangles)

        'Report the info on the sources
    Output.PrintMessage "Color Composite Info on" + Str(nSources) + " sources from the Images collection."
    Output.PrintMessage lfProblemCodesAsString(ProblemCodes)
    Output.PrintMessage "Bits per color channel: " + McToText(varBitsPerColorChannels)
    Output.PrintMessage "Max Bits per color channel: " + McToText(lMaxBitsPerColorChannel)
    Output.PrintMessage "Is Float Pixel Type :" + McToText(varIsFloatPixelDataTypes)
    Output.PrintMessage "Some pixel data type is float:" + Str(bSomePixelDataTypeIsFloat)
    Output.PrintMessage "Frame Counts: " + McToText(varFrameCounts)
    Output.PrintMessage "Min Adjusted Frame Count:" + Str(lMinAdjustedFrameCount)
    Output.PrintMessage "Source Sizes: " + vbCrLf + McToText(varSourceSizes)
    Output.PrintMessage "Min Source Size: " + McToText(varMinAndMaxSourceSizes(0)) + _
        " Max Source Size: " + McToText(varMinAndMaxSourceSizes(1))
    Output.PrintMessage "Source Offsets supplied: " + vbCrLf + McToText(ptSourceOffsetsXY)
    Output.PrintMessage "Minus Dest Offset of: " + McToText(ptDestOffsetXY)
    Output.PrintMessage "Offset Source Rectangles: " + vbCrLf + McToText(varOffsetSourceRectangles)

    ColorComposite.DoComposite _
        varSourceImages, _
        larraySourceColors, _
        ControlFlags, _
        larraySourceStartingFrames, _
        varSourceLookupTables, _
        ptSourceOffsetsXY, _
        dptMagnificationsXY, _
        lBackgroundIndex, _
        larraySourceStartingFrames, _
        0, _
        ptDestOffsetXY, _
        varDestRect, _
        imgComposite

    If bTestCaching Then 'for cache test, redo with new offsets
            'Turn off intermediate file display
        ControlFlags = ControlFlags And Not mcccfDebugShowIntermediateImages

        varDestRect = Array(32, 32, 45, 43) 'smaller

        larraySourceColors(0) = &H80& 'less Red for Source(0)

        ColorComposite.FreeCaches Array(varSourceImages(0)), 0, mcfcctColorized 'free source 0 color cache

        ColorComposite.DoComposite _
            varSourceImages, _
            larraySourceColors, _
            ControlFlags, _
            larraySourceStartingFrames, _
            varSourceLookupTables, _
            ptSourceOffsetsXY, _
            dptMagnificationsXY, _
            lBackgroundIndex, _
            larraySourceStartingFrames, _
            0, _
            ptDestOffsetXY, _
            varDestRect, _
            imgComposite
    End If 'bTestCaching

    Set TestTwoWayGrayColorComposite = imgComposite
    imgComposite.Modified = False
    imgComposite.LookupTables.Reset mclrmBWTrueRange
    Set ActiveImage = imgComposite

End Function 'TestTwoWayGrayColorComposite

Public Sub DoTestTwoWayGrayColorComposite()
'        Optional bTestSourceOffsets As Boolean = False, _
'        Optional bTestMagnifications As Boolean = False, _
'        Optional bTestDestAoi As Boolean = False, _
'        Optional bTestDestOffset As Boolean = False, _
'        Optional bTestDestRect As Boolean = False, _
'        Optional bTestLutChange As Boolean = False, _
'        Optional bTestCaching As Boolean = False, _
'        Optional lBackgroundIndex As Long = -1)
    TestTwoWayGrayColorComposite True, False, False, False, False, False, True, -1
End Sub 'DoTestTwoWayGrayColorComposite