mclcd.cls

银行定储模拟程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "mcLCD"
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