morphlcd.ctl

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

VERSION 5.00
Begin VB.UserControl MorphDisplay 
   AutoRedraw      =   -1  'True
   ClientHeight    =   675
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2565
   ScaleHeight     =   45
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   171
   ToolboxBitmap   =   "MorphLCD.ctx":0000
End
Attribute VB_Name = "MorphDisplay"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：06/02/15
'描    述：LED/LCD数字显示控件
'网    站：http://www.mndsoft.com/
'e-mail  ：[e-mail]
'OICQ    ：88382850
'****************************************************************************'*************************************************************************
'* MorphDisplay v1.00 - Ownerdrawn digital display user control.         *
'* Written January, 2006, by Matthew R. Usner for Planet Source Code.    *
'*************************************************************************
'* MorphDisplay is a digital display control that uses techniques that I *
'* learned by studying LaVolpe's "Shaped Regions" submission (PSC, at    *
'* txtCodeId=58562).  Other open source LCD/LED display controls I have  *
'* found at PSC or other sites depend on basic drawing techniques like   *
'* "Line" or shuffle bitmaps of LEDs around to achieve their goal.  This *
'* control uses shaped regions to form hexagonal, trapezoidal or rect-   *
'* angular digit segments.  Control can be used for calculator displays, *
'* displaying time, or as a simple counter.  Just about every conceivable*
'* aspect of this control can be customized via a multitude of proper-   *
'* ties.  Main and exponent digits separately configurable.  Properties  *
'* for segment height and width, intersegment gap, and interdigit gap    *
'* allow you to size, position and space digits exactly the way you want.*
'* Support for thousands separator and decimal separator.  Thousands and *
'* decimal separators can be defined as a comma or period so that inter- *
'* national standards can be maintained.  Thousands grouping can also be *
'* adjusted according to international preference.  Background bitmap    *
'* can be tiled or stretched.  All colors are also fully user-definable. *
'* Negative numbers can be displayed in a different color than positive. *
'* Corners can be individually rounded for a different look.  A simulated*
'* digit burn-in display mode is also available if desired.  A Filament  *
'* option allows digits to be displayed as wireframed, rather than solid.*
'* The .ShowExponent property allows you to disable exponent display if  *
'* you wish to use this as a simple counter.  Six basic themes are incl- *
'* uded that show various display styles. Since there's ~40 properties   *
'* that make up one theme, it is a real good idea to make a theme out of *
'* a combination of properties that works in a particular application.   *
'*************************************************************************
'* Legal:  Redistribution of this code, whole or in part, as source code *
'* or in binary form, alone or as part of a larger distribution or prod- *
'* uct, is forbidden for any commercial or for-profit use without the    *
'* author's explicit written permission.                                 *
'*                                                                       *
'* Non-commercial redistribution of this code, as source code or in      *
'* binary form, with or without modification, is permitted provided that *
'* the following conditions are met:                                     *
'*                                                                       *
'* Redistributions of source code must include this list of conditions,  *
'* and the following acknowledgment:                                     *
'*                                                                       *
'* This code was developed by Matthew R. Usner.                          *
'* Source code, written in Visual Basic 6.0, is freely available for     *
'* noncommercial, nonprofit use.                                         *
'*                                                                       *
'* Redistributions in binary form, as part of a larger project, must     *
'* include the above acknowledgment in the end-user documentation.       *
'* Alternatively, the above acknowledgment may appear in the software    *
'* itself, if and where such third-party acknowledgments normally appear.*
'*************************************************************************
'* Credits and Thanks:                                                   *
'* LaVolpe, for inspiring this control with his "Shaped Regions" project.*
'* Carles P.V., for the gradient, bitmap tiling, and corner rounding.    *
'* Redbird77, for code examination and optimization.                     *
'*************************************************************************

Option Explicit

' declares for creating, selecting, coloring and destroying the shaped LCD segment regions.
Private Declare Function CreatePolygonRgn Lib "gdi32.dll" (ByRef lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function FillRgn Lib "gdi32.dll" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function FrameRgn Lib "gdi32.dll" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function OffsetRgn Lib "gdi32.dll" (ByVal hRgn As Long, ByVal x As Long, ByVal Y As Long) As Long
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long

' other graphics api declares.
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal nXDest As Long, ByVal nYDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CombineRgn Lib "gdi32.dll" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function CreateDIBPatternBrushPt Lib "gdi32" (lpPackedDIB As Any, ByVal iUsage As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetObjectType Lib "gdi32" (ByVal hgdiobj As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, pccolorref As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetBrushOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nXOrg As Long, ByVal nYOrg As Long, lppt As POINTAPI) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As Any, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpDest As Any, ByRef lpSource As Any, ByVal iLen As Long)
Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)

'  for separator and colon positioning.
Private Type POINTAPI
   x                            As Long
   Y                            As Long
End Type

'  declares for gradient painting and bitmap tiling.
Private Type BITMAPINFOHEADER
   biSize                       As Long
   biWidth                      As Long
   biHeight                     As Long
   biPlanes                     As Integer
   biBitCount                   As Integer
   biCompression                As Long
   biSizeImage                  As Long
   biXPelsPerMeter              As Long
   biYPelsPerMeter              As Long
   biClrUsed                    As Long
   biClrImportant               As Long
End Type

Private Type BITMAP
   bmType                       As Long
   bmWidth                      As Long
   bmHeight                     As Long
   bmWidthBytes                 As Long
   bmPlanes                     As Integer
   bmBitsPixel                  As Integer
   bmBits                       As Long
End Type

Private Const DIB_RGB_COLORS    As Long = 0                 ' also used in gradient generation.
Private Const OBJ_BITMAP        As Long = 7                 ' used to determine if picture is a bitmap.
Private m_hBrush                As Long                     ' pattern brush for bitmap tiling.

'  used to define various graphics areas.
Private Type RECT
   Left                         As Long
   Top                          As Long
   Right                        As Long
   Bottom                       As Long
End Type

'  gradient generation constants.
Private Const RGN_DIFF          As Long = 4
Private Const PI                As Single = 3.14159265358979
Private Const TO_DEG            As Single = 180 / PI
Private Const TO_RAD            As Single = PI / 180
Private Const INT_ROT           As Long = 1000

'  gradient information for background.
Private BGuBIH                  As BITMAPINFOHEADER
Private BGlBits()               As Long

' enum tied to .Theme property.
Public Enum LCDThemeOptions
   [None] = 0
   [LED Hex Small] = 1
   [LED Hex Medium] = 2
   [LCD Trap Small] = 3
   [LCD Trap Medium] = 4
   [Rectangular Medium] = 5
   [Rectangular Small] = 6
End Enum

' enum tied to .ThousandsSeparator and .DecimalSeparator properties.
Public Enum SeparatorOptions
   [Comma] = 0
   [Period] = 1
End Enum

' enum tied to .SegmentStyle and .SegmentStyleExp properties.
Public Enum SegmentStyleOptions
   [Hexagonal] = 0
   [Trapezoidal] = 1
   [Rectangular] = 2
End Enum

' enum tied to .SegmentFillStyle property.
Public Enum SegmentFillStyleOptions
   [Filament] = 0
   [Solid] = 1
End Enum

'  enum tied to .PictureMode property.
Public Enum LCDPicModeOptions
   [Normal] = 0
   [Stretch] = 1
   [Tiled] = 2
End Enum

' holds all segment region pointers for hexagonal/trapezoidal/rectangular LCD display segment types.
Private LCDSegment(0 To 9)      As Long
Private LCDSegmentExp(0 To 9)   As Long

' pointers to the segment currently being created or displayed.
Private Const VERTICAL_HEXAGONAL_SEGMENT              As Long = 0
Private Const HORIZONTAL_HEXAGONAL_SEGMENT            As Long = 1
Private Const HORIZONTAL_DOWNWARD_TRAPEZOIDAL_SEGMENT As Long = 2
Private Const VERTICAL_LEFTWARD_TRAPEZOIDAL_SEGMENT   As Long = 3
Private Const HORIZONTAL_UPWARD_TRAPEZOIDAL_SEGMENT   As Long = 4
Private Const VERTICAL_RIGHTWARD_TRAPEZOIDAL_SEGMENT  As Long = 5
Private Const VERTICAL_RECTANGULAR_SEGMENT            As Long = 6
Private Const HORIZONTAL_RECTANGULAR_SEGMENT          As Long = 7
Private Const DECIMAL_SEPARATOR_SEGMENT               As Long = 8
Private Const THOUSANDS_SEPARATOR_SEGMENT             As Long = 9

' pointers to which LCD digit type we're currently manipulating.
Private Const MAINVALUE         As Long = 0
Private Const EXPONENT          As Long = 1

' segment lit status constants.
Private Const SEGMENT_LIT       As String = "1"
Private Const SEGMENT_UNLIT     As String = "0"

' used by the DisplayValue routine to determine whether value should
' be fully redisplayed (as when property is changed in design mode).
Private Const FORCE_REDRAW_YES  As Boolean = True
Private Const FORCE_REDRAW_NO   As Boolean = False

Private LCDLitColorBrush        As Long                     '  color brush for lit segments.
Private LCDBurnInColorBrush     As Long                     '  color brush for 'burn-in' segments.
Private LCDLitColorBrushNeg     As Long                     '  for when value is negative.
Private LCDBurnInColorBrushNeg  As Long                     '  for when value is negative.
Private CurrentLitColorBrush    As Long                     '  which lit segment brush we're currently using.
Private CurrentBurnInColorBrush As Long                     '  which 'burn-in' brush we're currently using.

'  holds binary string patterns indicating which segments to "light up".
'  0-9, unlit segment, minus sign and hex A-F.  18 patterns total.
Private DisplayPattern(0 To 17) As String

Private Const MAX_DIGITS                   As Long = 50     '  maximum displayable number of digits.
Private DigitXPos(0 To MAX_DIGITS - 1)     As Long          '  X coordinate of each main value digit.
Private DigitXPosExp(0 To 4)               As Long          '  X coordinate of each exponent digit.
Private ThousandsFlag()                    As Boolean       '  thousands separator flag for after each digit.

' X and Y coordinates of the decimal separator.
Private DecimalSeparatorPos As POINTAPI

' X and Y coordinates of each 'dot' in the colon.
Private Type ColonCoordinateType
   TopPoint                     As POINTAPI
   BottomPoint                  As POINTAPI
End Type
Private ColonPos                As ColonCoordinateType

'  the widths and heights of main and exponent LCD digits.
Private DigitWidth              As Long                     ' width of a main value digit, in pixels.