frmcustomfilter.frm

Visual Basic image processing. Mainly it occupies some filters to detect some prperties of image. Re

      Width           =   435
   End
   Begin VB.TextBox txtValue 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   4
      Left            =   1980
      MaxLength       =   3
      TabIndex        =   9
      Text            =   "0"
      Top             =   480
      Width           =   435
   End
   Begin VB.TextBox txtValue 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   3
      Left            =   1500
      MaxLength       =   3
      TabIndex        =   8
      Text            =   "0"
      Top             =   480
      Width           =   435
   End
   Begin VB.TextBox txtValue 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   2
      Left            =   1020
      MaxLength       =   3
      TabIndex        =   7
      Text            =   "0"
      Top             =   480
      Width           =   435
   End
   Begin VB.TextBox txtValue 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   1
      Left            =   540
      MaxLength       =   3
      TabIndex        =   6
      Text            =   "0"
      Top             =   480
      Width           =   435
   End
   Begin VB.TextBox txtWeight 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   840
      MaxLength       =   3
      TabIndex        =   5
      Text            =   "1"
      Top             =   3060
      Width           =   2535
   End
   Begin VB.TextBox txtValue 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Index           =   0
      Left            =   60
      MaxLength       =   3
      TabIndex        =   3
      Text            =   "0"
      Top             =   480
      Width           =   435
   End
   Begin VB.ComboBox cboBaseOn 
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   840
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   3480
      Width           =   2535
   End
   Begin VB.Label lblWeight 
      Caption         =   "Weight:"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   60
      TabIndex        =   4
      Top             =   3120
      Width           =   795
   End
   Begin VB.Label lblBase 
      Caption         =   "Base On:"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   60
      TabIndex        =   1
      Top             =   3540
      Width           =   735
   End
   Begin VB.Label lblName 
      Caption         =   "Name:"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   60
      TabIndex        =   0
      Top             =   120
      Width           =   795
   End
End
Attribute VB_Name = "frmCustomFilter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_cI As New cImageProcessDIB
Private m_bCancel As Boolean

Private Sub pLoadSavedFilter(ByVal lIndex As Long)
Dim cR As New cRegistry
Dim i As Long
Dim vValues As Variant
    cR.ClassKey = HKEY_CURRENT_USER
    cR.SectionKey = "Software\vbAccelerator\vbImageProc\Filter" & lIndex
    If (cR.KeyExists) Then
        cR.ValueKey = "Weight"
        cR.ValueType = REG_DWORD
        txtWeight.Text = cR.Value
        cR.ValueKey = "Values"
        cR.ValueType = REG_BINARY
        vValues = cR.Value
        For i = 0 To 48
            If (vValues(i * 2) <> 0) Then
                txtValue(i) = -1 * vValues(i * 2 + 1)
            Else
                txtValue(i) = vValues(i * 2 + 1)
            End If
        Next i
    End If
    
End Sub
Private Sub pSaveFilter(ByVal sName As String)
Dim lC As Long
Dim cR As New cRegistry
Dim bV() As Byte
Dim iV As Integer
Dim i As Long

    If (cboName.ListIndex = -1) Then
        lC = cboName.ListCount + 1
    Else
        lC = cboName.ItemData(cboName.ListIndex)
    End If
    cR.ClassKey = HKEY_CURRENT_USER
    cR.SectionKey = "Software\vbAccelerator\vbImageProc"
    
    ' Increment the name list:
    cR.ValueKey = "CustomFilters"
    cR.ValueType = REG_DWORD
    cR.Value = lC
    cR.ValueKey = "Filter" & lC
    cR.ValueType = REG_SZ
    cR.Value = sName

    ' Add the specific values:
    cR.SectionKey = cR.SectionKey & "\Filter" & lC
    cR.ValueKey = "Weight"
    cR.ValueType = REG_DWORD
    cR.Value = CLng(txtWeight.Text)
    cR.ValueKey = "Values"
    cR.ValueType = REG_BINARY
    ReDim bV(0 To 98) As Byte
    For i = 0 To 48
        iV = Val(txtValue(i).Text)
        If iV < 0 Then
            bV(i * 2) = 1
        End If
        bV(i * 2 + 1) = Abs(iV)
    Next i
    cR.Value = bV()
    
End Sub

Public Property Get ImageProcess() As cImageProcessDIB
    Set ImageProcess = m_cI
End Property

Public Property Get Cancelled() As Boolean
    Cancelled = m_bCancel
End Property

Private Sub cboBaseOn_Click()
Dim i As Long, j As Long
Dim iIndex As Long
Dim lSize As Long

    If (cboBaseOn.ListIndex <> -1) Then
        If (cboBaseOn.ItemData(cboBaseOn.ListIndex) <> -1) Then
            For i = 0 To 48
                If (i <> 24) Then
                    txtValue(i) = "0"
                    txtValue_Change CInt(i)
                Else
                    txtValue(i) = "1"
                End If
            Next i
            txtWeight = "1"
            If (cboBaseOn.ItemData(cboBaseOn.ListIndex) > -1) Then
                m_cI.FilterType = cboBaseOn.ItemData(cboBaseOn.ListIndex)
                lSize = m_cI.FilterArraySize
                iIndex = 3 - lSize \ 2 + ((3 - lSize \ 2)) * 7
                For i = -lSize \ 2 To lSize \ 2
                    For j = -lSize \ 2 To lSize \ 2
                        txtValue(iIndex) = m_cI.FilterValue(i, j)
                        iIndex = iIndex + 1
                    Next j
                    iIndex = iIndex + 7 - lSize
                Next i
                txtWeight = m_cI.FilterWeight
            End If
        End If
    End If
End Sub

Private Sub cboName_Click()
    If (cboName.ListIndex > -1) Then
        pLoadSavedFilter cboName.ItemData(cboName.ListIndex)
    End If
End Sub

Private Sub chkAuto_Click()
    If (chkAuto.Value = Checked) Then
        pCalculateWeight
    End If
End Sub

Private Sub cmdCancel_Click()
    m_bCancel = True
    Unload Me
End Sub

Private Sub cmdOK_Click()
Dim i As Long, j As Long
Dim iIndex As Long
Dim iMaxI As Long, iMaxJ As Long, iC As Long
Dim iMax As Long
Dim iSIze As Long
Dim bAllZero As Boolean

    m_bCancel = False
    ' Evaluate the size required for this filter:
    bAllZero = True
    For i = 0 To 6
        For j = 0 To 6
            If Val(txtValue(iIndex).Text) <> 0 Then
                bAllZero = False
                iC = Abs(i - 3)
                If (iC > iMaxI) Then iMaxI = iC
                iC = Abs(j - 3)
                If (iC > iMaxJ) Then iMaxJ = iC
            End If
            iIndex = iIndex + 1
        Next j
    Next i
    
    If (bAllZero) Then
        MsgBox "This filter would always cause the output image to be black.  Please enter a value.", vbInformation
        Exit Sub
    End If
    
    If (iMaxI > iMaxJ) Then iMax = iMaxI Else iMax = iMaxJ
    Debug.Print iMax
    If (iMax < 1) Then
        MsgBox "Filters must be at least 3x3 in size.", vbInformation
        Exit Sub
    End If
    
    iSIze = iMax * 2 + 1
    ' Store size, weight and filter coefficients:
    m_cI.FilterArraySize = iSIze
    m_cI.FilterWeight = Val(txtWeight.Text)
    
    iIndex = 3 - iSIze \ 2 + ((3 - iSIze \ 2)) * 7
    For i = -iMax To iMax
        For j = -iMax To iMax
            m_cI.FilterValue(i, j) = Val(txtValue(iIndex).Text)
            iIndex = iIndex + 1
        Next j
        iIndex = iIndex + 7 - iSIze
    Next i
        
    pSaveFilter cboName.Text
        
    Unload Me
End Sub

Private Sub Form_Load()
    
    ' Display the options:
    m_bCancel = True
    With cboBaseOn
        .AddItem "<none>"
        .ItemData(.NewIndex) = -1
        .AddItem "<reset>"
        .ItemData(.NewIndex) = -2
        .AddItem "Blur"
        .ItemData(.NewIndex) = eBlur
        .AddItem "Blur More"
        .ItemData(.NewIndex) = eBlurMore
        .AddItem "Soften"
        .ItemData(.NewIndex) = eSoften
        .AddItem "Soften More"
        .ItemData(.NewIndex) = eSoftenMore
        .AddItem "Sharpen"
        .ItemData(.NewIndex) = eSharpen
        .AddItem "Sharpen More"
        .ItemData(.NewIndex) = eSharpenMore
        .ListIndex = 1
        .ListIndex = 0
    End With
    
    ' Load saved values:
    Dim cR As New cRegistry
    Dim lC As Long, lSaved As Long
    
    cR.ClassKey = HKEY_CURRENT_USER
    cR.SectionKey = "Software\vbAccelerator\vbImageProc"
    cR.ValueKey = "CustomFilters"
    cR.Default = 0
    cR.ValueType = REG_DWORD
    lC = cR.Value
    If (lC > 0) Then
        For lSaved = 1 To lC
            cR.ValueKey = "Filter" & lC
            cR.ValueType = REG_SZ
            cboName.AddItem cR.Value
            cboName.ItemData(cboName.NewIndex) = lSaved
        Next lSaved
    End If
    
End Sub

Private Sub txtValue_Change(Index As Integer)
    If (IsNumeric(txtValue(Index).Text)) Then
        If (Val(txtValue(Index).Text) = 0) Then
            txtValue(Index).BackColor = vbButtonFace
        Else
            txtValue(Index).BackColor = vbWindowBackground
        End If
    End If
    If (chkAuto.Value = Checked) Then
        pCalculateWeight
    End If
End Sub
Private Sub pCalculateWeight()
Dim i As Long
Dim lWt As Long
    For i = txtValue.LBound To txtValue.UBound
        If IsNumeric(txtValue(i).Text) Then
            lWt = lWt + Val(txtValue(i).Text)
        End If
    Next i
    txtWeight.Text = lWt
End Sub

Private Sub txtValue_KeyPress(Index As Integer, KeyAscii As Integer)
    If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
    Else
        If (KeyAscii <> 8) And (KeyAscii <> Asc("-")) Then
            KeyAscii = 0
        End If
    End If
End Sub

Private Sub txtWeight_KeyPress(KeyAscii As Integer)
    If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Then
    Else
        If (KeyAscii <> 8) And (KeyAscii <> Asc("-")) Then
            KeyAscii = 0
        End If
    End If
End Sub