?? 圖象處理.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 + -