morphlcd.ctl

串口通讯。上位机实例.提供了良好的界面。对初学者很有参考性

'  reset the ThousandsFlag boolean array to all False.  (Remember that False
'  is an integer (2-byte) value equal to zero, so this is a lightning-quick
'  way to set a dynamic boolean array, as opposed to looping.)
   FillMemory ThousandsFlag(0), 2 * m_NumDigits, False

'  Add decimal point to end if whole number.
   If InStr(sVal, ".") = 0 Then
      sVal = sVal & "."
   End If

'  left-pad value.
   sTmp = Right$(String$(m_NumDigits, "0") & sVal, m_NumDigits)

'  get position of decimal point.
   p2 = InStr(sTmp, ".")

'  get position of first non-zero and non-minus sign digit.
   p1 = m_NumDigits - Len(sVal) + 1
   If Mid$(sTmp, p1, 1) = "-" Then
      p1 = p1 + 1
   End If

'  flag appropriate digits that receive a decimal separator after them.
   For i = p2 - (m_ThousandsGrouping + 1) To p1 Step -m_ThousandsGrouping
      ThousandsFlag(i) = True
   Next i

End Sub

Private Sub DisplayThousandsSeparators()

'*************************************************************************
'* display needed thousands separators and erase any others.             *
'*************************************************************************

   Dim i    As Long   ' loop index.
   Dim r    As Long   ' bitblt function call return.
   Dim XPos As Long   ' x coordinate of thousands separator.
   Dim YPos As Long   ' y coordinate of thousands separator.

'  determine the Y coordinate of the thousands separator. If digit
'  segment style is rectangular, 1 is subtracted from Y coordinate.
   Select Case m_ThousandsSeparator
      Case [Period]
         YPos = m_YOffset + DigitHeight - m_SegmentWidth + 1 + (m_SegmentStyle = [Rectangular])
      Case [Comma]
         YPos = m_YOffset + DigitHeight - m_SegmentWidth - 1
   End Select

   For i = 0 To m_NumDigits - 1

'     calculate the starting X coordinates for the thousands separator.
      Select Case m_ThousandsSeparator
         Case [Period]
            XPos = DigitXPos(i) + DigitWidth + (m_InterDigitGap \ 2) - (m_SegmentWidth \ 2)
         Case [Comma]
            XPos = DigitXPos(i) + (DigitWidth) - (m_SegmentWidth)
      End Select

      If ThousandsFlag(i) Then
'        display a thousands separator.
         DisplaySegment LCDSegment(), THOUSANDS_SEPARATOR_SEGMENT, XPos, YPos, SEGMENT_LIT
      Else
'        make sure a possible previous thousands separator is erased.
         Select Case m_ThousandsSeparator
            Case [Period]
               r = BitBlt(hdc, XPos, YPos, m_SegmentWidth, m_SegmentWidth, VirtualDC_BG, XPos, YPos, vbSrcCopy)
            Case [Comma]
               OffsetRgn LCDSegment(THOUSANDS_SEPARATOR_SEGMENT), XPos, YPos
               BlitToRegion VirtualDC_BG, hdc, ScaleWidth, ScaleHeight, LCDSegment(THOUSANDS_SEPARATOR_SEGMENT), XPos, YPos
               OffsetRgn LCDSegment(THOUSANDS_SEPARATOR_SEGMENT), -XPos, -YPos
         End Select
      End If

   Next i

End Sub

Private Sub ProcessColon(ByRef s As String)

'*************************************************************************
'* erases old colon, if one was displayed.  Displays new colon if needed *
'* and removes colon from passed value string.                           *
'* NOTE:  To use this control as a clock display, set the number of main *
'* value digits to 4, and the number of exponent digits to 2.  Pass the  *
'* time (either 12- or 24-hour mode) to the .Value property like this:   *
'* HH:MMe+SS, where HH:MM is the hours:minutes, and SS is the seconds.   *
'* The 'e+' tricks control into displaying the seconds in the exponent   *
'* part of the display.  If you wish to just display hours and minutes,  *
'* set the .ShowExponent property to False and just send HH:MM.          *
'*************************************************************************

   EraseOldColon
   DrawNewColon s

End Sub

Private Sub EraseOldColon()

'*************************************************************************
'* erases previously drawn colon by drawing background over it.          *
'*************************************************************************

   Dim r As Long    ' bitblt function call return.

'  only bother if there was actually a displayed colon.
   If ColonPos.TopPoint.X > -1 Then
      r = BitBlt(hdc, ColonPos.TopPoint.X, ColonPos.TopPoint.Y, m_SegmentWidth, m_SegmentWidth, _
                 VirtualDC_BG, ColonPos.TopPoint.X, ColonPos.TopPoint.Y, vbSrcCopy)
      r = BitBlt(hdc, ColonPos.BottomPoint.X, ColonPos.BottomPoint.Y, m_SegmentWidth, m_SegmentWidth, _
                 VirtualDC_BG, ColonPos.BottomPoint.X, ColonPos.BottomPoint.Y, vbSrcCopy)
   End If

End Sub

Private Sub DrawNewColon(ByRef s As String)

'*************************************************************************
'* draws new colon in correct location.                                  *
'*************************************************************************

   Dim i As Long    ' position of colon within value to be displayed.

'  check for existence of colon in value to be displayed.
   i = InStr(s, ":")

   If i > 0 Then

'     if colon needed, calculate the starting X and Y coordinates of each 'dot'.
      ColonPos.TopPoint.X = DigitXPos(i - 1 + (m_NumDigits - Len(s))) + DigitWidth + (m_InterDigitGap \ 2) - (m_SegmentWidth \ 2) + 1
      ColonPos.BottomPoint.X = ColonPos.TopPoint.X
      ColonPos.TopPoint.Y = m_YOffset + m_SegmentHeight \ 2 + m_SegmentWidth \ 2
      ColonPos.BottomPoint.Y = ColonPos.TopPoint.Y + m_SegmentHeight

'     display the colon.
      DisplaySegment LCDSegment(), DECIMAL_SEPARATOR_SEGMENT, ColonPos.TopPoint.X, ColonPos.TopPoint.Y, SEGMENT_LIT
      DisplaySegment LCDSegment(), DECIMAL_SEPARATOR_SEGMENT, ColonPos.BottomPoint.X, ColonPos.BottomPoint.Y, SEGMENT_LIT

'     remove the colon from the numeric string to be displayed.
      s = Left(s, i - 1) & Right(s, Len(s) - i)

   Else

'     flag it so control knows no colon has been drawn.
      ColonPos.TopPoint.X = -1

   End If

End Sub

Private Sub ProcessDecimalSeparator(ByRef s As String)

'*************************************************************************
'* erases old decimal point, if one was displayed.  Displays new decimal *
'* point if needed and removes decimal point from passed value string.   *
'*************************************************************************

   EraseOldDecimalSeparator
   DisplayNewDecimalSeparator s

End Sub

Private Sub EraseOldDecimalSeparator()

'*************************************************************************
'* erases previously drawn decimal point by drawing background over it.  *
'*************************************************************************

   Dim r As Long    ' bitblt function call return.

'  only bother if there was actually a displayed decimal separator.
   If DecimalSeparatorPos.X > -1 Then
      Select Case m_DecimalSeparator
         Case [Period]
            r = BitBlt(hdc, DecimalSeparatorPos.X, DecimalSeparatorPos.Y, m_SegmentWidth, m_SegmentWidth, _
                       VirtualDC_BG, DecimalSeparatorPos.X, DecimalSeparatorPos.Y, vbSrcCopy)
         Case [Comma]
            BlitToRegion VirtualDC_BG, hdc, ScaleWidth, ScaleHeight, LCDSegment(DECIMAL_SEPARATOR_SEGMENT), DecimalSeparatorPos.X, DecimalSeparatorPos.Y
      End Select
   End If

End Sub

Private Sub DisplayNewDecimalSeparator(ByRef s As String)

'*************************************************************************
'* draws new decimal separator in correct location.                      *
'*************************************************************************

   Dim i As Long    ' position of decimal point within value to be displayed.

'  check for existence of decimal point in value to be displayed.
   i = InStr(s, ".")

   If i > 0 Then

'     calculate the starting X and Y coordinates for the decimal point.  If digit
'     segment style is rectangular, 1 is subtracted from the Y coordinate.  These
'     coordinates are retained for erasing the decimal separator when necessary.
      Select Case m_DecimalSeparator
         Case [Period]
            DecimalSeparatorPos.X = DigitXPos(i - 1 + (m_NumDigits - Len(s))) + DigitWidth + (m_InterDigitGap \ 2) - (m_SegmentWidth \ 2)
            DecimalSeparatorPos.Y = m_YOffset + DigitHeight - m_SegmentWidth + 1 + (m_SegmentStyle = [Rectangular])
         Case [Comma]
            DecimalSeparatorPos.X = DigitXPos(i - 1 + (m_NumDigits - Len(s))) + (DigitWidth) - (m_SegmentWidth)
            DecimalSeparatorPos.Y = m_YOffset + DigitHeight - m_SegmentWidth - 1
      End Select

'     display the decimal separator.
      DisplaySegment LCDSegment(), DECIMAL_SEPARATOR_SEGMENT, DecimalSeparatorPos.X, DecimalSeparatorPos.Y, SEGMENT_LIT

'     remove the decimal separator from the numeric string to be displayed.
      s = Left(s, i - 1) & Right(s, Len(s) - i)

   Else

'     flag it so control knows no decimal separator has been drawn.
      DecimalSeparatorPos.X = -1

   End If

End Sub

Private Sub DisplayHexagonalSegmentDigit(ByVal strDigit As String, ByRef LCD() As Long, _
                                         ByVal OffsetX As Long, ByVal OffsetY As Long, _
                                         ByVal SegmentHeight As Long, ByVal SegmentWidth As Long, _
                                         ByVal SegmentGap As Long, _
                                         ByVal DigWidth As Long, ByVal DigHeight As Long)

'*************************************************************************
'* displays one hex-segment display digit according to string pattern.   *
'*************************************************************************

   Dim Digit               As Long    ' the display pattern index of the current digit to draw.
   Dim r                   As Long    ' bitblt function call return.

'  used to avoid unnecessary recalculations of segment gap multiples.  Just a speed
'  tweak for situations where the display must be updated quickly (as in a counter).
   Dim DoubleSegmentGap    As Long
   Dim TripleSegmentGap    As Long
   Dim QuadrupleSegmentGap As Long
   Dim HalfSegmentWidth    As Long

   DoubleSegmentGap = 2 * SegmentGap
   TripleSegmentGap = 3 * SegmentGap
   QuadrupleSegmentGap = 4 * SegmentGap
   HalfSegmentWidth = SegmentWidth \ 2

'  blit the appropriate portion of the background over the digit position to 'erase' old digit.
'   r = BitBlt(hdc, OffsetX, OffsetY, DigWidth, DigHeight, VirtualDC_BG, OffsetX, OffsetY, vbSrcCopy)
   r = BitBlt(hdc, OffsetX, m_BorderWidth, DigWidth, ScaleHeight - m_BorderWidth * 2, VirtualDC_BG, OffsetX, m_BorderWidth, vbSrcCopy)

'  get the appropriate segment display pattern for the digit.
   Digit = GetDisplayPatternIndex(strDigit)
   If Digit = -1 Then
      Exit Sub
   End If