frm12864.frm

12864 lcd 的字模提取软件

    End If
  Loop Until sInvalidStr = ""
  
  Call SetFontInfo(mSecondaryBigFont, cdlg.FontName, cdlg.FontSize)
  Call SetTextOrLabelFontByCDlg(lblSecondaryBigFont)
  Exit Sub
quit:
  Debug.Assert Err.Description = "Cancel was selected."
  txtChar.FontName = mSecondaryBigFont.Name
  txtChar.FontSize = mSecondaryBigFont.Size
End Sub

Private Sub cmdBrowse_Click()
  On Error GoTo quit:
  cdlg.ShowSave
  txtFile.Text = cdlg.FileName
  Exit Sub
quit:
  Debug.Assert Err.Description = "Cancel was selected."
End Sub

Private Sub cmdSecondarySmallFont_Click()
  Dim sInvalidStr As String
  
  Call HightlightCmdBtn(cmdSecondarySmallFont)
  cdlg.FontName = mSecondarySmallFont.Name
  cdlg.FontSize = mSecondarySmallFont.Size
  
  Do
    On Error GoTo quit:
    cdlg.ShowFont
    Call SetTextOrLabelFontByCDlg(txtChar)
    sInvalidStr = GetFontHeightInvalidString(8)
    If sInvalidStr <> "" Then
      MsgBox "以下字符的高度大于8，请重新选择：" & vbCrLf & sInvalidStr, vbCritical, "错误"
    End If
  Loop Until sInvalidStr = ""
  
  Call SetFontInfo(mSecondarySmallFont, cdlg.FontName, cdlg.FontSize)
  Call SetTextOrLabelFontByCDlg(lblSecondarySmallFont)
  Exit Sub
quit:
  Debug.Assert Err.Description = "Cancel was selected."
  txtChar.FontName = mSecondarySmallFont.Name
  txtChar.FontSize = mSecondarySmallFont.Size
End Sub



Private Sub cmdPrimarySmallFont_Click()
  Dim sInvalidStr As String
  
  Call HightlightCmdBtn(cmdPrimarySmallFont)
  cdlg.FontName = mPrimarySmallFont.Name
  cdlg.FontSize = mPrimarySmallFont.Size
  
  On Error GoTo quit:
  cdlg.ShowFont
  Call SetTextOrLabelFontByCDlg(txtChar)
  sInvalidStr = GetFontHeightInvalidString(8)
  If sInvalidStr <> "" Then
    MsgBox "以下高度大于8的字符将使用备用字体：" & vbCrLf & sInvalidStr, vbExclamation, "警告"
  End If
  
  Call SetFontInfo(mPrimarySmallFont, cdlg.FontName, cdlg.FontSize)
  Call SetTextOrLabelFontByCDlg(lblPrimarySmallFont)
  Exit Sub
quit:
  Debug.Assert Err.Description = "Cancel was selected."
  txtChar.FontName = mPrimarySmallFont.Name
  txtChar.FontSize = mPrimarySmallFont.Size
End Sub
Private Sub Form_Load()
  Dim X As Integer
  Dim Y As Integer
  Dim i As Byte
  Dim lx As Single
  Dim ly As Single
  txtFile.Text = App.Path & "\CharData.h"
  shpLcdBorder.Move 2, 1, 655, 336
  
  sChineseCharacters = "←→参"
  sAllCharacters = BASIC_CHARS & SPECIAL_CHARS & sChineseCharacters
  mPrimarySmallFont.Name = "Times New Roman"
  mPrimarySmallFont.Size = 8
  mSecondarySmallFont.Name = "宋体"
  mSecondarySmallFont.Size = 8
  mPrimaryBigFont.Name = "Times New Roman"
  mPrimaryBigFont.Size = 12
  mSecondaryBigFont.Name = "宋体"
  mSecondaryBigFont.Size = 12
  
  lblPrimarySmallFont.FontName = mPrimarySmallFont.Name
  lblPrimarySmallFont.FontSize = mPrimarySmallFont.Size
  lblSecondarySmallFont.FontName = mSecondarySmallFont.Name
  lblSecondarySmallFont.FontSize = mSecondarySmallFont.Size
  lblPrimaryBigFont.FontName = mPrimaryBigFont.Name
  lblPrimaryBigFont.FontSize = mPrimaryBigFont.Size
  lblSecondaryBigFont.FontName = mSecondaryBigFont.Name
  lblSecondaryBigFont.FontSize = mSecondaryBigFont.Size
  
  lblPrimarySmallFont.Caption = mPrimarySmallFont.Name & " " & CStr(mPrimarySmallFont.Size)
  lblSecondarySmallFont.Caption = mSecondarySmallFont.Name & " " & CStr(mSecondarySmallFont.Size)
  lblPrimaryBigFont.Caption = mPrimaryBigFont.Name & " " & CStr(mPrimaryBigFont.Size)
  lblSecondaryBigFont.Caption = mSecondaryBigFont.Name & " " & CStr(mSecondaryBigFont.Size)
  
  txtChar.FontName = mPrimarySmallFont.Name
  txtChar.FontSize = mPrimarySmallFont.Size
  
  '在使用ShowFont 方法之前，必须给 cdlCFBoth，或 cdlCFScreenFonts 置标识属性。
  cdlg.Flags = cdlCFBoth Or cdlCFEffects
  
  For X = 0 To 63
    For Y = 0 To 127
      Call ShowPt(Y, X, False)
    Next Y
  Next X
  
  Me.ForeColor = vbYellow
  lx = LEFT_MARGIN + 128 * (LCD_DOT_SIDE_LENGTH + LCD_DOT_DOT_SPACE)
  For i = 8 To 56 Step 8
    ly = TOP_MARGIN + i * (LCD_DOT_SIDE_LENGTH + LCD_DOT_DOT_SPACE) - LCD_DOT_DOT_SPACE / 2
    Line (LEFT_MARGIN, ly)-(lx, ly)
  Next i
  
  lx = LEFT_MARGIN + 64 * (LCD_DOT_SIDE_LENGTH + LCD_DOT_DOT_SPACE) - LCD_DOT_DOT_SPACE / 2
  ly = TOP_MARGIN + 64 * (LCD_DOT_SIDE_LENGTH + LCD_DOT_DOT_SPACE) - LCD_DOT_DOT_SPACE / 2
  Line (lx, TOP_MARGIN)-(lx, ly)
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  bCapture = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim XPage As Byte
  Dim bSet As Boolean
  Dim Pos As Byte
  
  MouseX = Int((X - LEFT_MARGIN) / (LCD_DOT_SIDE_LENGTH + LCD_DOT_DOT_SPACE))
  MouseY = Int((Y - TOP_MARGIN) / (LCD_DOT_SIDE_LENGTH + LCD_DOT_DOT_SPACE))
  
  If MouseY >= 0 And MouseY <= 63 And MouseX >= 0 And MouseX <= 127 Then
    lblXY.Caption = "Ln " & CStr(MouseY) & ", Col " & CStr(MouseX)
    shpLcdBorder.Visible = True
  Else
    shpLcdBorder.Visible = False
  End If
  
  If bCapture Then
    bSet = (Button = 1)
    Call ShowPt(MouseX, MouseY, bSet)
    Call SetData(MouseY, MouseX, bSet)
  End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  bCapture = False
End Sub

Private Sub mnuClearAll_Click()
  Dim i As Byte
  Dim j As Byte
  
  For i = 0 To 7
    For j = 0 To 127
      Data(i, j) = 0
    Next j
  Next i
  
  For i = 0 To 63
    For j = 0 To 127
      Call ShowPt(j, i, False)
    Next j
  Next i
End Sub

Private Sub mnuGenFullScreenData_Click()
  Dim XPage As Byte
  Dim Y As Byte
  Dim s As String
  Dim sx As String
  Dim sy As String
  Dim sd As String
  Dim Count As Integer
  Dim i As Integer
  
  s = "void FuncName(void)" & vbCrLf _
    & "{" & vbCrLf _
    & "  unsigned int i;" & vbCrLf
    
  sx = "  unsigned char x[] = {"
  sy = "  unsigned char y[] = {"
  sd = "  unsigned char d[] = {"
  For XPage = 0 To 7
    For Y = 0 To 127
      If Data(XPage, Y) <> 0 Then
        Count = Count + 1
        sx = sx & CStr(XPage) & ","
        sy = sy & CStr(Y) & ","
        sd = sd & "0x" & Add0Hex(Data(XPage, Y)) & ","
      End If
    Next Y
  Next XPage
  
  sx = Left(sx, Len(sx) - 1) & "};" & vbCrLf
  sy = Left(sy, Len(sy) - 1) & "};" & vbCrLf
  sd = Left(sd, Len(sd) - 1) & "};" & vbCrLf
  s = s & sx & sy & sd & vbCrLf
  s = s & "  for(i=0;i<=" & CStr(Count - 1) & ";i++)" & vbCrLf
  s = s & "    LcdWriteData(x[i],y[i],d[i]);" & vbCrLf
  s = s & "}" & vbCrLf

  txtCode.Text = s
  txtCode.SelStart = 5
  txtCode.SelLength = 8
  txtCode.SetFocus
  Clipboard.SetText s
End Sub

Private Sub mnuGenImgAt0_0_Click()
  txtCode.SetFocus
  Call GenerateImage(0, 0)
  Call ShowCharInfo
End Sub

Private Sub mnuGenImgAtMouse_Click()
  If MouseY >= 0 And MouseY <= 63 And MouseX >= 0 And MouseX <= 127 Then
    txtCode.SetFocus
    Call GenerateImage(MouseX, MouseY)
    Call ShowCharInfo
  Else
    MsgBox "请将鼠标移到液晶屏范围后再进行此操作", vbCritical, "错误"
  End If
End Sub
Private Sub mnuOneKeyAllCode_Click()
  Dim MyDc As Long
  Dim sCCode As String
  Dim sWidth As String
  Dim sWidthComment As String
  Dim sDotData As String
  Dim sDotLineData As String
  Dim Ch As String * 1
  Dim i As Byte
  Dim j As Byte
  Dim X As Integer
  Dim Y As Integer
  Dim ColumeData As Byte
  Dim YInit As Byte
  Dim MyChar As udtCharInfo
  Dim Page As Byte
  Dim bUseSecondaryFont As Boolean
  
  sCCode = ""
  sCCode = sCCode & "/************************************************************************************" & vbCrLf
  sCCode = sCCode & "/* 文件名：" & txtFile.Text & vbCrLf
  sCCode = sCCode & "/* 本文件中所有代码均由肖宁杰设计的“12864液晶自动化编程系统”自动生成" & vbCrLf
  sCCode = sCCode & "/* 首选字体：" & mPrimarySmallFont.Name & " " & CStr(mPrimarySmallFont.Size) & vbCrLf
  sCCode = sCCode & "/* 备用字体：" & mSecondarySmallFont.Name & " " & CStr(mSecondarySmallFont.Size) & vbCrLf
  sCCode = sCCode & "/* 以下注释中若无特殊注明者均为首选字体" & vbCrLf
  sCCode = sCCode & "/*" & vbCrLf
  sCCode = sCCode & "/* 版权所有(c) 2007, Ningjie Xiao, 保留所有权利" & vbCrLf
  sCCode = sCCode & "/***********************************************************************************/" & vbCrLf & vbCrLf
  
  sCCode = sCCode & "#define BasicCharsCount " & CStr(Len(BASIC_CHARS)) & vbCrLf
  sCCode = sCCode & "#define SingleByteCharsCount " & CStr(Len(BASIC_CHARS) + Len(SPECIAL_CHARS)) & vbCrLf & vbCrLf
  
  sCCode = sCCode & "char *sSpecialChars = """ & Replace(SPECIAL_CHARS, """", "\""") & """;" & vbCrLf
  sCCode = sCCode & "char *sChineseChars = """ & sChineseCharacters & """;" & vbCrLf & vbCrLf
  
  sDotData = ""
    
  txtCode.SetFocus '把焦点从txtChar上移走
  MyDc = GetDC(frmMain.txtChar.hWnd)
  pgb.Max = Len(sAllCharacters) * 2
  pgb.Visible = True
  
  For i = 1 To 2 'i = 1时求小字体参数；i = 2时求大字体参数
    
    sWidth = "  "
    sWidthComment = "//"
    sCCode = sCCode & "unsigned char " & IIf(i = 1, "Small", "Big") & "CharWidth[]=" & vbCrLf & "{" & vbCrLf
    sDotData = sDotData & "unsigned char " & IIf(i = 1, "Small", "Big") & "CharData[]=" & vbCrLf & "{" & vbCrLf
    
    For j = 1 To Len(sAllCharacters)
      Ch = Mid(sAllCharacters, j, 1)
      Call SetTextboxFont(IIf(i = 1, emPrimarySmall, emPrimaryBig))
      txtChar.Text = Ch
      DoEvents
      Call GetCharSize(MyChar)
      
      bUseSecondaryFont = (MyChar.Height > IIf(i = 1, 8, 16))
      
      If bUseSecondaryFont Then
        Call SetTextboxFont(IIf(i = 1, emSecondarySmall, emSecondaryBig))
        bUseSecondaryFont = True
        txtChar.Text = Chr(j)
        DoEvents
        Call GetCharSize(MyChar)
      End If
      
      sWidthComment = sWidthComment & IIf(MyChar.Width > 9 And LenB(StrConv(Ch, vbFromUnicode)) = 1, " ", "") & Ch & ","
      sWidth = sWidth & CStr(MyChar.Width) & ","
      
      If j = Len(sAllCharacters) Then
        sCCode = sCCode & RTrim1(sWidthComment) & vbCrLf _
          & RTrim1(sWidth) & vbCrLf & "};" & vbCrLf & vbCrLf
      ElseIf Ch = "9" Or Ch = "Z" Or Ch = "z" Then
        sCCode = sCCode & sWidthComment & vbCrLf & sWidth & vbCrLf & vbCrLf
        sWidth = "  "
        sWidthComment = "//"
      End If
      
      For Page = 1 To i
        sDotLineData = "  "
        sDotData = sDotData & "  "
        For X = MyChar.Left To MyChar.Right
          ColumeData = 0
          YInit = MyChar.Top + (Page - 1) * 8
          For Y = YInit To YInit + 7
            If IsPixelChar(GetPixel(MyDc, X, Y)) Then
              ColumeData = ColumeData + 2 ^ (Y - YInit)
            End If
          Next Y
          sDotLineData = sDotLineData & "0x" & Add0Hex(ColumeData) & ","
        Next X
        
        If j = Len(sAllCharacters) And Page = i Then
          sDotLineData = RTrim1(sDotLineData)
        End If
        
        sDotLineData = sDotLineData & Space(80 - Len(sDotLineData)) & "//" & Ch & IIf(bUseSecondaryFont, "(备用字体)", "") & vbCrLf
        sDotData = sDotData & sDotLineData
      Next Page
      
      pgb.Value = (i - 1) * Len(sAllCharacters) + j
      
    Next j
    sDotData = sDotData & "};" & vbCrLf & vbCrLf
  Next i
    
  pgb.Visible = False
  sCCode = sCCode & sDotData
  txtCode.Text = sCCode
  
  Open txtFile.Text For Output As #1
  Print #1, sCCode
  Close #1
End Sub

Private Sub mnuUndo_Click()
  Call RestoreData
End Sub

Private Sub txtChar_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyA And Shift = 2 Then
    txtChar.SelStart = 0
    txtChar.SelLength = Len(txtChar.Text)
  End If
End Sub


Private Sub txtCode_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyA And Shift = 2 Then
    txtCode.SelStart = 0
    txtCode.SelLength = Len(txtCode.Text)
  End If
End Sub

Private Sub txtCode_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Clipboard.SetText txtCode.SelText
End Sub