📄 frmmain.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmMain
Caption = "VB编写的字模拾取软件"
ClientHeight = 7425
ClientLeft = 60
ClientTop = 345
ClientWidth = 8340
LinkTopic = "Form1"
ScaleHeight = 7425
ScaleWidth = 8340
StartUpPosition = 1 '所有者中心
Begin VB.PictureBox Picture1
Height = 555
Left = 960
Picture = "frmMain.frx":0000
ScaleHeight = 495
ScaleWidth = 495
TabIndex = 16
Top = 4380
Width = 555
End
Begin VB.TextBox txtInfo
Height = 2025
Left = 90
MultiLine = -1 'True
TabIndex = 7
Text = "frmMain.frx":03B9
Top = 5250
Width = 8205
End
Begin VB.Frame Frame3
Caption = "控制"
Height = 1905
Left = 3870
TabIndex = 3
Top = 3270
Width = 4395
Begin VB.CommandButton cmdGetCode
BackColor = &H000080FF&
Caption = "取模"
Height = 435
Left = 2940
Style = 1 'Graphical
TabIndex = 14
Top = 810
Width = 1035
End
Begin VB.Frame Frame4
Caption = "放大"
Height = 1185
Left = 330
TabIndex = 9
Top = 390
Width = 1815
Begin VB.TextBox txtZoom
Height = 285
Left = 900
TabIndex = 12
Text = "100"
Top = 540
Width = 705
End
Begin VB.CommandButton cmdAdd
Caption = "+"
Height = 315
Left = 180
TabIndex = 11
Top = 330
Width = 555
End
Begin VB.CommandButton cmdSub
Caption = "-"
Height = 315
Left = 180
TabIndex = 10
Top = 720
Width = 555
End
End
End
Begin VB.Frame Frame2
Caption = "图片模"
Height = 1485
Left = 3900
TabIndex = 2
Top = 1710
Width = 4365
Begin VB.CommandButton cmdPickImage
Caption = "查找图片"
Height = 555
Left = 240
TabIndex = 8
Top = 510
Width = 975
End
End
Begin VB.Frame Frame1
Caption = "汉字模"
Height = 1545
Left = 3900
TabIndex = 1
Top = 90
Width = 4365
Begin MSComDlg.CommonDialog cDg
Left = 3360
Top = 1020
_ExtentX = 847
_ExtentY = 847
_Version = 393216
FontName = "system"
FontSize = 0
End
Begin VB.CommandButton cmdFont
Caption = "字体"
Height = 495
Left = 3120
TabIndex = 6
Top = 390
Width = 825
End
Begin VB.TextBox txtHz
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1470
MaxLength = 1
TabIndex = 4
Text = "汉"
Top = 360
Width = 1365
End
Begin VB.Label Label2
Caption = "输入汉字"
Height = 255
Left = 510
TabIndex = 5
Top = 540
Width = 795
End
End
Begin VB.PictureBox Pic
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Height = 3945
Left = 60
ScaleHeight = 3885
ScaleWidth = 3585
TabIndex = 0
Top = 150
Width = 3645
Begin VB.PictureBox PicX
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Height = 1365
Left = 2100
ScaleHeight = 1305
ScaleWidth = 1365
TabIndex = 13
Top = 2130
Visible = 0 'False
Width = 1425
End
End
Begin VB.Label Label1
Caption = "字模取值方向"
Height = 525
Left = 150
TabIndex = 15
Top = 4380
Width = 645
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fZoom As Double
Dim fFixZoom As Double
Private Sub cmdAdd_Click()
Pic.Cls
fZoom = fZoom * 1.1
txtZoom.Text = Str(fZoom * 100)
Pic.PaintPicture PicX.Image, 0, 0, Pic.Width * fFixZoom * fZoom, Pic.Height * fFixZoom * fZoom
End Sub
Private Sub cmdSub_Click()
Pic.Cls
fZoom = fZoom * 0.9
txtZoom.Text = Str(fZoom * 100)
Pic.PaintPicture PicX.Image, 0, 0, Pic.Width * fFixZoom * fZoom, Pic.Height * fFixZoom * fZoom
End Sub
Private Sub cmdGetCode_Click()
GetFont 1
End Sub
Private Sub cmdPickImage_Click()
cDg.Filter = "*.bmp|*.bmp"
cDg.ShowOpen
If cDg.FileName = "" Then
Exit Sub
End If
Set PicX.Picture = LoadPicture(cDg.FileName)
Pic.PaintPicture PicX.Image, 0, 0, Pic.Width * fFixZoom * fZoom, Pic.Height * fFixZoom * fZoom
End Sub
Private Sub cmdFont_Click()
cDg.FontName = Pic.FontName
cDg.Flags = cdlCFEffects Or cdlCFBoth
cDg.ShowFont
If cDg.FontSize = 0 Then Exit Sub
PicX.FontName = cDg.FontName
PicX.FontBold = cDg.FontBold
PicX.FontSize = cDg.FontSize
PicX.FontItalic = cDg.FontItalic
PicX.Cls
PicX.Print txtHz.Text
Pic.PaintPicture PicX.Image, 0, 0, Pic.Width * fFixZoom * fZoom, Pic.Height * fFixZoom * fZoom
End Sub
Private Sub Form_Load()
fZoom = 1#
fFixZoom = 3#
Pic.FontSize = 172
Pic.Print txtHz.Text
End Sub
Private Sub GetFont(dir As Integer)
Dim i As Long
Dim j As Long
Dim st As Long
Dim c As Long
Dim cnt As Long
Dim bt As Integer
Dim t As Integer
Dim retCnt As Long
Dim s As String
st = Pic.Width \ 16
t = 1
retCnt = 0
bt = 0
txtInfo.Text = ""
cnt = 1
For i = 0 To 15
For j = 0 To 15
If isPixelExist(i * st, j * st, st) Then
bt = bt Or t
End If
t = t * 2
If (cnt = 8) Then
cnt = 0
t = 1
s = Hex(bt)
If (Len(s) = 1) Then s = "0" + s
s = "0" + s
If retCnt Mod 8 = 0 Then
txtInfo.Text = txtInfo.Text + vbCrLf + "DB "
txtInfo.Text = txtInfo.Text + s + "H"
Else
txtInfo.Text = txtInfo.Text + Chr(44) + s + "H"
End If
retCnt = retCnt + 1
bt = 0
End If
cnt = cnt + 1
Next j
Next i
End Sub
Private Function isPixelExist(x As Long, y As Long, rr As Long) As Boolean
Dim i As Long
Dim j As Long
Dim sum As Long
Dim c As Long
Dim area As Long
Dim r As Long
Dim g As Long
Dim b As Long
sum = 0
area = 0
For i = 0 To rr Step Screen.TwipsPerPixelX
For j = 0 To rr Step Screen.TwipsPerPixelY
c = Pic.Point(i + x, j + y)
r = c And &HFF
c = c \ 256
g = c And &HFF
c = c \ 256
b = c And &HFF
c = r + g + b '得到图像的灰度
c = c / 3
sum = sum + c
area = area + 1
Next
Next
c = sum \ area '得到平均灰度
If c < 200 Then '小于该设定平均灰度的返回真,表示一个亮点
isPixelExist = True
Else
isPixelExist = False
End If
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -