vbAccelerator - Contents of code file: frmCompositing.frm

VERSION 5.00
Begin VB.Form frmCompositing 
   Caption         =   "vbAccelerator Compositing Class Demonstration"
   ClientHeight    =   6285
   ClientLeft      =   2355
   ClientTop       =   2115
   ClientWidth     =   8040
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmCompositing.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   419
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   536
   Begin VB.ComboBox cboCompositing 
      Height          =   315
      Left            =   1860
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   420
      Width           =   6075
   End
   Begin VB.Label lblInfo 
      BackStyle       =   0  'Transparent
      Caption         =   "Description of the selected compositing technique."
      Height          =   1155
      Left            =   1920
      TabIndex        =   4
      Top             =   780
      Width           =   6015
   End
   Begin VB.Label lblResult 
      BackColor       =   &H80000010&
      Caption         =   " Result"
      ForeColor       =   &H80000014&
      Height          =   255
      Left            =   1860
      TabIndex        =   3
      Top             =   1980
      Width           =   6075
   End
   Begin VB.Label Label1 
      BackColor       =   &H80000010&
      Caption         =   " Compositing Technique"
      ForeColor       =   &H80000014&
      Height          =   255
      Left            =   1860
      TabIndex        =   1
      Top             =   60
      Width           =   6075
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000010&
      X1              =   120
      X2              =   120
      Y1              =   4
      Y2              =   420
   End
   Begin VB.Label lblSourceImages 
      BackColor       =   &H80000010&
      Caption         =   " Source Images"
      ForeColor       =   &H80000014&
      Height          =   255
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   1695
   End
End
Attribute VB_Name = "frmCompositing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_cSrc As cAlphaDibSection
Private m_cDst As cAlphaDibSection
Private m_cSrcOutput As cAlphaDibSection
Private m_cResOutput As cAlphaDibSection

Private m_domAPI As DOMDocument

Private Sub Composite(ByVal operation As CompositingOperations)
   
   ' Prepare destination:
   Set m_cResOutput = New cAlphaDibSection
   m_cResOutput.Create m_cSrcOutput.width, m_cSrcOutput.height
   m_cResOutput.Clear
   m_cResOutput.CopyArea m_cDst, , , , , (m_cResOutput.width - m_cDst.width)
   
   ' Perform compositing operation
   Dim cCompositor As New cCompositing
   cCompositor.Src = m_cSrcOutput
   cCompositor.Dst = m_cResOutput
   cCompositor.operation = operation
  
   cCompositor.Composite
   
   Me.Refresh
   
End Sub

Private Sub loadImages()
Dim sPath As String
   
On Error GoTo errorHandler

   Set m_cSrc = New cAlphaDibSection
   sPath = normalizePath(App.Path) & "Images\alphaBlue.bmp"
   m_cSrc.CreateFromPicture LoadPicture(sPath)
   
   Set m_cDst = New cAlphaDibSection
   sPath = normalizePath(App.Path) & "Images\alphaBenediti.bmp"
   m_cDst.CreateFromPicture LoadPicture(sPath)
   
   Set m_cSrcOutput = New cAlphaDibSection
   m_cSrcOutput.Create (m_cSrc.width * 4) \ 3, (m_cSrc.height * 4) \ 3
   m_cSrcOutput.Clear
   m_cSrcOutput.CopyArea m_cSrc, , , , , , (m_cSrcOutput.height - m_cSrc.height)
   
   Exit Sub
   
errorHandler:
   MsgBox "Error loading source images for demonstration: " & Err.Description &
    vbCrLf & vbCrLf & "Please check you've installed all files for this
    demonstration properly.", vbExclamation
   Exit Sub
   
End Sub

Private Sub loadDocumentation()
Dim sPath As String
   
   Set m_domAPI = New DOMDocument
   sPath = normalizePath(App.Path) & "/home/VB/Code/vbMedia/Image_Processing/Compositing/InfoCompositing.xml"
   If Not (m_domAPI.Load(sPath)) Then
      MsgBox "Error loading the compositing API XML document: " &
       m_domAPI.parseError & vbCrLf & vbCrLf & "Please check you've installed
       all files for this demonstration properly.", vbExclamation
      Exit Sub
   End If
   
   ' write the compositing methods into the combo:
Dim xPath As String
Dim nodMethod As IXMLDOMNode
   xPath = "Compositing/Method"
   For Each nodMethod In m_domAPI.selectNodes(xPath)
      cboCompositing.AddItem
       nodMethod.selectSingleNode("Name").firstChild.nodeValue
      cboCompositing.ItemData(cboCompositing.NewIndex) =
       CLng(attributeValue(nodMethod, "value"))
   Next
   
   ' select the first item:
   cboCompositing.ListIndex = 0
   
End Sub

Private Function normalizePath(ByVal sPath As String) As String
   If StrComp(Right(Trim(sPath), 1), "\") = 0 Then
      normalizePath = Trim(sPath)
   Else
      normalizePath = Trim(sPath) & "\"
   End If
End Function

Private Function attributeValue(nod As IXMLDOMNode, ByVal name As String) As
 String
Dim attr As IXMLDOMAttribute
   For Each attr In nod.Attributes
      If StrComp(attr.name, name) = 0 Then
         attributeValue = attr.nodeValue
         Exit For
      End If
   Next
End Function

Private Function replace(ByVal sString As String, ByVal sToReplace As String,
 ByVal sReplaceWith As String) As String
Dim sRet As String
Dim iPos As Long
Dim iNextPos As Long
   iPos = 1
   Do
      iNextPos = InStr(iPos, sString, sToReplace)
      If (iNextPos > 0) Then
         sRet = sRet & Mid(sString, iPos, iNextPos - iPos)
         sRet = sRet & sReplaceWith
         iPos = iNextPos + Len(sToReplace)
      End If
   Loop While (iNextPos > 0)
   sRet = sRet & Mid(sString, iPos)
   replace = sRet
End Function

Private Sub cboCompositing_Click()
   '
   ' show the description:
   Dim xPath As String
   xPath = "Compositing/Method[@value='" & _
      cboCompositing.ItemData(cboCompositing.ListIndex) & _
      "']"
   Dim nodMethod As IXMLDOMNode
   Set nodMethod = m_domAPI.selectSingleNode(xPath)
   Dim sDescription As String
   sDescription = nodMethod.selectSingleNode("Description").firstChild.nodeValue
   lblInfo.Caption = replace(sDescription, vbLf, " ")
   
   ' TODO would also like to show Algorithm here
   
   ' Now perform the algorithm:
   Composite cboCompositing.ItemData(cboCompositing.ListIndex)
   
   
End Sub

Private Sub Form_Load()
   loadImages
   loadDocumentation
End Sub

Private Sub Form_Paint()
   '
   Me.Cls
   
   Dim x As Long
   Dim y As Long
   Dim width As Long
   
   x = lblSourceImages.Left
   y = lblSourceImages.Top + lblSourceImages.height + 2
   width = lblSourceImages.width
   
   m_cSrc.AlphaPaintPicture Me.hdc, x, y, width
   m_cDst.AlphaPaintPicture Me.hdc, x, y + m_cSrc.height + 2, width
   
   If Not (m_cResOutput Is Nothing) Then
      x = lblResult.Left
      y = lblResult.Top + lblResult.height + 2
      width = lblResult.width
   
      m_cResOutput.AlphaPaintPicture Me.hdc, x, y, width
      
   End If
   '
End Sub