morphlcd.ctl

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

   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

   DoubleSegmentGap = 2 * SegmentGap
   TripleSegmentGap = 3 * SegmentGap
   QuadrupleSegmentGap = 4 * SegmentGap

'  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_DOWNWARD_TRAPEZOIDAL_SEGMENT), _
                  OffsetX + SegmentGap, _
                  OffsetY, _
                  Mid(DisplayPattern(Digit), 1, 1)

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

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

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

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

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

'  segment 7 (middle)
   DisplaySegment LCD(HORIZONTAL_HEXAGONAL_SEGMENT), _
                  OffsetX + SegmentGap, _
                  OffsetY + SegmentHeight + DoubleSegmentGap - (SegmentWidth \ 2), _
                  Mid(DisplayPattern(Digit), 7, 1)

End Sub

Private Sub DisplayRectangularSegmentDigit(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 rectangular-segment display digit according to 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 DoubleSegmentWidth  As Long

   DoubleSegmentGap = 2 * SegmentGap
   TripleSegmentGap = 3 * SegmentGap
   QuadrupleSegmentGap = 4 * SegmentGap
   DoubleSegmentWidth = 2 * SegmentWidth

'  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_RECTANGULAR_SEGMENT), _
                  OffsetX + SegmentWidth + SegmentGap - 1, _
                  OffsetY, _
                  Mid(DisplayPattern(Digit), 1, 1)

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

'  segment 3 (bottom right)
   DisplaySegment LCD(VERTICAL_RECTANGULAR_SEGMENT), _
                  OffsetX + SegmentWidth + SegmentHeight + DoubleSegmentGap - 2, _
                  OffsetY + SegmentHeight + DoubleSegmentWidth + TripleSegmentGap - 3, _
                  Mid(DisplayPattern(Digit), 3, 1)

'  segment 4 (bottom)
   DisplaySegment LCD(HORIZONTAL_RECTANGULAR_SEGMENT), _
                  OffsetX + SegmentWidth + SegmentGap - 1, _
                  OffsetY + (2 * SegmentHeight) + DoubleSegmentWidth + QuadrupleSegmentGap - 4, _
                  Mid(DisplayPattern(Digit), 4, 1)

'  segment 5 (bottom left)
   DisplaySegment LCD(VERTICAL_RECTANGULAR_SEGMENT), _
                  OffsetX, _
                  OffsetY + SegmentHeight + DoubleSegmentWidth + TripleSegmentGap - 3, _
                  Mid(DisplayPattern(Digit), 5, 1)

'  segment 6 (top left)
   DisplaySegment LCD(VERTICAL_RECTANGULAR_SEGMENT), _
                  OffsetX, _
                  OffsetY + SegmentWidth + SegmentGap - 1, _
                  Mid(DisplayPattern(Digit), 6, 1)

'  segment 7 (center)
   DisplaySegment LCD(HORIZONTAL_RECTANGULAR_SEGMENT), _
                  OffsetX + SegmentWidth + SegmentGap - 1, _
                  OffsetY + SegmentHeight + SegmentWidth + DoubleSegmentGap - 2, _
                  Mid(DisplayPattern(Digit), 7, 1)

End Sub

Private Function GetDisplayPatternIndex(ByVal strDigit As String) As Long

'*************************************************************************
'* returns correct segment lighting pattern index for supplied digit.    *
'*************************************************************************

   If strDigit = " " And m_ShowBurnIn Then
'     for showing unlit digits in burn-in display mode.
      GetDisplayPatternIndex = 10
   ElseIf strDigit = " " Then
'     if not showing burn-in pattern, don't mess with an unlit digit at all.
      GetDisplayPatternIndex = -1
   ElseIf strDigit = "-" Then
'     the pattern index for the minus sign.
      GetDisplayPatternIndex = 11
   ElseIf InStr("ABCDEF", strDigit) Then
'     the pattern index for the appropriate hex value A-F.
      GetDisplayPatternIndex = Asc(strDigit) - 53
   Else
'     the appropriate pattern index for the supplied digit.
      GetDisplayPatternIndex = Val(strDigit)
   End If

End Function

Private Sub DisplaySegment(ByVal Segment As Long, ByVal StartX As Long, ByVal StartY As Long, ByVal LitStatus As String)

'*************************************************************************
'* displays one segment of an LCD digit according to its fill style.     *
'*************************************************************************

'  position the segment region in the correct location.
   OffsetRgn Segment, StartX, StartY

   If LitStatus = SEGMENT_UNLIT And m_ShowBurnIn Then
'     if segment is unlit but burn-in mode is active, display as unlit according to fill mode.
      If m_SegmentFillStyle = [Solid] Then
         FillRgn hdc, Segment, CurrentBurnInColorBrush
      Else
         FrameRgn hdc, Segment, CurrentBurnInColorBrush, 1, 1
      End If
   Else
      If LitStatus = SEGMENT_LIT Then
'        otherwise, if segment is lit, display according to fill mode.
         If m_SegmentFillStyle = [Solid] Then
            FillRgn hdc, Segment, CurrentLitColorBrush
         Else
            FrameRgn hdc, Segment, CurrentLitColorBrush, 1, 1
         End If
      End If
   End If

'  reset the region location to (0, 0) to prepare for the next segment draw.
   OffsetRgn Segment, -StartX, -StartY

End Sub

Private Function CreateHexRegion(ByVal cx As Long, ByVal cy As Long) As Long

'*************************************************************************
'* Author: LaVolpe                                                       *
'* creates a horizontal/vertical hex region with perfectly smooth edges. *
'* the cx & cy parameters are respective width & height of the region.   *
'* passed values may be modified which coder can use for other purposes  *
'* like drawing borders or calculating the client/clipping region.       *
'*************************************************************************

   Dim tpts(0 To 7) As POINTAPI    ' holds polygon region vertices.

   If cy > cx Then             ' vertical hex vs horizontal

'     absolute minimum width & height of a hex region
      If cx < 4 Then
         cx = 4
      End If
'     ensure width is even
      If cx Mod 2 Then
         cx = cx - 1
      End If

'     calculate the vertical hex.
      tpts(0).x = cx \ 2              ' bot apex
      tpts(0).Y = cy
      tpts(1).x = cx                  ' bot right
      tpts(1).Y = cy - tpts(0).x
      tpts(2).x = cx                  ' top right
      tpts(2).Y = tpts(0).x - 1
      tpts(3).x = tpts(0).x           ' top apex
      tpts(3).Y = -1
'     add an extra point & modify; trial & error shows without this
'     added point, getting a nice smooth diagonal edge is impossible
      tpts(4).x = tpts(0).x - 1       ' added
      tpts(4).Y = 0
      tpts(5).x = 0                   ' top left
      tpts(5).Y = tpts(2).Y
      tpts(6).x = 0                   ' bot left
      tpts(6).Y = tpts(1).Y
      tpts(7) = tpts(0)               ' bot apex, close polygon

   Else

'     absolute minimum width & height of a hex region
      If cy < 4 Then
         cy = 4
      End If

'     ensure height is even
      If cy Mod 2 Then
         cy = cy - 1
      End If

'     calculate the horizontal hex.
      tpts(0).x = 0                   ' left apex
      tpts(0).Y = cy \ 2
      tpts(1).x = tpts(0).Y           ' bot left
      tpts(1).Y = cy
      tpts(2).x = cx - tpts(0).Y      ' bot right
      tpts(2).Y = tpts(1).Y
      tpts(3).x = cx                  ' right apex
      tpts(3).Y = tpts(0).Y
'     add an extra point & modify; trial & error sh