📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "LED显示屏字模发生器"
ClientHeight = 4725
ClientLeft = 60
ClientTop = 375
ClientWidth = 9375
FillColor = &H00800000&
Icon = "Form1.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 315
ScaleMode = 3 'Pixel
ScaleWidth = 625
StartUpPosition = 2 '屏幕中心
Begin VB.OptionButton Option3
Caption = "16*32"
Height = 375
Left = 13680
TabIndex = 20
Top = 120
UseMaskColor = -1 'True
Value = -1 'True
Width = 1185
End
Begin VB.TextBox Text4
Appearance = 0 'Flat
Height = 1980
Left = 9645
MultiLine = -1 'True
TabIndex = 14
Top = 2220
Width = 5010
End
Begin VB.OptionButton Option1
Caption = "16*16"
Height = 300
Left = 10755
MaskColor = &H8000000F&
TabIndex = 11
Top = 135
UseMaskColor = -1 'True
Width = 1185
End
Begin VB.OptionButton Option2
Caption = "8*8"
Height = 300
Left = 12240
MaskColor = &H8000000F&
TabIndex = 10
Top = 135
UseMaskColor = -1 'True
Width = 1185
End
Begin VB.CommandButton ComFont
Caption = "字体"
Height = 345
Left = 12375
TabIndex = 7
Top = 570
Width = 945
End
Begin VB.TextBox Text3
Height = 375
Left = 10785
TabIndex = 6
Text = "60"
Top = 1132
Width = 990
End
Begin VB.CommandButton ComGet
Caption = "生成"
Height = 345
Left = 12375
TabIndex = 5
Top = 1695
Width = 945
End
Begin VB.TextBox Text2
Height = 375
Left = 10785
TabIndex = 4
Text = "A"
Top = 1695
Width = 990
End
Begin VB.CommandButton ComReF
Caption = "刷新"
Height = 345
Left = 12375
TabIndex = 3
Top = 1132
Width = 945
End
Begin VB.TextBox Text1
Height = 375
Left = 10785
TabIndex = 2
Text = "128"
Top = 570
Width = 990
End
Begin VB.PictureBox Pic1
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 3900
Left = 150
ScaleHeight = 260
ScaleMode = 3 'Pixel
ScaleWidth = 520
TabIndex = 0
Top = 285
Width = 7800
Begin VB.Label label
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "A"
BeginProperty Font
Name = "黑体"
Size = 72
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 1455
Left = 0
TabIndex = 1
Top = 0
Width = 720
End
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "0 -> 8"
Height = 180
Left = 3030
TabIndex = 19
Top = 4245
Width = 540
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "LED4"
Height = 180
Left = 2370
TabIndex = 18
Top = 4245
Width = 360
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "LED3"
Height = 180
Left = 345
TabIndex = 17
Top = 4230
Width = 360
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "LED2"
Height = 180
Left = 2370
TabIndex = 16
Top = 60
Width = 360
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "LED1"
Height = 180
Left = 345
TabIndex = 15
Top = 45
Width = 360
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "字符："
Height = 180
Left = 9675
TabIndex = 13
Top = 1770
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "点阵类型："
Height = 180
Left = 9675
TabIndex = 12
Top = 195
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "精细度："
Height = 180
Left = 9675
TabIndex = 9
Top = 1245
Width = 720
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "字符大小："
Height = 180
Left = 9675
TabIndex = 8
Top = 720
Width = 900
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Fill(16, 16) As Integer
Dim intIi As Integer
Dim LedDot(4, 8) As Integer
Private Sub ComReF_Click()
label.Caption = Text2.Text
label.FontSize = Text1.Text
label.Refresh
Debug.Print label.Top
Debug.Print label.Left
DrawPic
End Sub
Private Function LED8()
Dim iColor As Long
Dim i As Integer
Dim j As Integer
Dim intH As Integer
Dim intV As Integer
Dim x As Long
intIi = Text3.Text
Pic1.FillColor = RGB(255, 0, 0)
x = 0
For intV = 0 To 7
For intH = 0 To 7
For i = 0 To 16
For j = 0 To 16
iColor = Pic1.Point(i + intV * 16, j + intH * 16)
'Debug.Print iColor
If iColor <= 256 Then x = x + 1
Next
Next
' Debug.Print x
If x > intIi Then
Fill(intV, intH) = 0
Pic1.FillStyle = 0
Pic1.Circle (8 + intV * 16, 8 + intH * 16), 7
Else
Fill(intV, intH) = 1
Pic1.FillStyle = 1
Pic1.Circle (8 + intV * 16, 8 + intH * 16), 7
End If
x = 0
Next
Next
'label.Visible = False
Pic1.FillStyle = 1
End Function
Private Sub ComGet_Click()
label.Caption = Text2.Text
Me.Refresh
Pic1.Cls
DrawPic
If Me.Option1.Value Then
LED16
Else
LED8
End If
Text4.Text = ""
'label.Visible = False
GetDot
End Sub
Private Function LED16()
Dim iColor As Long
Dim i As Integer
Dim j As Integer
Dim intH As Integer
Dim intV As Integer
Dim x As Long
intIi = Text3.Text
Pic1.FillColor = RGB(255, 0, 0)
x = 0
For intV = 0 To 15
For intH = 0 To 15
For i = 0 To 16
For j = 0 To 16
'逐点读取颜色值
iColor = Pic1.Point(i + intV * 16, j + intH * 16)
'Debug.Print iColor
'记录黑色点的数量
If iColor <= 25 Then x = x + 1
Next
Next
' Debug.Print x
'矩形区域内有足够多的黑色点即判定为有效，LED点亮
If x > intIi Then
Fill(intV, intH) = 0
Pic1.FillStyle = 0
Pic1.Circle (8 + intV * 16, 8 + intH * 16), 7
Else
Fill(intV, intH) = 1
Pic1.FillStyle = 1
Pic1.Circle (8 + intV * 16, 8 + intH * 16), 7
End If
x = 0
Next
Next
'label.Visible = False
Pic1.FillStyle = 1
End Function
Private Sub ComFont_Click()
Me.CommonDialog1.ShowFont
label.Font = Me.CommonDialog1.FileName
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 37
label.Left = label.Left - 1
Case 38
label.Top = label.Top - 1
Case 39
label.Left = label.Left + 1
Case 40
label.Top = label.Top + 1
End Select
DrawPic
End Sub
Private Function DrawPic()
'绘制分划线和小空心园
Pic1.ForeColor = RGB(0, 0, 100)
Pic1.Line (0, 128)-(256, 128), RGB(0, 0, 240)
Pic1.Line (128, 0)-(128, 256), RGB(0, 0, 240)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim intL As Integer
For intL = 0 To 1
For k = 0 To 1
For i = 0 To 7
For j = 0 To 7
Pic1.Circle ((8 + i * 16 + k * 128), (8 + intL * 128 + j * 16)), 7
Next
Next
Next
Next
End Function
Private Function GetDot()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim intL As Integer
Dim intXx As Integer
Dim intYy As Integer
For i = 0 To 4
For j = 0 To 8
LedDot(i, j) = 0
' Debug.Print j
Next
Next
For k = 0 To 1
For intL = 0 To 1
For i = 0 To 7
intYy = 1
For j = 0 To 7
iColor = Pic1.Point((8 + intL * 128 + j * 16), (8 + i * 16 + k * 128))
'判断LED是否被点亮，即圆心是否为红色
'Debug.Print iColor
intXx = 0
If iColor = 255 Then intXx = 1
LedDot(intL + k * 2, i) = intXx * intYy + LedDot(intL + k * 2, i)
intYy = intYy * 2
Next
Text4.Text = Text4.Text + Str(LedDot(intL + k * 2, i))
Next
Text4.Text = Text4.Text + Chr(13) + Chr(10)
Next
Next
End Function
Private Sub Form_Load()
iOption
End Sub
Private Sub Option1_Click()
iOption
End Sub
Private Sub Option2_Click()
iOption
End Sub
Private Function iOption()
label.Caption = Text2.Text
If Option1.Value = True Then
label.Top = -7
label.Left = -10
label.FontSize = 200
Text1.Text = 200
Else
label.Top = -23
label.Left = 20
label.FontSize = 128
Text1.Text = 128
End If
Me.Refresh
DrawPic
End Function
Private Sub Pic1_Click()
End Sub
Private Sub Text2_Change()
Call ComReF_Click
End Sub
Private Sub Timer1_Timer()
DrawPic
Timer1.Enabled = False
End Sub
Private Sub Text3_Change()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -