Option Explicit
'*********************************************************************************
'   SeqAvi.scr  version 1.0, 18 May, 2001
'  
'   (c) 2001, Selmar Technologies, Inc.
'
'   Converts a 12- or 16-bit sequence to a 24-bit RGB sequence, respecting 
'      the display range and any pseudo-color table that is applied.  Then
'      prompts user if they want to save as an AVI file.  If so, pulls up
'      "Save As" dialog box with AVI format as default.  User needs to specify
'      file name and location as required.
'
'   Before starting this macro, the user should have the subject 
'      sequence adjusted to the desired Display Range (with 
'      "Enhance | Display Range"), and if desired, should apply 
'      a pseudo-color palette (with "Process | Pseudo-Color")
'
'   Note that in the "Save As" dialog box, with the AVI format selected, 
'      you can use the "Compression" drop-down box to pick different 
'      encodings, depending on which "codecs" are installed on your 
'      system.  A full discussion of codecs is beyond the scope of this
'      macro header, but be aware that uncompressed AVI files take up
'      significantly more disk space than compressed ones, and that some
'      codecs are more common than others (and therefore the resulting
'      AVI files will tend to be more portable to other computers)
'
'   Sometimes, at the mid-point of the conversion, on a sequence where 
'      you do not have a pseudo-color palette applied, you will see the
'      error message: Error; Cannot read file.  If you get this message, 
'      just click "OK" and the process should continue to completion 
'      with no problem.  I am researching ways to eliminate this message.
'
'*********************************************************************************

Sub SequenceToAVI()
	Dim OrigSeqId%, TempImgId%, NewGray8SeqId%, NewRGBSeqId%
	Dim DRLow As Long, DRHigh As Long, DRArr(1) As Long
	Dim FrameCount As Long, NumFrames As Long
	
	On Error Resume Next
	Kill "temp$$$.psc"
	
	On Error GoTo BombOut
	ret = IpDocGet(GETACTDOC, 0, OrigSeqId)
	If (ret < 0) Then
		Err.Raise _
		   Number:= -40, _
		   Source:="IpDocGet call", _
		   Description:="No Document returned.  You must have a sequence selected" 
	End If

	ret = IpSeqPlay(SEQ_FFRA)
	ret = IpSeqGet(SEQ_NUMFRAMES,NumFrames)

	ret = IpTrackBar(TBOPEN,NumFrames*2,"Converting sequence to 8-bit Grayscale")

	' go get display range into DRHigh and DRLow
	ret = IpDrGet(DR_RANGE, 0, DRArr(0))	

	ret = IpPcShow(1)
	ret = IpPcSave("temp$$$.psc")

	ret = IpSeqSet(SEQ_APPLY,0 )	' operate on current frame only
	
	' convert first frame to Gray to create new sequence workspace
	NewGray8SeqId = IpWsConvertImage(IMC_GRAY, CONV_USER, DRArr(0), DRArr(1), 0, 255)
	FrameCount = 1
	ret = IpAppUpdateDoc(DOCSEL_NONE)
	Do
		ret = IpAppSelectDoc(OrigSeqId)
		ret = IpSeqPlay(SEQ_NEXT)
		ret = IpWsConvertImage(IMC_GRAY, CONV_USER, DRArr(0), DRArr(1), 0, 255)
		ret = IpWsCopyFrames(0,-1)
		ret = IpDocClose()
		ret = IpAppSelectDoc(NewGray8SeqId) ' building sequence
		ret = IpWsPasteFrames(-1)
		If IpTrackBar(TBUPDATE, FrameCount, "") <> 0 Then 
			Err.Raise _
			   Number:= 0, _
			   Source:="First Loop", _
			   Description:="User Aborted Process" 
		End If
		FrameCount = FrameCount + 1
	Loop While FrameCount < NumFrames
	ret = IpAppUpdateDoc(DOCSEL_ALL)

	' convert first frame to RGB24 to create new sequence workspace
	ret = IpAppSelectDoc(NewGray8SeqId) ' point to new Gray8 Sequence
	ret = IpSeqPlay(SEQ_FFRA)    ' make sure to start at beginning
	ret = IpSeqSet(SEQ_APPLY,1 )	
	ret = IpPcShow(1)
	On Error Resume Next
	ret = IpPcLoad("temp$$$.psc")
	On Error GoTo BombOut
	ret = IpSeqSet(SEQ_APPLY,0 )	' operate on current frame only

	NewRGBSeqId = IpWsConvertImage(IMC_RGB, CONV_SCALE, 0, 0, 0, 0)
	FrameCount = 1

	ret = IpAppUpdateDoc(DOCSEL_NONE)
	Do
		ret = IpAppSelectDoc(NewGray8SeqId)
		ret = IpSeqPlay(SEQ_NEXT)
		ret = IpWsConvertImage(IMC_RGB, CONV_SCALE, 0, 0, 0, 0)
		ret = IpWsCopyFrames(0,-1)
		ret = IpDocClose()
		ret = IpAppSelectDoc(NewRGBSeqId) ' building sequence
		ret = IpWsPasteFrames(-1)
		If IpTrackBar(TBUPDATE, NumFrames+FrameCount, "") <> 0 Then 
			Err.Raise _
			   Number:= 0, _
			   Source:="First Loop", _
			   Description:="User Aborted Process" 
		End If
		FrameCount = FrameCount + 1
	Loop While FrameCount < NumFrames

	ret = IpDocCloseEx(NewGray8SeqId)
	ret = IpAppUpdateDoc(DOCSEL_ALL)
	ret = IpAppSelectDoc(NewRGBSeqId) ' point to new RGB Sequence
	ret = IpSeqSet(SEQ_APPLY,1 )
	ret = IpSeqPlay(SEQ_FFRA)
	ret = IpTrackBar(TBCLOSE,0,"")
	
	ret=IpMacroStop("You can play the new sequence to check it."+ _
	                vbCrLf + _
	                "Click continue to save as an AVI file."+ _
	                vbCrLf + _
	                "If necessary, in the ""Save As Type"" ListBox, "+ _
	                "pick ""AVI(AVI)"" as the file type.",0)

	ret = IpAppSelectDoc(NewRGBSeqId) ' make sure the user didn't select another
	ret = IpSeqSet(SEQ_APPLY,1 )
    IpTemplateMode(1)
	ret = IpWsSaveEx("test.avi", "avi",6,24)
    IpTemplateMode(0)

	GoTo ExitNormal
	BombOut:
		ret = IpTrackBar(TBCLOSE,0,"")
		MsgBox("Execution error; couldn't complete macro" + _
		vbCrLf + vbCrLf + "Message: "+Err.Description,0)

		' ... then drop through to ExitNormal
		
	ExitNormal:
		ret = IpAppUpdateDoc(DOCSEL_ALL)
		On Error Resume Next
		
	    Kill "temp$$$.psc"
	
End Sub