📄 custom.frm
字号:
VERSION 5.00
Begin VB.Form Form3
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "过滤器"
ClientHeight = 2010
ClientLeft = 4095
ClientTop = 3660
ClientWidth = 3600
LinkTopic = "Form3"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2010
ScaleWidth = 3600
Begin VB.Frame Frame3
Height = 735
Left = 1800
TabIndex = 12
Top = 960
Width = 1575
Begin VB.CommandButton WCan
Caption = "取消"
Height = 375
Left = 840
TabIndex = 14
Top = 240
Width = 615
End
Begin VB.CommandButton WProcess1
Caption = "处理"
Enabled = 0 'False
Height = 375
Left = 120
TabIndex = 13
Top = 240
Width = 615
End
End
Begin VB.Frame Frame1
Caption = "过滤核"
Height = 1455
Left = 240
TabIndex = 11
Top = 240
Width = 1335
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Index = 8
Left = 840
MaxLength = 1
TabIndex = 9
Top = 960
Width = 375
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 = 390
Index = 7
Left = 480
MaxLength = 1
TabIndex = 8
Top = 960
Width = 375
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 = 390
Index = 6
Left = 120
MaxLength = 1
TabIndex = 7
Top = 960
Width = 375
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 = 390
Index = 5
Left = 840
MaxLength = 1
TabIndex = 6
Top = 600
Width = 375
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 = 390
Index = 4
Left = 480
MaxLength = 1
TabIndex = 5
Top = 600
Width = 375
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 = 390
Index = 3
Left = 120
MaxLength = 1
TabIndex = 4
Top = 600
Width = 375
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 = 390
Index = 2
Left = 840
MaxLength = 1
TabIndex = 3
Top = 240
Width = 375
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 = 390
Index = 1
Left = 480
MaxLength = 1
TabIndex = 2
Top = 240
Width = 375
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 = 390
Index = 0
Left = 120
MaxLength = 1
TabIndex = 1
Top = 240
Width = 375
End
End
Begin VB.Frame Frame2
Caption = "增亮值"
Height = 615
Left = 1800
TabIndex = 0
Top = 240
Width = 1575
Begin VB.TextBox Text2
Height = 270
Left = 120
MaxLength = 3
TabIndex = 10
Top = 240
Width = 1335
End
End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public WLightInc As Integer 'Form3的增亮值
Dim WCustomFilter(8) As Integer 'Form3的Filter
Private Sub Text1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
If (KeyCode = 109) Then '如果键为“-”则长度为二
Text1(Index).MaxLength = 2
Exit Sub
End If
'如果键不为数字和不为回车则...
If ((KeyCode < 48) Or (KeyCode > 57)) And (KeyCode <> 13) Then
Text1(Index).Text = ""
Text1(Index).MaxLength = 1
Text1(Index).SetFocus
Exit Sub
End If
'如果为回车则...
If (KeyCode = 13) Then
If Text1(Index).Text = "-" Then '如果只键入”-“后回车则...
Text1(Index).Text = ""
Text1(Index).MaxLength = 1
Text1(Index).SetFocus
Exit Sub
End If
WCustomFilter(Index) = Val(Text1(Index).Text)
If (Index + 1) = 9 Then
Text2.SetFocus
Else
Text1(Index + 1).SetFocus
End If
End If
End Sub
Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
If ((KeyCode < 48) Or (KeyCode > 57)) And (KeyCode <> 13) Then
Text2.Text = ""
Text2.SetFocus
Exit Sub
End If
If KeyCode = 13 Then
If Val(Text2.Text) > 128 Then
MsgBox "请输入小于己于128的数字", vbExclamation, "提示"
Text2.Text = ""
Text2.SetFocus
Exit Sub
End If
WLightInc = Val(Text2.Text)
Text1(0).SetFocus
WProcess1.Enabled = True
End If
End Sub
Private Sub WCan_Click()
Dim I As Integer
For I = 0 To 8
WCustomFilter(I) = 0
Text1(I).Text = ""
Next I
WLightInc = 0
Text2.Text = ""
WProcess1.Enabled = False
Text1(0).SetFocus
End Sub
Private Sub WProcess1_Click()
Dim RSum As Integer, GSum As Integer, BSum As Integer
Dim R As Integer, G As Integer, B As Integer
Dim Fi As Integer, Fj As Integer
Dim I As Integer, J As Integer
Dim WSBmp As Long
Dim WSBmpDc As Long
Dim WFilterTemp(2, 2) As Integer
For I = 0 To 2
For J = 0 To 2
WFilterTemp(I, J) = WCustomFilter(I * 2 + J)
Next J
Next I
Form3.Hide
Screen.MousePointer = 11 '显示鼠标为漏斗状
Form2.ProgressBar1.Min = 0 '进度条的情况
Form2.ProgressBar1.Max = Form1.WIPicture1.ScaleWidth
Form2.Caption = "定制处理..."
Form2.Show
Form1.Enabled = False
Form2.ProgressBar1.Value = Form2.ProgressBar1.Min '进度条的情况
N = 0 '进度条初值
WSBmp = CreateCompatibleBitmap(Form1.WIPicture2.hdc, Form1.WIPicture2.ScaleWidth, Form1.WIPicture2.ScaleHeight)
WSBmpDc = CreateCompatibleDC(Form1.WIPicture2.hdc)
SelectObject WSBmpDc, WSBmp
BitBlt WSBmpDc, 0, 0, Form1.WIPicture2.ScaleWidth, Form1.WIPicture2.ScaleHeight, Form1.WIPicture2.hdc, 0, 0, &HCC0020
For I = 1 To (Form1.WIPicture1.ScaleWidth - 2) 'www
For J = 1 To (Form1.WIPicture1.ScaleHeight - 2)
RSum = 0: GSum = 0: BSum = 0
For Fi = -1 To 1
For Fj = -1 To 1
RSum = RSum + WImage(0, I + Fi, J + Fj) * WFilterTemp(Fi + 1, Fj + 1)
GSum = GSum + WImage(1, I + Fi, J + Fj) * WFilterTemp(Fi + 1, Fj + 1)
BSum = BSum + WImage(2, I + Fi, J + Fj) * WFilterTemp(Fi + 1, Fj + 1)
Next Fj
Next Fi
R = Abs(RSum / 9 + WLightInc)
G = Abs(GSum / 9 + WLightInc)
B = Abs(BSum / 9 + WLightInc)
SetPixel WSBmpDc, I, J, RGB(R, G, B)
Next J
N = N + 1
Form2.ProgressBar1.Value = N
DoEvents
Next I
BitBlt Form1.WIPicture2.hdc, 1, 1, Form1.WIPicture2.ScaleWidth - 2, Form1.WIPicture2.ScaleHeight - 2, WSBmpDc, 0, 0, &HCC0020
Form2.Hide
Form1.Enabled = True
Screen.MousePointer = 0 '鼠标恢复正常
'显示目的图像
DestX = 0: DestY = 0
Form1.WDHScrol.Value = 0: Form1.WDVScrol.Value = 0
Call DisplayPicture2(Form1.WDPicture, Form1.WIPicture2, Form1.WDHScrol, Form1.WDVScrol, Form1)
Form1.SetFocus '设FORM1为焦点
Call DeleteDC(WSBmpDc)
Call DeleteObject(WSBmp)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -