morphlcd.ctl

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

'* 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, _
                 VirtualBackgroundDC, ColonPos.TopPoint.x, ColonPos.TopPoint.Y, vbSrcCopy)
      r = BitBlt(hdc, ColonPos.BottomPoint.x, ColonPos.BottomPoint.Y, m_SegmentWidth, m_SegmentWidth, _
                 VirtualBackgroundDC, 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, _
                       VirtualBackgroundDC, DecimalSeparatorPos.x, DecimalSeparatorPos.Y, vbSrcCopy)
         Case [Comma]
            EraseIrregularRegion DECIMAL_SEPARATOR_SEGMENT, DecimalSeparatorPos.x, DecimalSeparatorPos.Y
      End Select
   End If

End Sub

Private Sub EraseIrregularRegion(ByVal RegionIndex As Long, ByVal xPos As Long, ByVal yPos As Long)

'*************************************************************************
'* erases a non-rectangular region by using SelectClipRgn to select the  *
'* desired clipping region.  The subsequent BitBlt blits to the entire   *
'* control, but only the selected clipping region is actually updated    *
'* with control background graphics.  The clipping region is then reset. *
'* I do this with comma separators because the bottom of the comma will  *
'* oftentimes be underneath the lower right corner of the preceding      *
'* digit and a straightforward rectangular blit would erase that lower   *
'* right corner of the preceding digit.  Thanks to LaVolpe for the tip.  *
'*************************************************************************

   Dim r               As Long    ' bitblt function call return.
   Dim CommaClipRegion As Long    ' clipping region for bitblt.

'  move the comma region to the decimal separator position.
   OffsetRgn LCDSegment(RegionIndex), xPos, yPos

'  select a clipping region consisting of the comma decimal separator segment.
   CommaClipRegion = SelectClipRgn(hdc, LCDSegment(RegionIndex))

'  blit the whole background back to the control.  Since the comma clipping region has been
'  selected, only that portion of the background will actually be drawn, thereby erasing the comma.
   r = BitBlt(hdc, 0, 0, ScaleWidth, ScaleHeight, VirtualBackgroundDC, 0, 0, vbSrcCopy)

'  remove the clipping region constraint from the control.
   SelectClipRgn hdc, ByVal 0&

'  delete the selected clipping region.
   DeleteObject CommaClipRegion

'  reset the comma region coordinates to 0,0.
   OffsetRgn LCDSegment(RegionIndex), -xPos, -yPos

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, VirtualBackgroundDC, OffsetX, OffsetY, vbSrcCopy)

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

'  segment 1 (top)
   DisplaySegment LCD(HORIZONTAL_HEXAGONAL_SEGMENT), _
                  OffsetX + HalfSegmentWidth + SegmentGap, _
                  OffsetY, _
                  Mid(DisplayPattern(Digit), 1, 1)

'  segment 2 (top right)
   DisplaySegment LCD(VERTICAL_HEXAGONAL_SEGMENT), _
                  OffsetX + SegmentHeight + DoubleSegmentGap, _
                  OffsetY + HalfSegmentWidth + SegmentGap, _
                  Mid(DisplayPattern(Digit), 2, 1)

'  segment 3 (bottom right)
   DisplaySegment LCD(VERTICAL_HEXAGONAL_SEGMENT), _
                  OffsetX + SegmentHeight + DoubleSegmentGap, _
                  OffsetY + SegmentHeight + HalfSegmentWidth + TripleSegmentGap, _
                  Mid(DisplayPattern(Digit), 3, 1)

'  segment 4 (bottom)
   DisplaySegment LCD(HORIZONTAL_HEXAGONAL_SEGMENT), _
                  OffsetX + HalfSegmentWidth + SegmentGap, _
                  OffsetY + (2 * SegmentHeight) + QuadrupleSegmentGap, _
                  Mid(DisplayPattern(Digit), 4, 1)

'  segment 5 (bottom left)
   DisplaySegment LCD(VERTICAL_HEXAGONAL_SEGMENT), _
                  OffsetX, _
                  OffsetY + SegmentHeight + HalfSegmentWidth + TripleSegmentGap, _
                  Mid(DisplayPattern(Digit), 5, 1)

'  segment 6 (top left)
   DisplaySegment LCD(VERTICAL_HEXAGONAL_SEGMENT), _
                  OffsetX, _
                  OffsetY + HalfSegmentWidth + SegmentGap, _
                  Mid(DisplayPattern(Digit), 6, 1)

'  segment 7 (center)
   DisplaySegment LCD(HORIZONTAL_HEXAGONAL_SEGMENT), _
                  OffsetX + HalfSegmentWidth + SegmentGap, _
                  OffsetY + SegmentHeight + DoubleSegmentGap, _
                  Mid(DisplayPattern(Digit), 7, 1)

End Sub

Private Sub DisplayTrapezoidalSegmentDigit(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 a trapezoidal-segment display digit according to pattern.    *
'*************************************************************************

   Dim Digit As Long    ' the display pattern index of the current digit to draw.