frmzktq.frm

液晶自模点阵提取软件

        If (XX Mod 8 = 1) Then
            Label3.Caption = "正在处理位图，请等候…… " & "-"
        ElseIf (XX Mod 8 = 3) Then
            Label3.Caption = "正在处理位图，请等候…… " & "\"
        ElseIf (XX Mod 8 = 5) Then
            Label3.Caption = "正在处理位图，请等候…… " & "|"
        ElseIf (XX Mod 8 = 7) Then
            Label3.Caption = "正在处理位图，请等候…… " & "/"
        End If
    DoEvents
        For j = 0 To 3
            n1 = DotLib(XX, j)
            For i = 0 To 7
            If (n1 Mod 2) Then
            red = 255
            Else
            red = 0
            End If
            PictureRev.PSet (XX * 4, (j * 8 + i) * 4), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 1, (j * 8 + i) * 4), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 2, (j * 8 + i) * 4), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 3, (j * 8 + i) * 4), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4, (j * 8 + i) * 4 + 1), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 1, (j * 8 + i) * 4 + 1), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 2, (j * 8 + i) * 4 + 1), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 3, (j * 8 + i) * 4 + 1), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4, (j * 8 + i) * 4 + 2), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 1, (j * 8 + i) * 4 + 2), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 2, (j * 8 + i) * 4 + 2), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 3, (j * 8 + i) * 4 + 2), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4, (j * 8 + i) * 4 + 3), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 1, (j * 8 + i) * 4 + 3), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 2, (j * 8 + i) * 4 + 3), RGB(red, 0, 0)
            PictureRev.PSet (XX * 4 + 3, (j * 8 + i) * 4 + 3), RGB(red, 0, 0)
            n1 = n1 \ 2
            Next i
        Next j
    Next XX
    PictureRev.Line (0, 64)-(449, 64), RGB(0, 0, 255)
    If ComboSY.Text = "16X16" Then
        For i = 1 To 6
            PictureRev.Line (i * 64, 0)-(i * 64, 128), RGB(0, 0, 255)
        Next i
    ElseIf ComboSY.Text = "16X8" Then
        For i = 1 To 13
            PictureRev.Line (i * 32, 0)-(i * 32, 128), RGB(0, 0, 255)
        Next i
    ElseIf ComboSY.Text = "8X6" Then
        For i = 1 To 19
             PictureRev.Line (i * 24, 0)-(i * 24, 128), RGB(0, 255, 0)
        Next i
        PictureRev.Line (0, 32)-(449, 32), RGB(0, 255, 0)
        PictureRev.Line (0, 96)-(449, 96), RGB(0, 255, 0)

    End If
'    For i = 1 To n
'    PictureRev.Line (i * 64, 0)-(i * 64, 128), RGB(0, 0, 255)
'    Next i
DisplayBigErr:
Label3.Alignment = 2
Label3.Caption = "关 于"
ProgressBar1.Visible = f

End Sub
Private Sub CreatZiKu()
Dim i, j, k
    If ComboSY.Text = "16X16" Then
        For i = 0 To 6
            For j = 0 To 15
                For k = 0 To 1
                ZiKu(i, j, k) = DotLib(i * 16 + j, k)
                Next k
            Next j
        Next i
        For i = 7 To 13
            For j = 0 To 15
                For k = 0 To 1
                ZiKu(i, j, k) = DotLib((i - 7) * 16 + j, k + 2)
                Next k
            Next j
        Next i
        
    ElseIf ComboSY.Text = "16X8" Then
        For i = 0 To 13
            For j = 0 To 7
                For k = 0 To 1
                ZiKu(i, j, k) = DotLib(i * 8 + j, k)
                Next k
            Next j
        Next i
        For i = 14 To 27
            For j = 0 To 7
                For k = 0 To 1
                ZiKu(i, j, k) = DotLib((i - 14) * 8 + j, k + 2)
                Next k
            Next j
        Next i
    ElseIf ComboSY.Text = "8X6" Then
       For i = 0 To 71
            For j = 0 To 5
                ZiKu(i, j, 0) = DotLib((i Mod (18)) * 6 + j, i \ 18)
            Next j
        Next i
    End If
End Sub
Private Sub CmdDisplay_Click()
'    If TxtLine1.Text = "" Then
'        MsgBox "请在第一行输入文字", vbExclamation, "LCD液晶点阵文字输入错误"
'        Exit Sub
'    End If
    AscText.Visible = False
    CreatLib
    DisplayBig
    CreatZiKu
End Sub

Private Sub Cmdexit_Click()
    Unload Me
End Sub

Private Sub CmdFont_Click()
Dim LcdFont As New StdFont
On Error GoTo CmdFontErr
      CommonDialog1.Flags = cdlCFBoth   ' 在使用ShowFont 方法之前，必须给 cdlCFBoth，
                                        ' cdlCFPrinterFonts,或 cdlCFScreenFonts置标识属性。
      CommonDialog1.CancelError = True
    CommonDialog1.ShowFont
    LcdFont.Bold = CommonDialog1.FontBold
    LcdFont.Name = CommonDialog1.FontName
    LcdFont.Size = CommonDialog1.FontSize
    TxtLine1.Font = CommonDialog1.FontName
    TxtLine2.Font = CommonDialog1.FontName
    Set Labtxt.Font = LcdFont
CmdFontErr:
End Sub

Private Sub CmdSave_Click()
Dim savefile As String
Dim FileNumber
On Error GoTo CmdSaveErr
    FileNumber = FreeFile   ' 取得未使用的文件号。
    CommonDialog1.Filter = "Rom文件(*.rom)|*.rom|bin文件(*.bin)|*.bin"
    CommonDialog1.ShowSave
    savefile = CommonDialog1.FileName
    If savefile = "" Then Exit Sub
    Open savefile For Binary As #FileNumber
    If ComboSY.Text = "16X16" Then
        For i = 0 To 13
            For k = 0 To 1
                For j = 0 To 15
                Put #FileNumber, , ZiKu(i, j, k)
                Next j
            Next k
        Next i
    Else
        For i = 0 To 27
            For k = 0 To 1
                For j = 0 To 7
                Put #FileNumber, , ZiKu(i, j, k)
                Next j
            Next k
        Next i
    End If
    
    Close #1
CmdSaveErr:
    MsgBox CommonDialog1.FileName & "文件保存错误", vbQuestion, "LCD液晶点阵图形错误"
End Sub

Private Sub CmdSignel_Click()
    CreatZiKu
    i1 = 0
    frmSignel.Show vbModal, Me

End Sub

Private Sub Form_Load()
    Show
    AscText.Visible = False
    ComboSY.AddItem ("16X16")
    ComboSY.AddItem ("16X8")
    ComboSY.AddItem ("8X6")
    ComboSY.Text = "16X16"
    'PictureRev.Line (0, 64)-(449, 64), RGB(0, 0, 255)
    str = TxtLine1.Text & " " & TxtLine2.Text
    Labtxt = str
    CommonDialog1.FontName = Labtxt.FontName
    CommonDialog1.FontSize = Labtxt.FontSize
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Label3.ForeColor = RGB(255, 0, 0)
End Sub

Private Sub Label3_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Label3.ForeColor = RGB(0, 0, 255)
End Sub

Private Sub Label4_Click()
Dim LcdFont As New StdFont
    AscText.Visible = True
    AscText.SetFocus
On Error GoTo CmdFontErr
'    LcdFont.Bold = CommonDialog1.FontBold
'    LcdFont.Name = CommonDialog1.FontName
'    LcdFont.Size = CommonDialog1.FontSize
'    TxtLine1.Font = CommonDialog1.FontName
'    TxtLine2.Font = CommonDialog1.FontName
'    Set Labtxt.Font = LcdFont
    Labtxt.FontName = "Terminal"
    Labtxt.FontSize = 6
CmdFontErr:
   
End Sub

Private Sub PictureRev_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i, j
    If Button = vbLeftButton Then
        If ComboSY.Text = "16X16" Then
            For i = 0 To 6
                If X > i * 64 And X < (i + 1) * 64 Then
                    If Y < 65 Then
                        i1 = i
                    Else
                        i1 = i + 7
                    End If
                    Exit For
                End If
            Next
        ElseIf ComboSY.Text = "16X8" Then
            For i = 0 To 13
                If X > i * 32 And X < (i + 1) * 32 Then
                    If Y < 65 Then
                        i1 = i
                    Else
                        i1 = i + 14
                    End If
                    Exit For
                End If
            Next
        ElseIf ComboSY.Text = "8X6" Then
            For i = 0 To 17
                If X > i * 24 And X < (i + 1) * 24 Then
                    If Y < 33 Then
                        i1 = i
                    ElseIf Y > 32 And Y < 65 Then
                        i1 = i + 18
                    ElseIf Y > 64 And Y < 97 Then
                        i1 = i + 36
                    ElseIf Y > 96 And Y < 129 Then
                        i1 = i + 54
                    End If
                    Exit For
                End If
            Next
       End If
    frmSignel.Show 1, Me
   End If
End Sub

Private Sub TxtLine1_Change()
    str = TxtLine1.Text & " " & TxtLine2.Text
    Labtxt = str
    If Len(TxtLine1.Text) > 7 Then
        ComboSY.Text = "16X8"
    Else
        ComboSY.Text = "16X16"
    End If
End Sub

Private Sub TxtLine2_Change()
    str = TxtLine1.Text & " " & TxtLine2.Text
    Labtxt = str

End Sub