demo1.frm

用matlab语言对数字图像处理进行了系统的阐述

      Caption         =   "红色："
      BeginProperty Font 
         Name            =   "System"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   1
      Left            =   -60
      TabIndex        =   5
      Top             =   4860
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "灰度："
      BeginProperty Font 
         Name            =   "System"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   0
      Left            =   -60
      TabIndex        =   4
      Top             =   4500
      Width           =   975
   End
   Begin VB.Menu x1 
      Caption         =   "颜色配色"
      Begin VB.Menu q1 
         Caption         =   "混色图"
      End
      Begin VB.Menu q2 
         Caption         =   "原始图"
      End
      Begin VB.Menu q5 
         Caption         =   "灰度图"
      End
      Begin VB.Menu zzz 
         Caption         =   "-"
      End
      Begin VB.Menu q3 
         Caption         =   "伪彩色方案一"
      End
      Begin VB.Menu q4 
         Caption         =   "伪彩色方案二"
      End
      Begin VB.Menu zz1 
         Caption         =   "-"
      End
      Begin VB.Menu qe 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu x2 
      Caption         =   "图象显示"
      Begin VB.Menu q12 
         Caption         =   "彩色负片"
      End
      Begin VB.Menu q13 
         Caption         =   "黑白负片"
      End
      Begin VB.Menu q6 
         Caption         =   "伪彩色一图象"
      End
      Begin VB.Menu q7 
         Caption         =   "伪彩色二图象"
      End
   End
   Begin VB.Menu x3 
      Caption         =   "图象处理"
      Begin VB.Menu q10 
         Caption         =   "3X3十字中值滤波平滑"
      End
      Begin VB.Menu q14 
         Caption         =   "模板处理"
      End
   End
End
Attribute VB_Name = "图像处理演示程序"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bz As Integer
Dim r, g, b As Single
Dim h, s, l As Single
Dim tx(319, 239) As Integer
Private Sub Form_Load()
    bz = False
End Sub

Private Sub hlstorgb()
    Dim m1, m2 As Single
    If l <= 0.5 Then
        m2 = l * (1 + s)
    Else
        m2 = l + s - l * s
    End If
    m1 = 2 * l - m2
    If s = 0 Then
        r = l
        g = l
        b = l
    Else
        r = value(m1, m2, h + 120)
        g = value(m1, m2, h)
        b = value(m1, m2, h - 120)
    End If
    r = CInt(r * 255)
    g = CInt(g * 255)
    b = CInt(b * 255)
End Sub

Private Sub q1_Click()
'   显示三基色及其混色图
    Dim i As Long, j As Long
    Dim x0 As Integer, y0 As Integer, r0 As Integer
    Dim r, pi As Single
    Dim x1, y1, x2, y2, x3, y3 As Single
    Dim r1, r2, r3 As Single
    Dim dx, dy As Single
    pi = Atn(1) / 45
'
    x0 = 160
    y0 = 131
    r0 = 50
    x1 = x0 - r0 * Cos(30 * pi)
    y1 = y0 + r0 * Sin(30 * pi)
    x2 = x0 + r0 * Cos(30 * pi)
    y2 = y1
    x3 = x0
    y3 = y0 - r0
    r = 80 * 80
    P2.Cls
    For j = 0 To 239
        For i = 0 To 319
            If r > (i - x1) * (i - x1) + (j - y1) * (j - y1) Then r1 = 255 Else r1 = 0
            If r > (i - x2) * (i - x2) + (j - y2) * (j - y2) Then r2 = 255 Else r2 = 0
            If r > (i - x3) * (i - x3) + (j - y3) * (j - y3) Then r3 = 255 Else r3 = 0
            P1.PSet (i, j), RGB(r1, r2, r3)
        Next i
        DoEvents
    Next j
'
    x0 = 159
    y0 = 119
    r0 = 118
    pi = 45 / Atn(1)
    For j = 0 To 239
        For i = 0 To 319
            r = Sqr((i - x0) * (i - x0) + (j - y0) * (j - y0))
            If r > r0 Then
                P2.PSet (i, j), 0
            Else
                s = r / r0
                l = 0.5
                dx = i - x0
                dy = j - y0
                If dx > 0 Then
                    h = pi * Atn(dy / dx)
                ElseIf dx < 0 Then
                    h = 180 + pi * Atn(dy / dx)
                ElseIf dy >= 0 And dx = 0 Then
                    h = 90
                ElseIf dy < 0 And dx = 0 Then
                    h = 270
                End If
                If h < 0 Then h = h + 360
                Call hlstorgb
                P2.PSet (i, j), RGB(r, g, b)
            End If
        Next i
        DoEvents
    Next j
End Sub

Private Sub q10_Click()
'   八邻域平均平滑
    Static mm(4) As Long
    Dim c As Long
    Dim r As Integer
    Dim g As Integer
    Dim b As Integer
    Dim i, j As Integer
    Dim s, m, chg As Integer
    Call q5_click
    P2.Visible = True
    For j = 1 To 342
        For i = 1 To 319
            mm(0) = P2.Point(i - 1, j)
            mm(1) = P2.Point(i + 1, j)
            mm(2) = P2.Point(i, j)
            mm(3) = P2.Point(i, j - 1)
            mm(4) = P2.Point(i, j + 1)
'           冒泡法排序
            Do
                chg = 0
                For m = 0 To 3
                    If mm(m) < mm(m + 1) Then
                        s = mm(m)
                        mm(m) = mm(m + 1)
                        mm(m + 1) = s
                        chg = 1
                    End If
                Next m
            DoEvents
            Loop While chg = 1
            P2.PSet (i, j), mm(2)
            DoEvents
        Next i
    Next j
End Sub

Private Sub q12_Click()
    Dim c As Long
    Dim r, g, b As Integer
    Dim i, j As Integer
    P1.Picture = p3.Picture
    For j = 0 To 239
        For i = 0 To 319
            c = P1.Point(i, j)
            b = c \ &H10000
            c = c Mod &H10000
            g = c \ &H100
            r = c Mod &H100
            P2.PSet (i, j), RGB(255 - r, 255 - g, 255 - b)
        Next i
        DoEvents
    Next j
End Sub

Private Sub q13_Click()
    Dim c As Long
    Dim r, g, b As Integer
    Dim i, j As Integer
    Call q5_click
    For j = 0 To 239
        For i = 0 To 320
            c = P1.Point(i, j)
            b = c \ &H10000
            c = c Mod &H10000
            g = c \ &H100
            r = c Mod &H100
            c = r * 0.3 + g * 0.59 + b * 0.11
            P2.PSet (i, j), RGB(255 - c, 255 - c, 255 - c)
        Next i
        DoEvents
    Next j
End Sub

Private Sub q14_Click()
    Dim c As Single
    Dim r As Integer
    Dim i As Long, j As Long, k As Long
    Dim min, max As Integer
    Call q5_click
    min = -10000
    max = 10000
    For j = 1 To 238
        For i = 1 To 318
            c = t(0).Text * (tx(i - 1, j - 1))
            c = c + t(1).Text * (tx(i - 1, j))
            c = c + t(2).Text * (tx(i - 1, j + 1))
            c = c + t(3).Text * (tx(i, j - 1))
            c = c + t(4).Text * (tx(i, j))
            c = c + t(5).Text * (tx(i, j + 1))
            c = c + t(6).Text * (tx(i + 1, j - 1))
            c = c + t(7).Text * (tx(i + 1, j))
            c = c + t(8).Text * (tx(i + 1, j + 1))
            c = CInt(c)
            tx(i, j) = Int(c)
            If min < c Then min = c
            If max > c Then max = c
            P2.PSet (i, j), RGB(255, 0, 0)
        Next i
        DoEvents
    Next j
    c = 255 / (max - min)
    For j = 1 To 238
        For i = 1 To 318
            r = c * (tx(i, j) - min)
            P2.PSet (i, j), RGB(r, r, r)
        Next i
        DoEvents
    Next j
End Sub

Private Sub q2_Click()
    P1.Picture = p3.Picture
End Sub

Private Sub q3_click()
'   显示伪彩色方案一
    Dim i, j As Integer
    Dim r, g, b As Single
    For i = 0 To 255
        If i <= 63 Then
            r = 0
            g = i * 255 / 63
            b = 255
        ElseIf i <= 127 Then
            r = 0
            g = 255
            b = (127 - i) * 255 / 63
        ElseIf i <= 191 Then
            r = (i - 128) * 255 / 63
            g = 255
            b = 0
        Else
            r = 255
            g = (255 - i) * 255 / 63
            b = 0
        End If
        For j = 0 To 22
            ph.PSet (i, j), RGB(i, i, i)
            pr.PSet (i, j), RGB(r, 0, 0)
            pg.PSet (i, j), RGB(0, g, 0)
            pb.PSet (i, j), RGB(0, 0, b)
            pw.PSet (i, j), RGB(r, g, b)
        Next j
        DoEvents
    Next i
End Sub

Private Sub q4_click()
'   显示伪彩色方案二
    Dim i, j As Integer
    Dim r, g, b As Single
    For i = 0 To 255
        For j = 0 To 22
            If i <= 31 Then
                r = 0: g = 0: b = i + i
            ElseIf i <= 63 Then
                r = i + i - 64: g = 0: b = 126 - i - i
            ElseIf i <= 95 Then
                r = 62: g = 0: b = i + i - 128
            ElseIf i <= 127 Then
                r = 254 - i - i: g = i + i - 192: b = 254 - i - i
            ElseIf i <= 159 Then
                r = 0: g = 62: b = i + i - 256
            ElseIf i <= 191 Then
                r = i + i - 320: g = 62: b = 382 - i - i
            ElseIf i <= 223 Then
                r = 62: g = 62: b = i + i - 384
            Else
                r = 510 - i - i: g = 510 - i - i: b = 510 - i - i
            End If
            r = r * 255 / 63
            g = g * 255 / 63
            b = b * 255 / 63
            ph.PSet (i, j), RGB(i, i, i)
            pr.PSet (i, j), RGB(r, 0, 0)
            pg.PSet (i, j), RGB(0, g, 0)
            pb.PSet (i, j), RGB(0, 0, b)
            pw.PSet (i, j), RGB(r, g, b)
        Next j
        DoEvents
    Next i
End Sub

Private Sub q5_click()
    '显示灰度图
    Dim c As Long
    Dim r, g, b As Integer
    Dim i, j As Integer
    P1.Picture = p3.Picture
    If tx(0, 0) <> 0 Then GoTo xxxx
    For j = 0 To 239
        For i = 0 To 319
            c = P1.Point(i, j)
            b = c \ &H10000
            c = c Mod &H10000
            g = c \ &H100
            r = c Mod &H100
            tx(i, j) = CInt(r * 0.3 + g * 0.59 + b * 0.11)
        Next i
    Next j
xxxx:
    For j = 0 To 239
        For i = 0 To 319
            P1.PSet (i, j), RGB(tx(i, j), tx(i, j), tx(i, j))
        Next i
        DoEvents
    Next j
    P2.Cls
End Sub

Private Sub q6_Click()
    Dim c As Long
    Dim r, g, b As Integer
    Dim i, j As Integer
    Call q5_click
    Call q3_click
    For j = 0 To 239
        For i = 0 To 319
            c = tx(i, j)
            If c <= 63 Then
                r = 0
                g = c * 255 / 63
                b = 255
            ElseIf c <= 127 Then
                r = 0
                g = 255
                b = (127 - c) * 255 / 63
            ElseIf c <= 191 Then
                r = (c - 128) * 255 / 63
                g = 255
                b = 0
            Else
                r = 255
                g = (255 - c) * 255 / 63
                b = 0
            End If
            P2.PSet (i, j), RGB(r, g, b)
        Next i
        DoEvents
    Next j
End Sub

Private Sub q7_Click()
    Dim c As Long
    Dim r As Integer
    Dim g As Integer
    Dim b As Integer
    Dim i, j As Integer
    Call q5_click
    Call q4_click
    For j = 0 To 239
        For i = 0 To 319
            c = tx(i, j)
            If c <= 31 Then
                r = 0: g = 0: b = c + c
            ElseIf c <= 63 Then
                r = c + c - 64: g = 0: b = 126 - c - c
            ElseIf c <= 95 Then
                r = 62: g = 0: b = c + c - 128
            ElseIf c <= 127 Then
                r = 254 - c - c: g = c + c - 192: b = 254 - c - c
            ElseIf c <= 159 Then
                r = 0: g = 62: b = c + c - 256
            ElseIf c <= 191 Then
                r = c + c - 320: g = 62: b = 382 - c - c
            ElseIf c <= 223 Then
                r = 62: g = 62: b = c + c - 384
            Else
                r = 510 - c - c: g = 510 - c - c: b = 510 - c - c
            End If
            r = r * 255 / 63
            g = g * 255 / 63
            b = b * 255 / 63
            P2.PSet (i, j), RGB(r, g, b)
        Next i
        DoEvents
    Next j
End Sub

Private Sub qe_Click()
    End
End Sub

Private Function value(ByVal n1 As Single, ByVal n2 As Single, ByVal hue As Single) As Single
    If hue > 360 Then hue = hue - 360
    If hue < 0 Then hue = hue + 360
    If hue < 60 Then
        value = n1 + (n2 - n1) * hue / 60
    ElseIf hue < 180 Then
        value = n2
    ElseIf hue < 240 Then
        value = n1 + (n2 - n1) * (240 - hue) / 60
    Else
        value = n1
    End If
End Function