Option Explicit Attribute VB_Name = "Module1" '********************************************************************** ' Filename: Stereo_Anaglyph.ipm ' Copyright Media Cybernetics, Inc. 2011 ' ' Free for use as demonstration code. ' '---------------------------------------------------------------------- ' PROBLEM SOLVED: ' ' Fuse L/R image pairs into a red/cyan stereo anaglyph. '---------------------------------------------------------------------- ' WHO WOULD USE THIS: ' '---------------------------------------------------------------------- ' SYSTEM REQUIREMENTS: ' '---------------------------------------------------------------------- 'HISTORY OF CHANGES: 'Macro Version: 1.0 'Created: 9/22/11 'Modified: 9/22/11 'Author: KR 'Application: IPWin 'Version: 7.x 'Change History: ' 1.0 9/22/11 KR Created. '********************************************************************** Sub Stereo_Anaglyph() Begin Dialog UserDialog 310,189,"Stereo Anaglyph",.dlgAnaglyph ' %GRID:10,7,1,1 GroupBox 20,14,270,84,"Image source",.GroupBox1 OptionGroup .GroupSource OptionButton 40,35,230,14,"Convergent stereo image (R/L)",.OptionButton1 OptionButton 40,56,230,14,"Divergent stereo image (L/R)",.OptionButton2 OptionButton 40,77,210,14,"Separate images",.OptionButton3 PushButton 50,147,90,21,"Form Stereo",.Stereo OKButton 170,147,90,21 CheckBox 100,112,120,14,"Align images",.CheckBoxAlign End Dialog Dim dlg As UserDialog Dialog dlg End Sub Rem See DialogFunc help topic for more information. Private Function dlgAnaglyph(DlgItem$, Action%, SuppValue?) As Boolean Dim tmpVal As Integer Select Case Action% Case 1 ' Dialog box initialization Call SetWindPos("Stereo Fusion") tmpVal = 0 ret = IpIniFile(INICMD_GETINT, "Stereo Fusion sourcetype", tmpVal) DlgValue "GroupSource", tmpVal tmpVal = 1 ret = IpIniFile(INICMD_GETINT, "Stereo Fusion alignment", tmpVal) If tmpVal > 1 Then tmpVal = 1 DlgValue "CheckBoxAlign", tmpVal Case 2 ' Value changing or button pressed dlgAnaglyph = True ' Prevent button press from closing the dialog box Select Case DlgItem$ Case "Stereo" ret = IpDocGet(DOCGET_GETACTDOC, 0, tmpVal) If tmpVal >= 0 Then Call Split_and_merge(DlgValue("GroupSource"), DlgValue("CheckBoxAlign")) End If Case "OK" dlgAnaglyph = False Call RecWindPos("Stereo Fusion") tmpVal = DlgValue("GroupSource") ret = IpIniFile(INICMD_SETINT, "Stereo Fusion sourcetype", tmpVal) tmpVal = DlgValue("CheckBoxAlign") ret = IpIniFile(INICMD_SETINT, "Stereo Fusion alignment", tmpVal) End Select Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem Wait .1 : dlgAnaglyph = True ' Continue getting idle actions Case 6 ' Function key End Select End Function Sub Split_and_merge(sourceType As Integer, doAlign As Integer) ' Processing core for this macro Dim source As Integer, tmp As Integer Dim alignSeq As Integer Dim dInfo As IPDOCINFO, dInfo1 As IPDOCINFO Dim clipLeft As Integer, clipRight As Integer Dim alignLeft As Integer, alignRight As Integer Dim mixRed As Integer, mixGreen As Integer, mixBlue As Integer Dim myPt As POINTAPI clipLeft = -1 : clipRight = -1 alignLeft = -1 : alignRight = -1 alignSeq = -1 Select Case sourceType Case 0, 1 ' Split the current image ret = IpDocGet(DOCGET_GETACTDOC, 0, source) ret = IpDocGet(DOCGET_GETDOCINFO, source, dInfo) ipRect.Left = 0 ipRect.top = 0 ipRect.Right = dInfo.Width/2-1 ipRect.bottom = dInfo.Height-1 ret = IpAoiCreateBox(ipRect) clipLeft = IpWsDuplicate() ret = IpAppSelectDoc(source) ret = IpAoiMove(dInfo.Width/2, 0) clipRight = IpWsDuplicate() ret = IpAppSelectDoc(source) ret = IpAoiShow(FRAME_NONE) Case 2 clipLeft = IpDocClick("Select the left image", myPt) clipRight = IpDocClick("Select the right image", myPt) If clipLeft < 0 Or clipRight < 0 Then Exit Sub ret = IpDocGet(DOCGET_GETDOCINFO, clipLeft, dInfo) ret = IpDocGet(DOCGET_GETDOCINFO, clipRight, dInfo1) If dInfo.Width <> dInfo1.Width Or dInfo.Height <> dInfo1.Height Or _ dInfo.iClass <> dInfo1.iClass Then Beep ret = IpMacroStop("Images are not the same size or class", 0) Exit Sub End If End Select If sourceType = 0 Then ' Reverse images! tmp = clipLeft clipLeft = clipRight clipRight = tmp End If If sourceType = 2 Then ret = IpAppSelectDoc(clipLeft) clipLeft = IpWsDuplicate() ret = IpAppSelectDoc(clipRight) clipRight = IpWsDuplicate() End If If doAlign = 1 Then ' Align images ret = IpAlignRemove(DOCSEL_ALL, -1) ret = IpAlignAdd(clipLeft, -1) ret = IpAlignAdd(clipRight, -1) ret = IpAlignSetInt(ALGN_OPTIONS, ALGN_TRANSLATE, 1) ret = IpAlignSetInt(ALGN_OPTIONS, ALGN_SCALE, 0) ret = IpAlignSetInt(ALGN_OPTIONS, ALGN_ROTATE, 0) ret = IpAlignSetInt(ALGN_TRIMBORDERS, 0, 1) ret = IpAlignCalculate() alignSeq = IpAlignApply() ret = IpSeqExtractFrames(0, -1) ' Rename, color split ret = IpDocGet(DOCGET_GETACTDOC, 0, alignRight) alignLeft = alignRight - 1 Else alignLeft = clipLeft alignRight = clipRight clipLeft = -1 : clipRight = -1 End If Select Case dInfo.iClass Case IMC_RGB, IMC_RGB36, IMC_RGB48 ret = IpAppSelectDoc(alignLeft) ret = IpLutSetAttr(CHANNEL, 2) ret = IpLutSetAttr(LUT_BRIGHTNESS, 0) ret = IpLutSetAttr(LUT_CONTRAST, 0) ret = IpLutSetAttr(LUT_GAMMA, 10) ret = IpLutApply() ret = IpLutSetAttr(CHANNEL, 3) ret = IpLutSetAttr(LUT_BRIGHTNESS, 0) ret = IpLutSetAttr(LUT_CONTRAST, 0) ret = IpLutSetAttr(LUT_GAMMA, 10) ret = IpLutApply() ret = IpAppSelectDoc(alignRight) ret = IpLutSetAttr(CHANNEL, 1) ret = IpLutSetAttr(LUT_CONTRAST, 0) ret = IpLutSetAttr(LUT_BRIGHTNESS, 0) ret = IpLutSetAttr(LUT_GAMMA, 10) ret = IpLutApply() ret = IpOpImageArithmetics(alignLeft, 0.0, OPA_ADD, 0) alignRight = -1 Case Else ret = IpCmChannelMerge3(0, alignLeft, alignRight, alignRight, CM_RGB, 1) End Select ' Clean up If clipLeft >= 0 Then ret = IpDocCloseEx(clipLeft) If clipRight >= 0 Then ret = IpDocCloseEx(clipRight) If alignSeq >= 0 Then ret = IpDocCloseEx(alignSeq) If alignLeft >= 0 Then ret = IpDocCloseEx(alignLeft) If alignRight >= 0 Then ret = IpDocCloseEx(alignRight) End Sub