IMcViewNDSetImageAsTexture Method

Sub SetImageAsTexture ( 
	Index As Integer,
	Image As Object,
	<OptionalAttribute> pPseudoColor As Object
)

'the macro shows how to create a composite image in ND Viewer
Sub CreateCompositePseudoColorView()
If MsgBox("Load demo images?", vbYesNo) = vbYes Then
ThisApplication.Images.RemoveAll
ThisApplication.Images.Open (Path & "\Images\DemoRed.tif")
ThisApplication.Images.Open (Path & "\Images\DemoGrn.tif")
ThisApplication.Images.Open (Path & "\Images\DemoBlue.tif")
End If
Dim ColorCompWindow As McWindow3D
Dim i As Long
'create new ND Window
Set ColorCompWindow = Application.Windows3D.Add(False, False)
'create a new pseudocolor
Dim pscnew As New McPseudoColor
With pscnew
.Size = 256
.ColorSpectrum = mccsRed
.Visible = True
End With
Dim Im As McImage
If ThisApplication.Images.Count = 0 Then Exit Sub
With ColorCompWindow.ViewND
.BeginBlockUpdate True    'disable updates
'put all images to color composite
.SetupTextureMode Images.Count
.BackgroundColor = 0
.SetViewProjection mcViewNDProjXY
.OrthogonalMode = True
.AutoSpin = False
.BackgroundColor = 0
.DrawAxes = False
.VolumeComposition = mcv3dcSum
.UserControlFlags = mcv3ducAllowLButton Or mcv3ducAllowMouseWheel
.AutoReloadFlags = mcv3darNone 'disable auto-reload
For i = 0 To ThisApplication.Images.Count - 1
'set colors (red,green,blue)
pscnew.ColorSpectrum = IIf(i Mod 3 = 0, mccsRed, IIf(i Mod 3 = 1, mccsGreen, mccsBlue))
If i = 0 Then
.ViewHeight = Images.Item(i).Height
End If
'apply image with texture
If ThisApplication.Images.Item(i).NumberOfChannels = 1 Then
'apply pseudocolor only to single channel images
.SetImageAsTexture i, Images.Item(i), pscnew
Else
.SetImageAsTexture i, Images.Item(i)
End If
Next i
.BeginBlockUpdate False
End With
If MsgBox("Show shift test?", vbYesNo) = vbYes Then
ShiftTest
End If
End Sub
'shows how the textures can be controlled
Sub ShiftTest()
Dim ColorCompWindow As McWindow3D
Dim i As Long
Set ColorCompWindow = Application.Windows3D.ActiveWindow3D
If ColorCompWindow Is Nothing Then Exit Sub 'no ND view
Dim Im As McImage
If ThisApplication.Images.Count = 0 Then Exit Sub
'speed test
Dim PauseTime, Start, Finish, TotalTime, NSteps, j
NSteps = 100
Start = Timer    ' Set start time.
For j = 0 To NSteps
Set Im = ThisApplication.Images.Item(j Mod Images.Count)
'move image 1
ColorCompWindow.ViewND.TextureOffset(1) = Array(-j, j, 0)
ColorCompWindow.ViewND.TextureRotation(1) = j
ColorCompWindow.ViewND.TextureScale(1) = (150 - j) / 100
DoEvents
Next j
Finish = Timer    ' Set end time.
TotalTime = Finish - Start    ' Calculate total time.
MsgBox "UpdateSpeed = " & 1000# * TotalTime / NSteps & " ms"
End Sub