form1.frm

一个基于计算阀值和黑像素值的生物识别软件

        peFlags As Byte
End Type

Dim BF As BITMAPFILEHEADER
Dim BI As BITMAPINFOHEADER
Dim pixcolor() As Byte
Dim newcolor() As Integer
Dim light() As Integer
Dim color() As RGBQUAD
Dim num As Byte

Private Sub Form_Load()
        Form1.Hide
        frmAbout.Show
        frmAbout.SetFocus
End Sub

Private Sub txsr_Click()
On Error Resume Next
         Dim Counter As Integer
         ProgressBar1.Min = 0
         ProgressBar1.max = 10000
         ProgressBar1.Visible = True
         ProgressBar1.Value = ProgressBar1.Min
         For Counter = 0 To 10000
           ProgressBar1.Value = Counter
         Next Counter
         ProgressBar1.Visible = False
         ProgressBar1.Value = ProgressBar1.Min
         CommonDialog1.ShowOpen
         Picture1.Picture = LoadPicture(CommonDialog1.FileName)
         sb.Enabled = False
         yz.Enabled = False
         ezh.Enabled = False
         bytq.Enabled = False
         zft.Enabled = False
         jg.Enabled = False
End Sub

Private Sub drsj_Click()
        Dim Counter As Integer
        ProgressBar1.Min = 0
        ProgressBar1.max = 10000
        ProgressBar1.Visible = True
        ProgressBar1.Value = ProgressBar1.Min
        For Counter = 0 To 10000
          ProgressBar1.Value = Counter
        Next Counter
        ProgressBar1.Visible = False
        ProgressBar1.Value = ProgressBar1.Min
        Dim i, j, n, t As Integer
        Form1.MousePointer = 11
        Form1.Enabled = False
        Open Form1.Picture1.Picture For Binary As #1
        Get #1, , BF
        Get #1, , BI
        ReDim pixcolor(BI.biHeight, BI.biWidth, 2) As Byte
        Select Case BI.biBitCount
               Case 1
               ReDim color(2) As RGBQUAD
               Get #1, , color(0)
               Get #1, , color(1)
               For i = 0 To BI.biHeight - 1
                 For j = 0 To BI.biWidth - 1
                   Get #1, , num
                   pixcolor(i, j, 0) = color(num).rgbBlue
                   pixcolor(i, j, 1) = color(num).rgbGreen
                   pixcolor(i, j, 2) = color(num).rgbRed
                 Next j
               Next i
               
               Case 4
               ReDim color(16) As RGBQUAD
               For n = 0 To 15
               Get #1, , color(n)
               Next n
               For i = 0 To BI.biHeight - 1
                 For j = 0 To BI.biWidth - 1
                   Get #1, , num
                   pixcolor(i, j, 0) = color(num).rgbBlue
                   pixcolor(i, j, 1) = color(num).rgbGreen
                   pixcolor(i, j, 2) = color(num).rgbRed
                 Next j
               Next i
               
               Case 8
               ReDim color(255) As RGBQUAD
               For n = 0 To 255
                 Get #1, , color(n)
               Next n
               If BI.biWidth Mod 4 = 0 Then
               n = 0
               Else
               n = BI.biWidth Mod 4
               End If
               For i = 0 To BI.biHeight - 1
                 For j = 0 To BI.biWidth - 1
                   Get #1, , num
                   pixcolor(i, j, 0) = color(num).rgbBlue
                   pixcolor(i, j, 1) = color(num).rgbGreen
                   pixcolor(i, j, 2) = color(num).rgbRed
                 Next j
                 For t = 1 To n
                   Get #1, , num
                 Next t
               Next i
               
               Case 24
               If BI.biWidth Mod 4 = 0 Then
               n = 0
               Else
               n = BI.biWidth Mod 4
               End If
               For i = 0 To BI.biHeight - 1
                 For j = 0 To BI.biWidth - 1
                   Get #1, , pixcolor(i, j, 0)
                   Get #1, , pixcolor(i, j, 1)
                   Get #1, , pixcolor(i, j, 2)
                 Next j
                 For t = 1 To n
                   Get #1, , num
                 Next t
               Next i
               End Select
               
        Close #1
        Form1.Enabled = True
        Form1.MousePointer = 0
        txsr.Enabled = True
        sb.Enabled = True
        yz.Enabled = True
        ezh.Enabled = True
        bytq.Enabled = True
        zft.Enabled = True
        jg.Enabled = True
        drsj.Enabled = True
End Sub

Private Sub zft_Click()
        Dim Counter As Integer
        ProgressBar1.Min = 0
        ProgressBar1.max = 10000
        ProgressBar1.Visible = True
        ProgressBar1.Value = ProgressBar1.Min
        For Counter = 0 To 10000
          ProgressBar1.Value = Counter
        Next Counter
        ProgressBar1.Visible = False
        ProgressBar1.Value = ProgressBar1.Min
        Dim i, j, r, g, b As Integer
        Dim c, hd(255) As Long
        Dim cc, pic(255, 255, 2), l As Byte
        Dim PictureName As String
        MSChart1.ColumnCount = 32
        MSChart1.RowCount = 8
        Form1.MSChart1.Row = 1: Form1.MSChart1.RowLabel = "32"
        Form1.MSChart1.Row = 2: Form1.MSChart1.RowLabel = "64"
        Form1.MSChart1.Row = 3: Form1.MSChart1.RowLabel = "96"
        Form1.MSChart1.Row = 4: Form1.MSChart1.RowLabel = "128"
        Form1.MSChart1.Row = 5: Form1.MSChart1.RowLabel = "160"
        Form1.MSChart1.Row = 6: Form1.MSChart1.RowLabel = "192"
        Form1.MSChart1.Row = 7: Form1.MSChart1.RowLabel = "224"
        Form1.MSChart1.Row = 8: Form1.MSChart1.RowLabel = "256"
        Screen.MousePointer = 11
        For i = 0 To Picture1.ScaleWidth - 1
          For j = 0 To Picture1.ScaleHeight - 1
            c = Picture1.Point(i, j)
            r = (c And 255)
            g = (c And 65280) / 256
            b = (c And 16711680) / 65536
            cc = Fix((r + g + b) / 3)
            pic(i, j, 2) = cc
          Next
        Next
        For i = 0 To Picture1.ScaleWidth - 1
          For j = 0 To Picture1.ScaleHeight - 1
            l = pic(i, j, 2)
            hd(l) = hd(l) + 1
          Next
        Next
        For i = 0 To 7
          For j = 0 To 31
            Form1.MSChart1.Row = i + 1
            Form1.MSChart1.Column = j + 1
            Form1.MSChart1.Data = hd(i * 32 + j)
          Next
        Next
        Screen.MousePointer = 0
End Sub

Public Sub picpoint()
       Dim i, j, k As Integer
       Dim h(0 To 400, 0 To 400) As Integer              '存储像素的灰度值
       Dim r As Integer
       Dim c As Long
       Dim hd(0 To 300) As Integer
       Dim p(0 To 300) As Currency                       '灰度均值
       Dim tt(0 To 300) As Long                          '存储各等级像素个数
       Dim u As Long
       Dim uu(0 To 300) As Long
       Dim w(0 To 300) As Currency
       Dim b(0 To 300) As Long
       Dim max As Long
       Dim maxb As Integer
       Dim t As Integer
       MousePointer = 11
       '扫描全图，取得各像素灰度值
       For i = 1 To Picture1.ScaleWidth
         For j = 1 To Picture1.ScaleHeight
           c = Picture1.Point(i, j)
           r = (c And 255)
           h(i, j) = r
         Next
       Next
       '计算各等级像素个数
       For i = 1 To Picture1.ScaleWidth
         For j = 1 To Picture1.ScaleHeight
           For r = 0 To 255
             If h(i, j) = r Then
             tt(r) = tt(r) + 1
             End If
           Next
         Next
       Next
       For t = 0 To 255
         p(t) = tt(t) / (Picture1.ScaleWidth * Picture1.ScaleHeight)       '计算灰度均值
       Next
       For t = 1 To 255
         u = u + (t - 1) * p(t)                          '计算灰度类均值和类直方图
       Next
       For k = 1 To 255
         uu(k) = uu(k - 1) + (k - 1) * p(k)              '计算类分离指标
         w(k) = w(k - 1) + p(k)
         If w(k) * (1 - w(k)) <> 0 Then
         b(k) = ((u * w(k) - uu(k)) * (u * w(k) - uu(k))) / (w(k) * (1 - w(k)))
         End If
       Next
       max = b(0)
       For k = 0 To 255                  '求最大Q时的k
         If b(k) >= max Then
         max = b(k)
         End If
       Next
       For k = 0 To 255
         If b(k) = max Then
         maxb = k
         End If
       Next
       Form2.Label2.Caption = maxb - 1           '输出k
End Sub

Private Sub yz_Click()
        Dim Counter As Integer
        ProgressBar1.Min = 0
        ProgressBar1.max = 10000
        ProgressBar1.Visible = True
        ProgressBar1.Value = ProgressBar1.Min
        For Counter = 0 To 10000
          ProgressBar1.Value = Counter
        Next Counter
        ProgressBar1.Visible = False
        ProgressBar1.Value = ProgressBar1.Min
        picpoint
        MousePointer = 0
        Form2.Show
End Sub

Private Sub bytq_Click()
        Dim Counter As Integer
        ProgressBar1.Min = 0
        ProgressBar1.max = 10000
        ProgressBar1.Visible = True
        ProgressBar1.Value = ProgressBar1.Min
        For Counter = 0 To 10000
          ProgressBar1.Value = Counter
        Next Counter
        ProgressBar1.Visible = False
        ProgressBar1.Value = ProgressBar1.Min
        Dim i, j, rr As Integer
        Dim c, r, fx As Long
        Picture2.Cls
        Screen.MousePointer = 11
        For i = 0 To Picture1.ScaleWidth - 1 - 1
          For j = 0 To Picture1.ScaleHeight - 1 - 1
            c1 = Picture1.Point(i, j - 1)
            c2 = Picture1.Point(i - 1, j)
            c3 = Picture1.Point(i, j)
            c4 = Picture1.Point(i + 1, j)
            c5 = Picture1.Point(i, j + 1)
            c6 = Picture1.Point(i - 1, j - 1)
            c7 = Picture1.Point(i - 1, j + 1)
            c8 = Picture1.Point(i + 1, j - 1)
            c9 = Picture1.Point(i + 1, j + 1)
            r1 = (c1 And &HFF): r6 = (c6 And &HFF)
            r2 = (c2 And &HFF): r7 = (c7 And &HFF)
            r3 = (c3 And &HFF): r8 = (c8 And &HFF)
            r4 = (c4 And &HFF): r9 = (c9 And &HFF)
            r5 = (c5 And &HFF)
            fx = r6 - r2 - r4 - r9 - r1 - r8 - r7 - r5 + 8 * r3
            rr = Fix(Abs(fx / 2))
            Picture2.PSet (i, j), RGB(rr, rr, rr)
          Next j
        Next i
        Screen.MousePointer = 0
End Sub

Private Sub ezh_Click()
        Dim Counter As Integer
        ProgressBar1.Min = 0
        ProgressBar1.max = 10000
        ProgressBar1.Visible = True
        ProgressBar1.Value = ProgressBar1.Min
        For Counter = 0 To 10000
          ProgressBar1.Value = Counter
        Next Counter
        ProgressBar1.Visible = False
        ProgressBar1.Value = ProgressBar1.Min
        Dim yu, i, j, r As Integer
        Dim c As Long
        yu = Form2.Label2.Caption
        Picture2.Cls
        For i = 0 To Picture1.ScaleWidth - 1
          For j = 0 To Picture1.ScaleHeight - 1
            c = Picture1.Point(i, j)
            r = (c And 255)
            If r > yu Then
            Picture2.PSet (i, j), RGB(255, 255, 255)
            Else
            Picture2.PSet (i, j), RGB(0, 0, 0)
            End If
          Next
        Next
End Sub

Private Sub sb_Click()
        Picture2.Cls
        Dim Counter As Integer
        ProgressBar1.Min = 0
        ProgressBar1.max = 10000
        ProgressBar1.Visible = True
        ProgressBar1.Value = ProgressBar1.Min
        For Counter = 0 To 10000
          ProgressBar1.Value = Counter
        Next Counter
        ProgressBar1.Visible = False
        ProgressBar1.Value = ProgressBar1.Min
        Form3.Show
        Form3.SetFocus
        Form3.Label2.Caption = Form2.Label2.Caption - 128
End Sub

Private Sub jg_Click()
        Dim Counter As Integer
        ProgressBar1.Min = 0
        ProgressBar1.max = 10000
        ProgressBar1.Visible = True
        ProgressBar1.Value = ProgressBar1.Min
        For Counter = 0 To 10000
          ProgressBar1.Value = Counter
        Next Counter
        ProgressBar1.Visible = False
        ProgressBar1.Value = ProgressBar1.Min
        If Form3.Label2.Caption = 21 Then
        Form4.Show
        Form4.SetFocus
        Form4.Label3.Caption = "张燕"
        Else
          If Form3.Label2.Caption = 78 Then
          Form4.Show
          Form4.SetFocus
          Form4.Label3.Caption = "李晓红"
          Else
          Form4.Hide
          Form5.Show
          Form5.SetFocus
          End If
        End If
End Sub

Private Sub tc_Click()
        Form1.Hide
        frmSplash.Show
        frmSplash.SetFocus
End Sub