窗口.frm

51单片机控制LED点阵式汉显系统制作资料

End Sub

'Initialize the controls's state
Private Sub InitMaskControls()
    picMask(0).Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
    
    frmFont.Enabled = False
    chkWH.Enabled = False
End Sub


Private Sub InitShape()
    Dim i As Long, j As Long
    
    Shape1(0).Shape = INIT_SHAPE
    W = Shape1(0).Width + DISTANCE
    H = Shape1(0).Height + DISTANCE
    
    For i = 0 To row_1
        For j = 0 To col_1
            If (i + j) Then
                Load Shape1(i * (1 + col_1) + j)
                Shape1(i * (1 + col_1) + j).Move Shape1(0).Left + j * (W), Shape1(0).Top + i * (H)
                Shape1(i * (1 + col_1) + j).Visible = True
            End If
        Next
    Next

    optSquare.value = IIf(INIT_SHAPE = vbShapeSquare, True, False)
    optCircle.value = IIf(INIT_SHAPE = vbShapeCircle, True, False)
    
End Sub

Private Sub InitColor()
    color(1, 1) = "&H40"
    color(1, 2) = "&HFF"
    
    color(2, 1) = "&H4000"
    color(2, 2) = "&HFF00"
    
    color(3, 1) = "&H400000"
    color(3, 2) = "&HFF0000"
    
    color(4, 1) = "&H4040"
    color(4, 2) = "&HFFFF"
    
    color(5, 1) = "&H404000"
    color(5, 2) = "&HFFFF00"
    
    color(6, 1) = "&H400040"
    color(6, 2) = "&HFF00FF"
    
    m_nColor = INIT_COLOR
End Sub

Private Sub InitPictureBox(pic As PictureBox)
'HFONT CreateFont(
'  int nHeight,             // logical height of font
'  int nWidth,              // logical average character width
'  int nEscapement,         // angle of escapement
'  int nOrientation,        // base-line orientation angle
'  int fnWeight,            // font weight
'  DWORD fdwItalic,         // italic attribute flag
'  DWORD fdwUnderline,      // underline attribute flag
'  DWORD fdwStrikeOut,      // strikeout attribute flag
'  DWORD fdwCharSet,        // character set identifier
'  DWORD fdwOutputPrecision,  // output precision
'  DWORD fdwClipPrecision,  // clipping precision
'  DWORD fdwQuality,        // output quality
'  DWORD fdwPitchAndFamily,  // pitch and family
'  LPCTSTR lpszFace         // pointer to typeface name string
');
 
    With pic
        .ScaleMode = vbUser
        .ScaleHeight = ROW
        .ScaleWidth = COL
    End With
    
    Call ChangeFont(pic)
    
End Sub

Private Sub ChangeFont(pic As PictureBox)

    Dim bBold As Boolean, bItalic As Boolean, bUnderline As Boolean, bStrikeThrough As Boolean
    
    bBold = (chkBold.value = vbChecked)
    bItalic = (chkItalic.value = vbChecked)
    bUnderline = (chkUnderline.value = vbChecked)
    bStrikeThrough = (chkStrikeThrough.value = vbChecked)
    
    If oldFont <> 0 Then
        SelectObject curDC, oldFont
        DeleteObject oldFont
    End If
    
    If (chkWH.value = vbChecked) Then
        curFont = CreateFont(-160, 160, 0, 0, IIf(bBold, 700, 400), bItalic, bUnderline, bStrikeThrough, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, FF_DONTCARE, "宋体")
    Else
        curFont = CreateFont(-160, 80, 0, 0, IIf(bBold, 700, 400), bItalic, bUnderline, bStrikeThrough, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, FF_DONTCARE, "宋体")
    End If
    
    If (curDC = 0) Then curDC = GetDC(pic.hwnd)
    
    If (curFont <> 0 And curDC <> 0) Then
        
        If oldFont = 0 Then
            
            oldFont = SelectObject(curDC, curFont)
        
        Else
            
            SelectObject curDC, curFont
        
        End If
    
    End If
    
    Call DrawPic(pic, txtInput.Text)
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If (oldFont <> 0 And curDC <> 0) Then
        SelectObject curDC, oldFont
        DeleteObject curFont
    End If
    If curDC <> 0 Then ReleaseDC picOutput.hwnd, curDC
End Sub





Private Sub ImageLeft_Click()
    Dim i As Long
    Dim j As Long
    
       For j = 0 To col_1 Step 1
    
            If m_bHighLight(j, 0) = True Then Exit Sub
    
       Next
    
 
    For i = 0 To row_1 - 1 Step 1
        
        For j = 0 To col_1 Step 1
           
          m_bHighLight(j, i) = m_bHighLight(j, i + 1)
        
         If i = 14 Then m_bHighLight(j, 15) = False
                  
        Next

    Next
    
    DrawShape

End Sub



Private Sub ImageRight_Click()
    Dim i As Long
    Dim j As Long
    
       For j = 0 To col_1 Step 1
    
            If m_bHighLight(j, 15) = True Then Exit Sub
    
       Next

    
        
    For i = row_1 To 1 Step -1
        
        For j = 0 To col_1 Step 1
       
          m_bHighLight(j, i) = m_bHighLight(j, i - 1)
          
          If i = 1 Then m_bHighLight(j, 0) = False
        
        Next

    Next
    
    DrawShape

End Sub



Private Sub ImageUp_Click()
    Dim i As Long
    Dim j As Long
    
       For i = 0 To row_1 Step 1
    
            If m_bHighLight(0, i) = True Then Exit Sub
    
       Next
    
 
     For j = 0 To col_1 - 1 Step 1
 
        For i = 0 To row_1 Step 1
        
       
           
          m_bHighLight(j, i) = m_bHighLight(j + 1, i)
        
         If j = 14 Then m_bHighLight(15, i) = False
                  
        Next

    Next
    
    DrawShape

End Sub




Private Sub ImageDown_Click()
    Dim i As Long
    Dim j As Long
    
       For i = 0 To row_1 Step 1
    
            If m_bHighLight(15, i) = True Then Exit Sub
    
       Next
    
 
     For j = col_1 To 1 Step -1
 
        For i = 0 To row_1 Step 1
        
       
           
          m_bHighLight(j, i) = m_bHighLight(j - 1, i)
        
         If j = 1 Then m_bHighLight(0, i) = False
                  
        Next

    Next
    
    DrawShape

End Sub













Private Sub lblMail_Click()
    ShellExecute Me.hwnd, "Open", "Mailto:[e-mail]", vbNullString, vbNullString, SW_SHOWNORMAL
End Sub

Private Sub lblReverse_Click()
    Dim i As Long, j As Long
    
    For i = 0 To row_1
    
        For j = 0 To col_1
        
            m_bHighLight(i, j) = Not m_bHighLight(i, j)
            
        Next
        
    Next
    
    Call DrawShape
End Sub

Private Sub lblWeb_Click()
    ShellExecute Me.hwnd, "Open", "http://xsoft.blog.edu.cn", vbNullString, vbNullString, SW_SHOWNORMAL
End Sub

Private Sub optASM_C51_Click(Index As Integer)
    mode = Index + 1
End Sub

Private Sub optColor_Click(Index As Integer)
    m_nColor = Index
    Call DrawShape
End Sub

Private Sub optSquare_Click()
    Dim i As Long, j As Long
    For i = 0 To row_1
        For j = 0 To col_1
            Shape1(i * (col_1 + 1) + j).Shape = vbShapeSquare
        Next
    Next
End Sub

Private Sub optCircle_Click()
    Dim i As Long, j As Long
    For i = 0 To row_1
        For j = 0 To col_1
            Shape1(i * (col_1 + 1) + j).Shape = vbShapeCircle
        Next
    Next
End Sub


'change the point's color which had been clicked
Private Sub PicFrame_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then Exit Sub
    
    Dim i As Long, j As Long
    
    X = X - Shape1(0).Left
    Y = Y - Shape1(0).Top
    
    If (X < 0 Or Y < 0 Or X > W * (1 + row_1) Or Y > H * (1 + row_1)) Then
        Exit Sub
    End If
    
    i = Y \ (H)
    j = X \ (W)
    
    m_bHighLight(i, j) = Not m_bHighLight(i, j)
    
    Shape1(i * (col_1 + 1) + j).FillColor = IIf(m_bHighLight(i, j), color(m_nColor, 2), color(m_nColor, 1))
End Sub

Private Sub DrawShape()
    Dim i As Long, j As Long
    
    For i = 0 To 15
        For j = 0 To 15
            Shape1(j * (col_1 + 1) + i).FillColor = IIf(m_bHighLight(j, i), color(m_nColor, 2), color(m_nColor, 1))
        Next
    Next
End Sub



Private Sub txtInput_Change()

    If Len(txtInput) = 0 Then Exit Sub
    
    If Asc(txtInput) > 0 Then
        chkWH.Enabled = True 'is English,can be bold
        frmFont.Enabled = True 'can choose font effect
        chkWH.value = vbChecked
        chkBold.value = vbChecked
    Else
        chkWH.value = vbUnchecked
        chkBold.value = vbUnchecked
        frmFont.Enabled = False
        chkWH.Enabled = False
    End If
    
    Call DrawPic(picOutput, txtInput.Text)
End Sub

Private Sub txtInput_GotFocus()
    txtInput.SelStart = 0
    txtInput.SelLength = 1
End Sub

Private Sub txtInput_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    txtInput.SelStart = 0
    txtInput.SelLength = 1
End Sub