morphlcd.ctl

一个简单的电子看板程序,可根据需要设定节拍时间

   Dim ExpPos       As Long      ' position in value of exponent symbols E+ or E-.
   Dim ExponentSign As String    ' what sign the exponent is (+ or -).

   If InStr(sValue, "E+") > 0 Or InStr(sValue, "E-") > 0 Then

'     since we see an "E" followed by a "+" or "-" we know it's the base-10
'     exponent "E", not hex "E".  Separate the main value and exponent.
      ExpPos = InStr(sValue, "E+")
      If ExpPos = 0 Then
         ExpPos = InStr(sValue, "E-")
      End If
      sMainValue = Left(sValue, ExpPos - 1)
      ExponentSign = Mid(sValue, ExpPos + 1, 1)
      ExponentValue = Right(sValue, Len(sValue) - ExpPos - 1)

'     grab appropriate part of exponent depending on whether
'     we're displaying calculation result exponent or seconds.
      If InStr(sValue, ":") = 0 Then
         ExponentValue = Right(String(m_NumDigitsExp - 1, "0") & ExponentValue, m_NumDigitsExp - 1)
      Else
         ExponentValue = Right(String(m_NumDigitsExp - 1, "0") & ExponentValue, m_NumDigitsExp)
      End If
      If ExponentSign = "-" Then
         ExponentValue = ExponentSign & ExponentValue
      Else
         ExponentValue = " " & ExponentValue
      End If
      SeparateMainValueAndExponent = True

   Else

'     could be hex, or a non-exponential decimal value.  Just return the original value.
      sMainValue = sValue
      ExponentValue = String(m_NumDigitsExp, " ")

   End If

End Function

Private Sub DisplayMainValue(strValue As String, ByVal ForceDisplay As Boolean)

'*************************************************************************
'* displays non-exponent portion of value stored in .Value property.     *
'*************************************************************************

   Dim s            As String    ' right-justified version of value.
   Dim i            As Long      ' loop variable.
   Dim CurrentDigit As String    ' the current digit being displayed.

   s = strValue

'  determine thousands separator placement, if they are to be displayed.
   If m_ShowThousandsSeparator Then
      DetermineThousandsSeparatorPlacement s
      DisplayThousandsSeparators
   End If

'  erase old decimal separator if displayed; display new one if necessary.
   ProcessDecimalSeparator s

'  erase old colon if displayed; display new one if necessary.
   ProcessColon s

'  pad the value with leading spaces.
   s = Right(Space(m_NumDigits) & s, m_NumDigits)

'  display the main value.  Only draw a digit if the particular digit being
'  drawn is different from digit the previous time value was displayed.
   Select Case m_SegmentStyle

      Case [Hexagonal]
         For i = 1 To m_NumDigits
            CurrentDigit = Mid(s, i, 1)
            If (CurrentDigit <> Mid(PreviousMainValue, i, 1)) Or ForceDisplay Then
               DisplayHexagonalSegmentDigit CurrentDigit, LCDSegment(), _
                                            DigitXPos(i - 1), m_YOffset, _
                                            m_SegmentHeight, m_SegmentWidth, _
                                            m_InterSegmentGap, DigitWidth, DigitHeight
            End If
         Next i

      Case [Trapezoidal]
         For i = 1 To m_NumDigits
            CurrentDigit = Mid(s, i, 1)
            If (CurrentDigit <> Mid(PreviousMainValue, i, 1)) Or ForceDisplay Then
               DisplayTrapezoidalSegmentDigit CurrentDigit, LCDSegment(), _
                                              DigitXPos(i - 1), m_YOffset, _
                                              m_SegmentHeight, m_SegmentWidth, _
                                              m_InterSegmentGap, DigitWidth, DigitHeight
            End If
         Next i

      Case [Rectangular]
         For i = 1 To m_NumDigits
            CurrentDigit = Mid(s, i, 1)
            If (CurrentDigit <> Mid(PreviousMainValue, i, 1)) Or ForceDisplay Then
               DisplayRectangularSegmentDigit CurrentDigit, LCDSegment(), _
                                              DigitXPos(i - 1), m_YOffset, _
                                              m_SegmentHeight, m_SegmentWidth, _
                                              m_InterSegmentGap, DigitWidth, DigitHeight
            End If
         Next i

   End Select

   UserControl.Refresh

'  save the displayed value so we know which LCD digits
'  to update the next time we need to display a value.
   PreviousMainValue = s

End Sub

Private Sub DisplayExponentValue(strValue As String, ByVal ForceDisplay As Boolean)

'*************************************************************************
'* displays exponent portion of value stored in .Value property.         *
'*************************************************************************

   Dim s            As String    ' right-justified version of exponent.
   Dim i            As Long      ' loop variable.
   Dim CurrentDigit As String    ' the current digit we're displaying.

   s = Right(Space(m_NumDigitsExp) & strValue, m_NumDigitsExp)

'  display the exponent.  Only draw a digit if the particular digit being
'  drawn is different from digit the previous time value was displayed.
   Select Case m_SegmentStyleExp

      Case [Hexagonal]
         For i = 1 To m_NumDigitsExp
            CurrentDigit = Mid(s, i, 1)
            If (CurrentDigit <> Mid(PreviousExponentValue, i, 1)) Or ForceDisplay Then
               DisplayHexagonalSegmentDigit CurrentDigit, LCDSegmentExp(), _
                                            DigitXPosExp(i - 1), m_YOffsetExp, _
                                            m_SegmentHeightExp, m_SegmentWidthExp, _
                                            m_InterSegmentGapExp, DigitWidthExp, DigitHeightExp
            End If
         Next i

      Case [Trapezoidal]
         For i = 1 To m_NumDigitsExp
            CurrentDigit = Mid(s, i, 1)
            If (CurrentDigit <> Mid(PreviousExponentValue, i, 1)) Or ForceDisplay Then
               DisplayTrapezoidalSegmentDigit CurrentDigit, LCDSegmentExp(), _
                                              DigitXPosExp(i - 1), m_YOffsetExp, _
                                              m_SegmentHeightExp, m_SegmentWidthExp, _
                                              m_InterSegmentGapExp, DigitWidthExp, DigitHeightExp
            End If
         Next i

      Case [Rectangular]
         For i = 1 To m_NumDigitsExp
            CurrentDigit = Mid(s, i, 1)
            If (CurrentDigit <> Mid(PreviousExponentValue, i, 1)) Or ForceDisplay Then
               DisplayRectangularSegmentDigit CurrentDigit, LCDSegmentExp(), _
                                              DigitXPosExp(i - 1), m_YOffsetExp, _
                                              m_SegmentHeightExp, m_SegmentWidthExp, _
                                              m_InterSegmentGapExp, DigitWidthExp, DigitHeightExp
            End If
         Next i

   End Select

   UserControl.Refresh

'  save the displayed value so we know which LCD digits
'  to update the next time we need to display a value.
   PreviousExponentValue = s

End Sub

Private Sub DetermineThousandsSeparatorPlacement(ByVal sVal As String)

'*************************************************************************
'* determines which digits in the main value get a thousands separator   *
'* afterwards.  ThousandsFlag() elements that correspond to LCD digits   *
'* that need to be followed by a thousands separator are set to True.    *
'* Thanks to Redbird77 for optimizing this routine.                      *
'*************************************************************************

   Dim i    As Long      ' loop variable.
   Dim p1   As Long      ' position of first non-zero/minus sign digit.
   Dim p2   As Long      ' position of decimal separator.
   Dim sTmp As String    ' padded value.

'  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, _
                          VirtualBackgroundDC, xPos, yPos, vbSrcCopy)
            Case [Comma]
               EraseIrregularRegion 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 *