📄 formsmoothdemo.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmmain
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "对24位真彩色图像加柔"
ClientHeight = 4080
ClientLeft = 60
ClientTop = 672
ClientWidth = 5868
LinkTopic = "Form1"
NegotiateMenus = 0 'False
ScaleHeight = 340
ScaleMode = 3 'Pixel
ScaleWidth = 489
ShowInTaskbar = 0 'False
Begin VB.PictureBox Picture2
AutoRedraw = -1 'True
AutoSize = -1 'True
FillColor = &H00000040&
FontTransparent = 0 'False
ForeColor = &H00FFFFFF&
Height = 3012
Left = 120
ScaleHeight = 247
ScaleMode = 3 'Pixel
ScaleWidth = 197
TabIndex = 3
Top = 480
Width = 2412
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
FillStyle = 0 'Solid
Height = 3012
Left = 3240
Negotiate = -1 'True
ScaleHeight = 247
ScaleMode = 3 'Pixel
ScaleWidth = 197
TabIndex = 2
Top = 480
Width = 2412
End
Begin MSComDlg.CommonDialog CommonDialog2
Left = 12000
Top = 8880
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DefaultExt = "bmp"
DialogTitle = "保存处理后的图像文件"
Filter = " ""Pictures (*.bmp;*.gif)|*.bmp;*.gif"""
InitDir = "d:\"
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5640
Top = 9240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DialogTitle = "请选择要打开的图像文件名子"
Flags = 1
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 372
Left = 1200
TabIndex = 0
Top = 3600
Width = 3816
_ExtentX = 6731
_ExtentY = 656
_Version = 393216
BorderStyle = 1
Appearance = 1
End
Begin VB.Label Label2
Caption = "原 图"
Height = 492
Left = 1080
TabIndex = 4
Top = 240
Width = 1212
End
Begin VB.Label Label1
Caption = "柔 化 图"
Height = 372
Left = 3960
TabIndex = 1
Top = 240
Width = 1692
End
Begin VB.Menu file
Caption = "文件(&F)"
WindowList = -1 'True
Begin VB.Menu open
Caption = "打开文件"
Shortcut = ^O
End
Begin VB.Menu save
Caption = "保存文件"
Shortcut = ^S
End
Begin VB.Menu mseperate
Caption = "-"
End
Begin VB.Menu exit
Caption = "退出系统"
Shortcut = ^X
End
End
Begin VB.Menu effect
Caption = "效果处理(&E)"
Visible = 0 'False
Begin VB.Menu m_frame
Caption = "加入像框"
End
Begin VB.Menu xxx
Caption = "-"
End
Begin VB.Menu character_extract
Caption = "特征提取"
Shortcut = ^B
End
Begin VB.Menu c
Caption = "-"
End
Begin VB.Menu smooth
Caption = "图像柔化"
Begin VB.Menu common_smooth
Caption = "1/9柔化"
Shortcut = {F1}
End
Begin VB.Menu smooth10
Caption = "1/10柔化"
End
Begin VB.Menu smooth16
Caption = "1/16柔化(高斯柔化)"
End
Begin VB.Menu smooth8
Caption = "1/8柔化"
End
Begin VB.Menu smooth2
Caption = "1/2柔化"
End
Begin VB.Menu smooth_more
Caption = "自定义柔化"
Shortcut = {F2}
End
End
Begin VB.Menu jjj
Caption = "-"
End
Begin VB.Menu sharp
Caption = "图像锐化"
Begin VB.Menu common_sharp
Caption = "H0锐化"
Shortcut = {F3}
End
Begin VB.Menu h1sharp
Caption = "H1锐化"
End
Begin VB.Menu h2sharp
Caption = "H2锐化(lpls锐化)"
End
Begin VB.Menu h3sharp
Caption = "H3锐化"
End
Begin VB.Menu h4sharp
Caption = "H4锐化"
End
Begin VB.Menu sobelsharp
Caption = "sobel锐化"
End
Begin VB.Menu prewittsharp
Caption = "Prewitt锐化"
End
Begin VB.Menu isotropicsharp
Caption = "Isotropic锐化"
End
Begin VB.Menu kirschsharp
Caption = "Kirsch锐化"
End
Begin VB.Menu wallissharp
Caption = "wallis锐化"
End
Begin VB.Menu f
Caption = "-"
End
Begin VB.Menu sharp_more
Caption = "自定义锐化"
Shortcut = {F4}
End
End
Begin VB.Menu ll
Caption = "-"
End
Begin VB.Menu inverse
Caption = "图像反色"
Shortcut = ^I
End
Begin VB.Menu g
Caption = "-"
Index = 3
End
Begin VB.Menu m_strech
Caption = "缩放图象"
End
Begin VB.Menu www
Caption = "-"
End
Begin VB.Menu emboss
Caption = "浮雕效果"
Shortcut = ^E
End
Begin VB.Menu h
Caption = "-"
End
Begin VB.Menu diffuse
Caption = "图像扩散"
Shortcut = ^D
End
Begin VB.Menu i
Caption = "-"
End
Begin VB.Menu customize
Caption = "定制处理"
Enabled = 0 'False
Shortcut = ^C
End
Begin VB.Menu pp
Caption = "-"
End
Begin VB.Menu undo
Caption = "图像恢复"
Shortcut = ^U
End
Begin VB.Menu m
Caption = "-"
End
Begin VB.Menu grayscale
Caption = "灰度图像"
End
Begin VB.Menu colorfulimage
Caption = "彩色图像"
Enabled = 0 'False
End
End
Begin VB.Menu move
Caption = "图像移动(&M)"
Visible = 0 'False
Begin VB.Menu translation
Caption = "图像平移"
Shortcut = ^M
End
Begin VB.Menu o
Caption = "-"
End
Begin VB.Menu rotate
Caption = "图像旋转"
Enabled = 0 'False
Shortcut = ^R
End
End
Begin VB.Menu mirror
Caption = "镜像"
Visible = 0 'False
Begin VB.Menu mhorizon
Caption = "水平镜像"
End
Begin VB.Menu vv
Caption = "-"
End
Begin VB.Menu mvertical
Caption = "垂直镜像"
End
End
Begin VB.Menu depth
Caption = "提取部分图像"
Visible = 0 'False
Begin VB.Menu partimage
Caption = "截取有效部分"
End
End
Begin VB.Menu mprocess
Caption = "特殊处理"
Visible = 0 'False
Begin VB.Menu mgetpoint
Caption = "输入采样点"
End
Begin VB.Menu a
Caption = "-"
End
Begin VB.Menu mgetoutline
Caption = "轮廓提取"
End
Begin VB.Menu p
Caption = "-"
End
Begin VB.Menu medge_trace
Caption = "轮廓跟踪"
End
Begin VB.Menu mrecgonize
Caption = "缺陷识别"
End
Begin VB.Menu e
Caption = "-"
End
Begin VB.Menu msame_color
Caption = "图像分割"
End
Begin VB.Menu dfa
Caption = "-"
End
Begin VB.Menu mshade
Caption = "投影"
Begin VB.Menu mver_shade
Caption = "竖直投影"
End
Begin VB.Menu fddd
Caption = "-"
End
Begin VB.Menu mhori_shade
Caption = "水平投影"
End
End
End
Begin VB.Menu manalysis
Caption = "图像效果"
Begin VB.Menu msmoothit
Caption = "柔化"
End
Begin VB.Menu mclipping
Caption = "削波"
Visible = 0 'False
End
Begin VB.Menu mgray_window
Caption = "灰度窗口"
Visible = 0 'False
End
Begin VB.Menu mbinary_image
Caption = "阀值化"
Visible = 0 'False
End
Begin VB.Menu mhistogram
Caption = "直方图均衡"
Visible = 0 'False
End
End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim imagepixels(2, 1024, 1024) As Integer '用来存储读入的图像数据
Dim x, y As Integer '用来记录图像的宽度和高度
Dim picturename, picture_savename As String
Private Sub open_Click()
Dim i As Integer, j As Integer
Dim red As Long, green As Long, blue As Long
Dim pixel As Long ' 设置“CancelError”为 True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler ' 设置标志
CommonDialog1.Flags = cdlOFNHideReadOnly ' 设置过滤器
CommonDialog1.Filter = "All Files (*.*)|*.*|Text Files" & _
"(*.txt)|*.txt|pictures(*.gif)|*.gif|pictures(*.bmp)|*.bmp" ' 指定缺省的过滤器
CommonDialog1.FilterIndex = 4 ' 显示“打开”对话框
CommonDialog1.ShowOpen ' 显示选定文件的名字
picturename = CommonDialog1.FileName
If picturename = "" Then Exit Sub
Picture1.Picture = LoadPicture(picturename)
Picture2.Picture = Picture1.Picture
Picture1.Refresh
Picture2.Refresh
Picture1.ScaleMode = vbPixels
Picture1.AutoSize = True
x = Picture1.ScaleWidth
y = Picture1.ScaleHeight
If x > 1024 Or y > 1024 Then
MsgBox "图片大,请选小图片"
x = 0
y = 0
Exit Sub
End If '限制处理图片的大小
frmmain.Visible = False
For i = 0 To y - 1
For j = 0 To x - 1
pixel& = frmmain.Picture1.Point(j, i)
red = pixel& Mod 256
green = ((pixel& And &HFF00) / 256&) Mod 256&
blue = (pixel& And &HFF0000) / 65536
imagepixels(0, j, i) = red
imagepixels(1, j, i) = green
imagepixels(2, j, i) = blue
Next
Next
frmmain.Visible = True
frmmain.Show
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub
Private Sub msmoothit_Click() '对彩色图像进行加柔
Dim i As Integer, j As Integer
Dim dx As Integer, dy As Integer
Dim red As Long, green As Long, blue As Long
Dim gray
Dim YofImg, UofImg, VofImg, redr, greeng, blueb '记录需削波的象素点的yuv值。
If Picture1.Picture = 0 Then
MsgBox ("please choose an image,firstly")
Exit Sub
End If
ProgressBar1.Visible = True
For i = 1 To y - 1
For j = 1 To x - 1
red = (imagepixels(0, j - 1, i - 1) + imagepixels(0, j - 1, i) + imagepixels(0, j - 1, i + 1) + imagepixels(0, j, i - 1) + imagepixels(0, j, i) + imagepixels(0, j, i + 1) + imagepixels(0, j + 1, i - 1) + imagepixels(0, j + 1, i) + imagepixels(0, j + 1, i + 1)) / 9
green = (imagepixels(1, j - 1, i - 1) + imagepixels(1, j - 1, i) + imagepixels(1, j - 1, i + 1) + imagepixels(1, j, i - 1) + imagepixels(1, j, i) + imagepixels(1, j, i + 1) + imagepixels(1, j + 1, i - 1) + imagepixels(1, j + 1, i) + imagepixels(1, j + 1, i + 1)) / 9
blue = (imagepixels(2, j - 1, i - 1) + imagepixels(2, j - 1, i) + imagepixels(2, j - 1, i + 1) + imagepixels(2, j, i - 1) + imagepixels(2, j, i) + imagepixels(2, j, i + 1) + imagepixels(2, j + 1, i - 1) + imagepixels(2, j + 1, i) + imagepixels(2, j + 1, i + 1)) / 9
Picture1.PSet (j, i), RGB(red, green, blue)
Next
Picture1.Refresh
ProgressBar1.Value = i * 100& / (y - 1)
DoEvents
Next
MsgBox ("图像已经被加柔!")
frmmain.ProgressBar1.Visible = False
End Sub
Private Sub save_Click()
' 初始化“CancelError”为 True
CommonDialog2.CancelError = True
On Error GoTo ErrHandler ' 设置标志
CommonDialog2.Flags = cdlOFNHideReadOnly ' 设置过滤器
CommonDialog2.Filter = "All Files (*.*)|*.*|Text Files" & _
"(*.txt)|*.txt|pictures(*.gif)|*.gif|pictures(*.bmp)|*.bmp" ' 指定缺省的过滤器
CommonDialog2.FilterIndex = 4 ' 显示“打开”对话框
CommonDialog2.ShowSave ' 显示选定文件的名字
picture_savename = CommonDialog2.FileName
SavePicture Picture1.Image, picture_savename
ErrHandler: ' 用户按了“取消”按钮
Exit Sub
End Sub
Private Sub exit_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -