form1.frm

一个将印刷线路板扫描图转化为黑白图像的分割程序

      TabIndex        =   2
      Top             =   960
      Width           =   1215
      Begin VB.OptionButton Option2 
         Caption         =   "白"
         Height          =   255
         Index           =   0
         Left            =   600
         TabIndex        =   5
         Top             =   720
         Width           =   495
      End
      Begin VB.OptionButton Option1 
         Caption         =   "黑"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   4
         Top             =   720
         Value           =   -1  'True
         Width           =   495
      End
      Begin VB.TextBox Text1 
         Height          =   375
         Index           =   0
         Left            =   120
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         TabIndex        =   3
         Top             =   240
         Width           =   975
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开扫描图"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   9135
      Left            =   1440
      MousePointer    =   2  'Cross
      ScaleHeight     =   605
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   800
      TabIndex        =   0
      Top             =   120
      Width           =   12060
   End
   Begin VB.Label Label1 
      Caption         =   "当前选择"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   600
      Width           =   735
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fileh(64) As Byte
Dim colordatar() As Byte
Dim colordatab() As Byte
Dim xsize
Dim ysize
Dim y
Dim x
Dim nx(6) As Integer
Dim avg(6, 3) As Double
Dim qvar(6, 3) As Double
Dim sumx(6, 3) As Double
Dim sumxx(6, 3) As Double
Dim dist(6) As Double
Private Sub Command1_Click()
On Error GoTo ext1
CommonDialog1.ShowOpen
Open CommonDialog1.FileName For Binary As #1
For i = 1 To 54
Get #1, , fileh(i)
Next i
X2 = fileh(20)
X1 = fileh(19)
Y2 = fileh(24)
Y1 = fileh(23)
xsize = X1 + X2 * 256
ysize = Y1 + Y2 * 256
If fileh(1) = Asc("B") And fileh(2) = Asc("M") And fileh(29) = 24 Then
Picture1.Cls
ReDim colordatar(xsize, ysize, 3) As Byte
For y = 0 To ysize - 1
For x = 0 To xsize - 1
Get #1, , colordatar(x, y, 0)
Get #1, , colordatar(x, y, 1)
Get #1, , colordatar(x, y, 2)
Next x
ProgressBar1.Value = 100 * y / ysize
Next y
If xsize <= 800 And ysize <= 600 Then
For y = 0 To ysize - 1
For x = 0 To xsize - 1
Picture1.PSet (x, ysize - y), RGB(colordatar(x, y, 2), colordatar(x, y, 1), colordatar(x, y, 0))
Next x
ProgressBar1.Value = 100 * y / ysize
Next y
Else
If ysize < 0.75 * xsize Then
k = 800 / xsize
For y = 0 To ysize * k - 1
For x = 0 To 799
Picture1.PSet (x, ysize * k - y), RGB(colordatar(x / k, y / k, 2), colordatar(x / k, y / k, 1), colordatar(x / k, y / k, 0))
Next x
ProgressBar1.Value = 100 * y / (ysize * k)
Next y
Else
k = 600 / ysize
For y = 0 To 599
For x = 0 To xsize * k - 1
Picture1.PSet (x, 600 - y), RGB(colordatar(x / k, y / k, 2), colordatar(x / k, y / k, 1), colordatar(x / k, y / k, 0))
Next x
ProgressBar1.Value = 100 * y / (ysize * k)
Next y
End If
End If
Else
If fileh(1) <> Asc("B") Or fileh(2) <> Asc("M") Then
MsgBox ("这个好像不是BMP文件吧...")
Else
MsgBox ("现在这个程序只认识24bit的BMP彩色图形")
End If
End If
Close #1
ext1:
End Sub

Private Sub Command2_Click()
On Error GoTo ext2
CommonDialog2.ShowSave
ReDim colordatab(xsize, ysize, 3)
For x = 0 To xsize - 1
For y = 0 To ysize - 1
r = colordatar(x, y, 2)
g = colordatar(x, y, 1)
b = colordatar(x, y, 0)
For i = 0 To 5
dist(i) = ((CDbl(r) - avg(i, 2)) / (qvar(i, 2) + 0.1)) ^ 2 + ((CDbl(g) - avg(i, 1)) / (qvar(i, 1) + 0.1)) ^ 2 + ((CDbl(b) - avg(i, 0)) / (qvar(i, 0) + 0.1)) ^ 2
Next i
det = 0
Vall = dist(0)
For i = 1 To 5
If dist(i) < Vall Then
det = i
Vall = dist(i)
End If
Next i
If Option1(det).Value = True Then
colordatab(x, y, 2) = 0
colordatab(x, y, 1) = 0
colordatab(x, y, 0) = 0
Else
colordatab(x, y, 2) = 255
colordatab(x, y, 1) = 255
colordatab(x, y, 0) = 255
End If
Next y
ProgressBar1.Value = x / xsize * 100
Next x
Open CommonDialog2.FileName For Binary As #2
For i = 1 To 54
Put #2, , fileh(i)
Next i
For y = 0 To ysize - 1
For x = 0 To xsize - 1
Put #2, , colordatab(x, y, 0)
Put #2, , colordatab(x, y, 1)
Put #2, , colordatab(x, y, 2)
Next x
ProgressBar1.Value = 100 * y / ysize
Next y
Close #2
ext2:
End Sub

Private Sub Command3_Click()
Picture1.AutoRedraw = False
For x = 0 To 800
For y = 0 To 600
colr = Picture1.Point(x, y)
r = colr Mod 256
g = Fix(colr / 256) Mod 256
b = Fix(colr / 65536) Mod 256
For i = 0 To 5
dist(i) = ((CDbl(r) - avg(i, 2)) / (qvar(i, 2) + 0.1)) ^ 2 + ((CDbl(g) - avg(i, 1)) / (qvar(i, 1) + 0.1)) ^ 2 + ((CDbl(b) - avg(i, 0)) / (qvar(i, 0) + 0.1)) ^ 2
Next i
det = 0
Vall = dist(0)
For i = 1 To 5
If dist(i) < Vall Then
det = i
Vall = dist(i)
End If
Next i
If Option1(det).Value = True Then
Picture1.PSet (x, y), RGB(0, 0, 0)
Else
Picture1.PSet (x, y), RGB(255, 255, 255)
End If
Next y
ProgressBar1.Value = x / 8
Next x
Picture1.AutoRedraw = True
End Sub

Private Sub Command4_Click()
Picture1.Refresh
End Sub

Private Sub Form_Load()
For i = 0 To 5
For j = 0 To 2
avg(i, j) = 0
qvar(i, j) = 0
sumx(i, j) = 0
sumxx(i, j) = 0
Next j
nx(i) = 0
Next i
End Sub

Private Sub Text1_Click(Index As Integer)
Text2.Text = Index
For j = 0 To 2
avg(Index, j) = 0
qvar(Index, j) = 0
sumx(Index, j) = 0
sumxx(Index, j) = 0
Next j
nx(Index) = 0
Text1(Index).BackColor = RGB(avg(Index, 2), avg(Index, 1), avg(Index, 0))
Text1(Index).Text = qvar(Index, 2) + qvar(Index, 1) + qvar(Index, 0)
End Sub

Private Sub Picture1_MouseDown(button As Integer, shift As Integer, px As Single, py As Single)
opr = CLng(Text2.Text)
colr = Picture1.Point(px, py)
r = colr Mod 256
g = Fix(colr / 256) Mod 256
b = Fix(colr / 65536) Mod 256
nx(opr) = nx(opr) + 1
sumx(opr, 0) = sumx(opr, 0) + b
sumx(opr, 1) = sumx(opr, 1) + g
sumx(opr, 2) = sumx(opr, 2) + r
sumxx(opr, 0) = sumxx(opr, 0) + b * b
sumxx(opr, 1) = sumxx(opr, 1) + g * g
sumxx(opr, 2) = sumxx(opr, 2) + r * r
avg(opr, 0) = sumx(opr, 0) / nx(opr)
avg(opr, 1) = sumx(opr, 1) / nx(opr)
avg(opr, 2) = sumx(opr, 2) / nx(opr)
qvar(opr, 0) = Sqr(sumxx(opr, 0) / nx(opr) - (sumx(opr, 0) / nx(opr)) ^ 2)
qvar(opr, 1) = Sqr(sumxx(opr, 1) / nx(opr) - (sumx(opr, 1) / nx(opr)) ^ 2)
qvar(opr, 2) = Sqr(sumxx(opr, 2) / nx(opr) - (sumx(opr, 2) / nx(opr)) ^ 2)
Text1(opr).BackColor = RGB(avg(opr, 2), avg(opr, 1), avg(opr, 0))
Text1(opr).Text = qvar(opr, 2) + qvar(opr, 1) + qvar(opr, 0)
End Sub