www.pudn.com > DataCollectionSystem.rar > mcLCD.Cls, change:2003-08-21,size:5799b


VERSION 1.0 CLASS 
BEGIN 
  MultiUse = -1  'True 
  Persistable = 0  'NotPersistable 
  DataBindingBehavior = 0  'vbNone 
  DataSourceBehavior  = 0  'vbNone 
  MTSTransactionMode  = 0  'NotAnMTSObject 
END 
Attribute VB_Name = "clsLCD" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = False 
Attribute VB_Exposed = False 
Option Explicit 
 
Private Type Coordinate 
   X As Integer 
   Y As Integer 
End Type 
 
Dim BasePoint As Coordinate 
 
Dim SegWidth As Integer 
Dim SegHeight As Integer 
 
Dim p As PictureBox 
Property Let BackColor(Color As Long) 
 
   p.BackColor = Color 
 
End Property 
 
Private Sub DrawNumber(Number As Integer) 
 
   Select Case Number 
   '画相应数字的图形 
   Case 0 
      DrawSegment (1) 
      DrawSegment (2) 
      DrawSegment (3) 
      DrawSegment (4) 
      DrawSegment (5) 
      DrawSegment (6) 
   Case 1 
      DrawSegment (2) 
      DrawSegment (3) 
   Case 2 
      DrawSegment (1) 
      DrawSegment (2) 
      DrawSegment (7) 
      DrawSegment (5) 
      DrawSegment (4) 
   Case 3 
      DrawSegment (1) 
      DrawSegment (2) 
      DrawSegment (7) 
      DrawSegment (3) 
      DrawSegment (4) 
   Case 4 
      DrawSegment (2) 
      DrawSegment (3) 
      DrawSegment (7) 
      DrawSegment (6) 
   Case 5 
      DrawSegment (1) 
      DrawSegment (6) 
      DrawSegment (7) 
      DrawSegment (3) 
      DrawSegment (4) 
   Case 6 
      DrawSegment (1) 
      DrawSegment (6) 
      DrawSegment (7) 
      DrawSegment (3) 
      DrawSegment (4) 
      DrawSegment (5) 
   Case 7 
      DrawSegment (1) 
      DrawSegment (2) 
      DrawSegment (3) 
   Case 8 
      DrawSegment (1) 
      DrawSegment (2) 
      DrawSegment (3) 
      DrawSegment (4) 
      DrawSegment (5) 
      DrawSegment (6) 
      DrawSegment (7) 
   Case 9 
      DrawSegment (1) 
      DrawSegment (2) 
      DrawSegment (3) 
      DrawSegment (4) 
      DrawSegment (6) 
      DrawSegment (7) 
   End Select 
 
End Sub 
 
 
Private Sub DrawSegment(SegNum As Integer) 
 
' 
'      1 
'     ___ 
'    |   | 
' 6  |   |  2 
'    |-7-| 
' 5  |   |  3 
'    |___| 
' 
'      4 
' 
 
   Select Case SegNum 
   Case 1 
      p.Line (BasePoint.X + 1, BasePoint.Y)-(BasePoint.X + SegWidth - 1, BasePoint.Y) 
      p.Line (BasePoint.X + 2, BasePoint.Y + 1)-(BasePoint.X + SegWidth - 2, BasePoint.Y + 1) 
      p.Line (BasePoint.X + 3, BasePoint.Y + 2)-(BasePoint.X + SegWidth - 3, BasePoint.Y + 2) 
   Case 2 
      p.Line (BasePoint.X + SegWidth - 1, BasePoint.Y + 1)-(BasePoint.X + SegWidth - 1, BasePoint.Y + (SegHeight \ 2) - 1) 
      p.Line (BasePoint.X + SegWidth - 2, BasePoint.Y + 2)-(BasePoint.X + SegWidth - 2, BasePoint.Y + (SegHeight \ 2)) 
      p.Line (BasePoint.X + SegWidth - 3, BasePoint.Y + 3)-(BasePoint.X + SegWidth - 3, BasePoint.Y + (SegHeight \ 2) - 1) 
   Case 3 
      p.Line (BasePoint.X + SegWidth - 1, BasePoint.Y + (SegHeight \ 2) + 2)-(BasePoint.X + SegWidth - 1, BasePoint.Y + SegHeight) 
      p.Line (BasePoint.X + SegWidth - 2, BasePoint.Y + (SegHeight \ 2) + 1)-(BasePoint.X + SegWidth - 2, BasePoint.Y + SegHeight - 1) 
      p.Line (BasePoint.X + SegWidth - 3, BasePoint.Y + (SegHeight \ 2) + 2)-(BasePoint.X + SegWidth - 3, BasePoint.Y + SegHeight - 2) 
   Case 4 
      p.Line (BasePoint.X + 3, BasePoint.Y + SegHeight - 2)-(BasePoint.X + SegWidth - 3, BasePoint.Y + SegHeight - 2) 
      p.Line (BasePoint.X + 2, BasePoint.Y + SegHeight - 1)-(BasePoint.X + SegWidth - 2, BasePoint.Y + SegHeight - 1) 
      p.Line (BasePoint.X + 1, BasePoint.Y + SegHeight)-(BasePoint.X + SegWidth - 1, BasePoint.Y + SegHeight) 
   Case 5 
      p.Line (BasePoint.X, BasePoint.Y + (SegHeight \ 2) + 2)-(BasePoint.X, BasePoint.Y + SegHeight) 
      p.Line (BasePoint.X + 1, BasePoint.Y + (SegHeight \ 2) + 1)-(BasePoint.X + 1, BasePoint.Y + SegHeight - 1) 
      p.Line (BasePoint.X + 2, BasePoint.Y + (SegHeight \ 2) + 2)-(BasePoint.X + 2, BasePoint.Y + SegHeight - 2) 
   Case 6 
      p.Line (BasePoint.X, BasePoint.Y + 1)-(BasePoint.X, BasePoint.Y + (SegHeight \ 2) - 1) 
      p.Line (BasePoint.X + 1, BasePoint.Y + 2)-(BasePoint.X + 1, BasePoint.Y + (SegHeight \ 2)) 
      p.Line (BasePoint.X + 2, BasePoint.Y + 3)-(BasePoint.X + 2, BasePoint.Y + (SegHeight \ 2) - 1) 
   Case 7 
      p.Line (BasePoint.X + 3, BasePoint.Y + (SegHeight \ 2) - 1)-(BasePoint.X + SegWidth - 3, BasePoint.Y + (SegHeight \ 2) - 1) 
      p.Line (BasePoint.X + 2, BasePoint.Y + (SegHeight \ 2))-(BasePoint.X + SegWidth - 2, BasePoint.Y + (SegHeight \ 2)) 
      p.Line (BasePoint.X + 3, BasePoint.Y + (SegHeight \ 2) + 1)-(BasePoint.X + SegWidth - 3, BasePoint.Y + (SegHeight \ 2) + 1) 
   End Select 
 
End Sub 
 
 
Public Property Let Caption(ByVal Value As String) 
Dim OrigX As Integer 
 
   OrigX = BasePoint.X 
   p.Cls 
 
   While Value <> "" 
      If Left$(Value, 1) <> ":" Then 
         DrawNumber (Val(Left$(Value, 1))) 
         BasePoint.X = BasePoint.X + SegWidth + 3 
      Else 
         p.Line (BasePoint.X + (SegWidth \ 2) - 4, BasePoint.Y + (SegHeight \ 2) - 6)-(BasePoint.X + (SegWidth \ 2), BasePoint.Y + (SegHeight \ 2) - 3), , BF 
         p.Line (BasePoint.X + (SegWidth \ 2) - 4, BasePoint.Y + (SegHeight \ 2) + 4)-(BasePoint.X + (SegWidth \ 2), BasePoint.Y + (SegHeight \ 2) + 7), , BF 
         BasePoint.X = BasePoint.X + SegWidth 
      End If 
      Value = Right$(Value, Len(Value) - 1) 
   Wend 
 
   BasePoint.X = OrigX 
 
End Property 
Property Let ForeColor(Color As Long) 
 
   p.ForeColor = Color 
 
End Property 
 
Public Sub NewLCD(PBox As PictureBox) 
 
   Set p = PBox 
    
   p.ScaleMode = 3               ' pixel 
   p.AutoRedraw = True 
    
   BasePoint.X = 2 
   BasePoint.Y = 2 
    
   SegHeight = p.ScaleHeight - 6 
   SegWidth = (SegHeight \ 2) + 2 
 
End Sub