tefrm.frm

使用VB编写的LCD/LED点阵取字模软件源码。

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmSignel 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "LCD单个点阵数据"
   ClientHeight    =   2865
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4815
   Icon            =   "tefrm.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "tefrm.frx":0442
   ScaleHeight     =   2865
   ScaleWidth      =   4815
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Cmdexit 
      Caption         =   "退  出"
      Height          =   855
      Left            =   3480
      Picture         =   "tefrm.frx":7774
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   1920
      Width           =   1215
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   1320
      Top             =   1440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton CmdSave 
      Caption         =   "保存数据"
      Height          =   855
      Left            =   120
      Picture         =   "tefrm.frx":7A7E
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   1920
      Width           =   1215
   End
   Begin RichTextLib.RichTextBox Richtb 
      Height          =   1455
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   4575
      _ExtentX        =   8070
      _ExtentY        =   2566
      _Version        =   393217
      Enabled         =   -1  'True
      ScrollBars      =   2
      TextRTF         =   $"tefrm.frx":7EC0
   End
   Begin VB.CommandButton CmdData 
      Caption         =   "数  据"
      Height          =   855
      Left            =   1800
      Picture         =   "tefrm.frx":814A
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   1920
      Width           =   1215
   End
End
Attribute VB_Name = "frmSignel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim hz(11, 31) As Byte

Private Sub CmdData_Click()
Dim bbb As Integer
Dim ttt As String
Dim aaa As String
Dim i, j, k
Dim a As Byte
    If frmzktq.ComboSY.Text = "16X16" Then
        For i = 0 To 28
            If Mid(str, i + 1, 1) = " " Then i = i + 1
            aaa = aaa & Mid(str, i + 1, 1)
        Next
        str = aaa
        If Len(frmzktq.TxtLine1.Text) > 7 Then
            If Len(str) Mod 2 = 1 Then
                bbb = Len(str) \ 2 + 1
            Else
                bbb = Len(str) \ 2
            End If
        Else
            bbb = Len(str)
        End If
            If Len(frmzktq.TxtLine1.Text) > 7 Then
                ttt = Mid(str, i1 * 2 + 1, 2) & ":" & vbCrLf
            Else
                ttt = Mid(str, i1 + 1, 1) & ":" & vbCrLf
            End If
            For k = 0 To 1
                For j = 0 To 15
                    a = ZiKu(i1, j, k)
                    If a <= 9 Then
                        ttt = ttt & " 0" & Hex(a) & "H,"
                    ElseIf (a > 9 And a < 16) Then
                        ttt = ttt & " 0" & Hex(a) & "H,"
                    ElseIf (a >= 16 And a < 160) Then
                        ttt = ttt & " " & Hex(a) & "H,"
                    ElseIf (a >= 160 And a < 256) Then
                        ttt = ttt & "0" & Hex(a) & "H,"
                    End If
                Next j
            Next k
            ttt = ttt & vbCrLf
        i1 = i1 + 1
        If i1 > bbb - 1 Then i1 = 0
        
    ElseIf frmzktq.ComboSY.Text = "16X8" Then

        For i = 0 To 28
            If Mid(str, i + 1, 1) = " " Then i = i + 1
            aaa = aaa & Mid(str, i + 1, 1)
        Next
        str = aaa
        bbb = Len(str)
            ttt = Mid(str, i1 + 1, 1) & ":" & vbCrLf
            For k = 0 To 1
                For j = 0 To 7
                    a = ZiKu(i1, j, k)
                    If a <= 9 Then
                        ttt = ttt & " 0" & Hex(a) & "H,"
                    ElseIf (a > 9 And a < 16) Then
                        ttt = ttt & " 0" & Hex(a) & "H,"
                    ElseIf (a >= 16 And a < 160) Then
                        ttt = ttt & " " & Hex(a) & "H,"
                    ElseIf (a >= 160 And a < 256) Then
                        ttt = ttt & "0" & Hex(a) & "H,"
                    End If
                Next j
            Next k
            ttt = ttt & vbCrLf
        i1 = i1 + 1
        If i1 > bbb - 1 Then i1 = 0
    ElseIf frmzktq.ComboSY.Text = "8X6" Then
        For i = 0 To 75
            If Mid(str, i + 1, 1) = " " Then i = i + 1
            aaa = aaa & Mid(str, i + 1, 1)
        Next
        str = aaa
        bbb = Len(str)
            ttt = Mid(str, i1 + 1, 1) & ":" & vbCrLf
            For j = 0 To 5
                a = ZiKu(i1, j, 0)
                If a <= 9 Then
                    ttt = ttt & " 0" & Hex(a) & "H,"
                ElseIf (a > 9 And a < 16) Then
                    ttt = ttt & " 0" & Hex(a) & "H,"
                ElseIf (a >= 16 And a < 160) Then
                    ttt = ttt & " " & Hex(a) & "H,"
                ElseIf (a >= 160 And a < 256) Then
                    ttt = ttt & "0" & Hex(a) & "H,"
                End If
            Next j
            ttt = ttt & vbCrLf
        i1 = i1 + 1
        If i1 > bbb - 1 Then i1 = 0
    End If
    Richtb.Text = ttt
End Sub

Private Sub Cmdexit_Click()
    Unload Me
End Sub

Private Sub CmdSave_Click()
Dim savefile As String
Dim FileNumber
On Error GoTo CmdSaveErr
    FileNumber = FreeFile   ' 取得未使用的文件号。
    CommonDialog1.Filter = "asm文件(*.asm)|*.asm|文本文件(*.txt)|*.txt"
    CommonDialog1.ShowSave
    savefile = CommonDialog1.FileName
    If savefile = "" Then Exit Sub
    Open savefile For Binary As #FileNumber
    '..........
    If frmzktq.ComboSY.Text = "16X16" Then
        For i = 0 To 28
            If Mid(str, i + 1, 1) = " " Then i = i + 1
            aaa = aaa & Mid(str, i + 1, 1)
        Next
        str = aaa
        If Len(frmzktq.TxtLine1.Text) > 7 Then
            If Len(str) Mod 2 = 1 Then
                bbb = Len(str) \ 2 + 1
            Else
                bbb = Len(str) \ 2
            End If

        Else
            bbb = Len(str)
        End If

        For i = 0 To bbb - 1
            If Len(frmzktq.TxtLine1.Text) > 7 Then
                ttt = Mid(str, i * 2 + 1, 2) & ":" & vbCrLf & "db  "
            Else
                ttt = Mid(str, i + 1, 1) & ":" & vbCrLf & "db  "
            End If
            For k = 0 To 1
                For j = 0 To 15
                    a = ZiKu(i, j, k)
                    If a <= 9 Then
                        ttt = ttt & " 0" & Hex(a) & "H,"
                    ElseIf (a > 9 And a < 16) Then
                        ttt = ttt & " 0" & Hex(a) & "H,"
                    ElseIf (a >= 16 And a < 160) Then
                        ttt = ttt & " " & Hex(a) & "H,"
                    ElseIf (a >= 160 And a < 256) Then
                        ttt = ttt & "0" & Hex(a) & "H,"
                    End If
                Next j
            Next k
            ttt = Mid(ttt, 1, Len(ttt) - 1)
        ttt = ttt & vbCrLf
        Put #FileNumber, , ttt
        ttt = ""
        Next i
    ElseIf frmzktq.ComboSY.Text = "16X8" Then
        For i = 0 To 28
            If Mid(str, i + 1, 1) = " " Then i = i + 1
            aaa = aaa & Mid(str, i + 1, 1)
        Next
        str = aaa
        bbb = Len(str)
        For i = 0 To bbb - 1
            ttt = Mid(str, i + 1, 1) & ":" & vbCrLf & "db  "
            For k = 0 To 1
                For j = 0 To 7
                    a = ZiKu(i, j, k)
                    If a <= 9 Then
                        ttt = ttt & " 0" & Hex(a) & "H,"
                    ElseIf (a > 9 And a < 16) Then
                        ttt = ttt & " 0" & Hex(a) & "H,"
                    ElseIf (a >= 16 And a < 160) Then
                        ttt = ttt & " " & Hex(a) & "H,"
                    ElseIf (a >= 160 And a < 256) Then
                        ttt = ttt & "0" & Hex(a) & "H,"
                    End If
                Next j
            Next k
            ttt = Mid(ttt, 1, Len(ttt) - 1)
           ttt = ttt & vbCrLf
        Put #FileNumber, , ttt
        ttt = ""
        Next i
        ElseIf frmzktq.ComboSY.Text = "8X6" Then
        For i = 0 To 75
            If Mid(str, i + 1, 1) = " " Then i = i + 1
            aaa = aaa & Mid(str, i + 1, 1)
        Next
        str = aaa
        bbb = Len(str)
        For i = 0 To bbb - 1
            ttt = Mid(str, i + 1, 1) & ":" & vbCrLf & "db  "
            For j = 0 To 5
                a = ZiKu(i, j, 0)
                If a <= 9 Then
                    ttt = ttt & " 0" & Hex(a) & "H,"
                ElseIf (a > 9 And a < 16) Then
                    ttt = ttt & " 0" & Hex(a) & "H,"
                ElseIf (a >= 16 And a < 160) Then
                    ttt = ttt & " " & Hex(a) & "H,"
                ElseIf (a >= 160 And a < 256) Then
                    ttt = ttt & "0" & Hex(a) & "H,"
                End If
            Next j
            ttt = Mid(ttt, 1, Len(ttt) - 1)
            ttt = ttt & vbCrLf
        Put #FileNumber, , ttt
        ttt = ""
        Next i

    End If
    Close #1
    Exit Sub
CmdSaveErr:
    MsgBox CommonDialog1.FileName & "文件保存错误", vbQuestion, "LCD液晶点阵图形错误"

End Sub

Private Sub Form_Load()
    CmdData_Click
End Sub