51

51单片机大量源码

   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 shows without this
'     added point, getting a nice smooth diagonal edge is impossible
      tpts(4).x = cx
      tpts(4).Y = tpts(3).Y - 1
      tpts(5).x = tpts(2).x + 1       ' top right
      tpts(5).Y = 0
      tpts(6).x = tpts(1).x - 1       ' top left
      tpts(6).Y = 0
      tpts(7).x = tpts(0).x           ' left apex, close polygon
      tpts(7).Y = tpts(0).Y - 1

   End If

   CreateHexRegion = CreatePolygonRgn(tpts(0), UBound(tpts) + 1, 2)

End Function

Private Function CreateDiagRectRegion(ByVal cx As Long, ByVal cy As Long, SideAStyle As Integer, SideBStyle As Integer) As Long

'**************************************************************************
'* Author: LaVolpe                                                        *
'* the cx & cy parameters are the respective width & height of the region *
'* the passed values may be modified which coder can use for other purp-  *
'* oses like drawing borders or calculating the client/clipping region.   *
'* SideAStyle is -1, 0 or 1 depending on horizontal/vertical shape,       *
'*            reflects the left or top side of the region                 *
'*            -1 draws left/top edge like /                               *
'*            0 draws left/top edge like  |                               *
'*            1 draws left/top edge like  \                               *
'* SideBStyle is -1, 0 or 1 depending on horizontal/vertical shape,       *
'*            reflects the right or bottom side of the region             *
'*            -1 draws right/bottom edge like \                           *
'*            0 draws right/bottom edge like  |                           *
'*            1 draws right/bottom edge like  /                           *
'**************************************************************************

   Dim tpts(0 To 4) As POINTAPI    ' holds polygonal region vertices.

   If cx > cy Then ' horizontal

'     absolute minimum width & height of a trapezoid
      If Abs(SideAStyle + SideBStyle) = 2 Then ' has 2 opposing slanted sides
         If cx < cy * 2 Then cy = cx \ 2
      End If

      If SideAStyle < 0 Then
         tpts(0).x = cy - 1
         tpts(1).x = -1
      ElseIf SideAStyle > 0 Then
         tpts(1).x = cy
      End If
      tpts(1).Y = cy

      tpts(2).x = cx + Abs(SideBStyle < 0)
      If SideBStyle > 0 Then tpts(2).x = tpts(2).x - cy
      tpts(2).Y = cy

      tpts(3).x = cx + Abs(SideBStyle < 0)
      If SideBStyle < 0 Then tpts(3).x = tpts(3).x - cy

   Else

'     absolute minimum width & height of a trapezoid
      If Abs(SideAStyle + SideBStyle) = 2 Then ' has 2 opposing slanted sides
         If cy < cx * 2 Then cx = cy \ 2
      End If

      If SideAStyle < 0 Then
         tpts(0).Y = cx - 1
         tpts(3).Y = -1
      ElseIf SideAStyle > 0 Then
         tpts(3).Y = cx - 1
         tpts(0).Y = -1
      End If

      tpts(1).Y = cy
      If SideBStyle < 0 Then tpts(1).Y = tpts(1).Y - cx
      tpts(2).x = cx

      tpts(2).Y = cy
      If SideBStyle > 0 Then tpts(2).Y = tpts(2).Y - cx
      tpts(3).x = cx

   End If

   tpts(4) = tpts(0)

   CreateDiagRectRegion = CreatePolygonRgn(tpts(0), UBound(tpts) + 1, 2)

End Function

Private Sub RedrawControl()

'*************************************************************************
'* master routine for painting of MorphDisplay control.                  *
'*************************************************************************

   SetBackGround                             ' display background gradient or bitmap.
   CreateBorder                              ' display border if width > 0.
   DisplayValue m_Value, FORCE_REDRAW_YES    ' display the value; force value redraw.

   UserControl.Refresh

End Sub

Private Function TranslateColor(ByVal oClr As OLE_COLOR, Optional hPal As Long = 0) As Long

'*************************************************************************
'* converts color long COLORREF for api coloring purposes.               *
'*************************************************************************

   If OleTranslateColor(oClr, hPal, TranslateColor) Then
      TranslateColor = -1
   End If

End Function

Private Sub InitLCDDisplayCharacteristics()

'*************************************************************************
'* initializes gradients, picture, and border.                           *
'*************************************************************************

   Dim r As Long    ' bitblt function call return.

   ReDim ThousandsFlag(0 To m_NumDigits - 1)

'  create a virtual bitmap that will hold the background gradien