实例介绍
【实例截图】
该项目主要包含以下文件:
Form1.frm
Form1.frx
Form1.log
Form2.frm
Form3.frm
Form4.frm
Form5.frm
frmAbout.frm
frmAbout.frx
frmSplash.frm
frmSplash.frx
MSCHRT20.oca*
MSCHRT20.OCX*
MSCHRT207w01.dll
MSSCCPRJ.SCC
Project1.vbp
Project1.vbw
【核心代码】
Private Type BITMAPFILEHEADER '14 bytes
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
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
小贴士
感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明


网友评论
我要评论