drawclass.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 = "DrawClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Member0" ,"Size"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'api
'Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal _
                                    Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
'Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, _
                                                            ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 SaveDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function RestoreDC Lib "gdi32" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long


'local variable(s) to hold property value(s)
Private mvarWidthNum As Integer 'local copy
Private mvarHeightNum As Integer 'local copy
Private mvarHDC As Long 'local copy
'Private mvarHwnd As Long 'local copy
Private mvarNumber As Integer 'local copy
Private mvarErrs As String 'local copy
Private mvarTrueX As Integer 'local copy
Private mvarTrueY As Integer 'local copy
Dim SSW As Integer 'SingleSqureWigth
Dim SSH As Integer 'SingleSqureHeight
Private Type Led
    X As Integer '在衬底中的位置
    Y As Integer '在衬底中的位置
    'ID As Integer
    Color As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Dim Leds() As Led
Dim OneTimeFlag As Boolean
Dim Rects As RECT
Private Const CRed = 255 'RGB(255, 0, 0)
Private Const CGreen = 65280 'RGB(0, 255, 0)
Private Const CBlue = 16711680 'RGB(0, 0, 255)
Private Const CWhite = 16777215
Private Const CNull = -1
'local variable(s) to hold property value(s)
'保持属性值的局部变量
Private mvarStyle3D As Boolean '局部复制
Public Property Let Style3D(ByVal vData As Boolean)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.Style3D = 5
    mvarStyle3D = vData
End Property

Public Property Get Style3D() As Boolean
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.Style3D
    Style3D = mvarStyle3D
End Property

Public Sub CloseThis()
OneTimeFlag = False
End Sub



Private Function PubDraw(ByVal Color As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal _
                                            X2 As Long, ByVal Y2 As Long) As Boolean
'Dim Rst As Long
'Rst = CreatePen(PS_NULL, 0, 0)
Dim BrushObj As Long
Dim SDc As Long
If mvarStyle3D Then
    With Rects
        .Left = X1
        .Top = Y1
        .Right = X2 - 1
        .Bottom = Y2 - 1
    End With
Else
    With Rects
        .Left = X1
        .Top = Y1
        .Right = X2
        .Bottom = Y2
    End With
End If
'SDc = SaveDC(mvarHDC)
BrushObj = CreateSolidBrush(Color)
'SelectObject mvarHDC, BrushObj
If FillRect(mvarHDC, Rects, BrushObj) Then
    'RestoreDC mvarHDC, BrushObj
    DeleteObject BrushObj
    PubDraw = True
Else
    mvarErrs = "pubdraw error"
    PubDraw = False
End If
End Function

'Private Function N2XY(Number As Integer) As Integer
'Dim Rst(0 To 1) As Integer
'Rst(0) = mvarWidthNum
'Rst(1) = mvarHeightNum
'N2XY = Rst()
'End Function

Public Sub Draw(ByVal Number As Integer, ByVal Color As Long)
If OneTimeFlag Then
    If SSW < 1 Or SSH < 1 Or Number = 0 Then
        mvarErrs = "SSW:" + SSW + " SSH:" + SSW + " Number:" + Number
        Exit Sub
    End If
    'Dim Rst(0 To 1) As Integer
    'Rst() = N2XY(Number)
    If Number > 0 And Number <= mvarNumber Then
        If Color = CNull Then
            Call PubDraw(Leds(Number).Color, Leds(Number).X, Leds(Number).Y, Leds(Number).X + SSW, Leds(Number).Y + SSH)
        End If
        If Color > CNull Then
            Call PubDraw(Color, Leds(Number).X, Leds(Number).Y, Leds(Number).X + SSW, Leds(Number).Y + SSH)
        End If
        If Color < CNull Then
            mvarErrs = "Color out of squre"
        End If
    Else
        mvarErrs = "Number out of squre" + " Number:" + Number
    End If
End If
End Sub

Public Function Create(ByVal SizeX As Integer, ByVal SizeY As Integer) As Boolean
If OneTimeFlag = False Then
    'If mvarHwnd = CNull Then
    '    mvarErrs = "mvarHwnd = CNull"
    '    Create = False
    '    Exit Function
    'End If
    If SizeX < 12 Or SizeY < 11 Then
        mvarErrs = "SizeX < 12 Or SizeY < 11"
        Create = False
        Exit Function
    End If
    If mvarWidthNum < 1 Or mvarHeightNum < 1 Then
        mvarErrs = "mvarWidthNum < 1 Or mvarHeightNum < 1"
        Create = False
        Exit Function
    End If
    If mvarHDC = CNull Then
        mvarErrs = "mvarHDC = CNull"
        Create = False
        Exit Function
    End If
    SSW = SizeX / mvarWidthNum
    SSH = SizeY / mvarHeightNum
    'MsgBox SSW + " " + SSH, vbOKOnly, Popup
    If SSW < 1 Or SSH < 1 Then
        mvarErrs = "SSW < 1 Or SSH < 1"
        Create = False
        Exit Function
    End If
    If mvarNumber > 0 Then
        ReDim Leds(1 To mvarNumber)
        Dim I As Integer
        Dim TempX As Integer
        Dim TempY As Integer
        'Dim TempSX As Integer
        'Dim TempSY As Integer
        Dim Switch As Boolean
        TempX = 0
        TempY = 0
        Switch = True
        For I = 1 To mvarNumber
            Leds(I).X = TempX '- 1
            TempX = TempX + SSW '- 1
            Leds(I).Y = TempY '- 1
            If TempX >= SizeX Then
                If Switch Then
                    mvarTrueX = TempX
                    Switch = False
                End If
                TempX = 0
                TempY = TempY + SSH '- 1
            End If
            Leds(I).Color = CWhite
            'Call Draw(I, CNull)
        Next I
        'TempSY = TempY + SSH
    Else
            mvarErrs = "mvarNumber<=0"
            Create = False
            Exit Function
    End If
    mvarTrueY = Leds(mvarNumber).Y + SSH
    'mvarErrs = "ssw:" + SSW * mvarWidthNum + " ssh:" + SSH * mvarHeightNum + " SX:" + SizeX + " SY:" + SizeY
    If PubDraw(RGB(255, 255, 255), 0, 0, mvarTrueX, mvarTrueY) Then
        Create = True
    Else
        mvarErrs = "PubDraw return false"
        Exit Function
    End If
    
    OneTimeFlag = True
    For I = 1 To mvarNumber
        Call Draw(I, CNull)
    Next I
    Create = True
Else
    mvarErrs = "Created ready"
End If
End Function

'**********************************************************************
'以下是这个类的构造函数和析构函数
'**********************************************************************
Private Sub Class_Initialize()
mvarWidthNum = -1
mvarHeightNum = -1
mvarHDC = CNull
mvarNumber = 0
OneTimeFlag = False
mvarErrs = "Nothing"
mvarTrueX = 0
mvarTrueY = 0
SSW = 0
SSH = 0
mvarStyle3D = False
End Sub
Private Sub Class_Terminate()
'DeleteObject (CreateSolidBrush)
'DeleteObject (Rectangle)
End Sub

Public Property Let HeightNum(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.HeightNum = 5
    mvarHeightNum = vData
End Property

Public Property Get HeightNum() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.HeightNum
    HeightNum = mvarHeightNum
End Property

Public Property Let WidthNum(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.WidthNum = 5
    mvarWidthNum = vData
End Property


Public Property Get WidthNum() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.WidthNum
    WidthNum = mvarWidthNum
End Property
Public Property Let hdc(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.WidthNum = 5
    mvarHDC = vData
End Property
'Public Property Let Hwnd(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.WidthNum = 5
'     mvarHwnd = vData
'End Property
Public Property Let TotalNumber(ByVal vData As Long)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.WidthNum = 5
     mvarNumber = vData
End Property

Public Property Get Errs() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.WidthNum
    Errs = mvarErrs
End Property

'Public Property Let TrueY(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.TrueY = 5
'    mvarTrueY = vData
'End Property


Public Property Get TrueY() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.TrueY
    TrueY = mvarTrueY
End Property



'Public Property Let TrueX(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.TrueX = 5
'    mvarTrueX = vData
'End Property


Public Property Get TrueX() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.TrueX
    TrueX = mvarTrueX
End Property