📄 图象处理.frm
字号:
VERSION 5.00
Begin VB.Form frmmain
BorderStyle = 3 'Fixed Dialog
Caption = "图象处理"
ClientHeight = 10320
ClientLeft = 45
ClientTop = 450
ClientWidth = 14955
Icon = "图象处理.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 10320
ScaleWidth = 14955
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton CmdCut
Caption = "图象分割"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 3480
TabIndex = 13
Top = 6720
Width = 1335
End
Begin VB.CommandButton Cmdlvbo
Caption = "滤 波"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5880
TabIndex = 12
Top = 6720
Width = 1695
End
Begin VB.PictureBox Picture3
AutoSize = -1 'True
Height = 5535
Left = 10080
ScaleHeight = 5475
ScaleWidth = 4995
TabIndex = 11
Top = 0
Width = 5055
End
Begin VB.PictureBox Picture1
AutoSize = -1 'True
Height = 5535
Left = 2880
ScaleHeight = 5475
ScaleWidth = 5355
TabIndex = 10
Top = 0
Width = 5415
End
Begin VB.PictureBox Picture2
Height = 3615
Left = 8160
ScaleHeight = 3555
ScaleWidth = 6555
TabIndex = 7
Top = 5760
Width = 6615
End
Begin VB.FileListBox File1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2730
Left = 120
MousePointer = 99 'Custom
TabIndex = 5
Top = 2520
Width = 2775
End
Begin VB.DirListBox Dir1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1980
Left = 120
MousePointer = 99 'Custom
TabIndex = 4
Top = 480
Width = 2775
End
Begin VB.DriveListBox Drive1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 120
MousePointer = 99 'Custom
TabIndex = 3
Top = 120
Width = 2775
End
Begin VB.CommandButton Command2
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3600
TabIndex = 2
Top = 8400
Width = 1695
End
Begin VB.CommandButton Command1
Caption = "打开"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1200
TabIndex = 1
Top = 8400
Width = 1695
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1800
TabIndex = 0
Top = 7560
Width = 6255
End
Begin VB.Label Label3
Caption = "点击图象获取直方图"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 4200
TabIndex = 9
Top = 5760
Width = 4455
End
Begin VB.Label Label2
Caption = "直 方 图"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 375
Left = 13440
TabIndex = 8
Top = 6960
Width = 4215
End
Begin VB.Label Label1
Caption = "图片路径为："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 480
TabIndex = 6
Top = 7680
Width = 3015
End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
i = Dir(Text1.Text)
If i <> "" Then
Picture1.Picture = LoadPicture(Text1.Text)
Else
MsgBox "找不到图片！"
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub CmdCut_Click()
Dim R As Integer
Dim G As Integer
Dim B As Integer '定义R，G，B用来存放RGB值
Dim xx As Integer
Dim yy As Integer '定义2个值用来定义扫描长宽
Dim x As Integer
Dim y As Integer '定义2个值用来进行FOR循环
Dim gr As Integer '用来做灰度临时变量
Dim grayarray(1000, 1000) As Integer '用数组来存放象素值
Dim gray(1000, 1000) As Integer '用数组来存放改变后的象素值
Dim change As Integer
xx = Picture1.ScaleWidth
yy = Picture1.ScaleHeight
Picture3.ScaleWidth = xx
Picture3.ScaleHeight = yy
For x = 1 To 1000
For y = 1 To 1000
grayarray(x, y) = 0
gray(x, y) = 0
Next
Next '数组初始化
For x = 1 To yy
For y = 1 To xx '对图象进行遍历
pi& = Picture1.Point(x, y) '获取像素值
R = pi& Mod 256
G = ((pi& And &HFF00) / 256&) Mod 256&
B = (pi1& And &HFF0000) / 65536
gr = R * 3 + G * 6 + B '转化为RGB值
gr = gr / 10 '转化为灰度值
If gr > 255 Then gr = 255
If gr < 0 Then gr = 0 '如果灰度出界，则赋于一个合理的数
grayarray(x, y) = gr '将值赋给数组
Next
Next
For x = 2 To yy
For y = 2 To xx '对数组进行遍历
If (grayarray(x, y) < 20) Then
gray(x, y) = 255
Else
If (grayarray(x, y + 10) < 20) Then
gray(x, y) = 255
Else
gray(x, y) = grayarray(x, y)
Exit For
End If
End If
Next
Next
For x = 2 To yy
For y = 2 To xx
Picture3.PSet (x, y), RGB(gray(x, y), gray(x, y), gray(x, y))
Next
Next
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
On Error Resume Next
Text1.Text = Dir1.Path + "\" + File1.FileName
i = Dir(Text1.Text)
If i <> "" Then
Picture1.Picture = LoadPicture(Text1.Text)
Else
MsgBox "找不到图片！"
End If
End Sub
Private Sub Form_Load()
frmmain.AutoRedraw = True
frmmain.ScaleMode = 3
Picture1.AutoRedraw = True
Picture1.ScaleMode = 3
Picture3.AutoRedraw = True
Picture3.ScaleMode = 3
Text1.Text = "f:\图片\电影截取\04[(013779)14-05-15].JPG"
End Sub
Private Sub Picture1_Click()
Dim R As Byte
Dim G As Byte
Dim B As Byte
Dim gray As Integer
Dim x As Integer
Dim y As Integer
Dim colorcount(255) As Double
Dim ColRatio(255) As Single
Picture2.Cls
Picture2.Scale (0, 0)-(20, 20)
For i = 1 To 19 '在picture2上画图表
Picture2.Line (0, i)-(19, i)
Picture2.Line (i, 0)-(i, 19)
Next
For x = 0 To 255 '先把数组清零
colorcount(x) = 0
Next
xx = Picture1.ScaleWidth
yy = Picture1.ScaleHeight
Print xx, yy
For x = 1 To xx - 2
For y = 1 To yy - 2
pi& = Picture1.Point(x, y) '获取像素值
R = pi& Mod 256
G = ((pi& And &HFF00) / 256&) Mod 256&
B = (pi1& And &HFF0000) / 65536
gray = R * 3 + G * 6 + B
gray = gray / 10 '转化为灰度值
'Gray = (R + G + B) / 3
colorcount(gray) = colorcount(gray) + 1 '相应数组加1
Next
Next
Picture2.Scale (0, 0)-(255, 2000)
For x = 1 To 255
Picture2.Line (x, 2000)-(x, colorcount(x))
Next
End Sub
Private Sub Cmdlvbo_Click()
Dim R As Integer
Dim G As Integer
Dim B As Integer
Dim xx As Integer
Dim yy As Integer
Dim x As Integer
Dim y As Integer
Dim gr As Integer
Dim grayarray(1000, 1000) As Integer
Dim gray(1000, 1000) As Integer
Dim temp(8) As Integer
Dim change As Integer
xx = Picture1.ScaleWidth
yy = Picture1.ScaleHeight
Picture3.ScaleWidth = xx
Picture3.ScaleHeight = yy
For x = 1 To 1000
For y = 1 To 1000
grayarray(x, y) = 0
gray(x, y) = 0
Next
Next
Print xx, yy
For x = 1 To yy
For y = 1 To xx
pi& = Picture1.Point(x, y) '获取像素值
R = pi& Mod 256
G = ((pi& And &HFF00) / 256&) Mod 256&
B = (pi1& And &HFF0000) / 65536
gr = R * 3 + G * 6 + B
gr = gr / 10 '转化为灰度值
If gr > 255 Then gr = 255
If gr < 0 Then gr = 0
grayarray(x, y) = gr
Next
Next
For x = 2 To yy
For y = 2 To xx
temp(0) = grayarray(x - 1, y + 1): temp(1) = grayarray(x, y + 1): temp(2) = grayarray(x + 1, y + 1)
temp(3) = grayarray(x - 1, y): temp(4) = grayarray(x, y): temp(5) = grayarray(x + 1, y)
temp(6) = grayarray(x - 1, y - 1): temp(7) = grayarray(x, y - 1): temp(8) = grayarray(x + 1, y - 1)
For j = 0 To 7
For i = 0 To j
If temp(i) > temp(i + 1) Then
change = temp(i + 1)
temp(i + 1) = temp(i)
temp(i) = change
End If
Next
Next
gray(x, y) = temp(4)
Next
Next
For x = 2 To yy
For y = 2 To xx
Picture3.PSet (x, y), RGB(gray(x, y), gray(x, y), gray(x, y))
Next
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -