Tools/WinSN5.0Ver.iso/PVb5.0/VB/SAMPLES/PGUIDE/PROGWOB/PWORECT.CLS

Visual Basic class definition | 1997-01-29 | 5.2 KB | 177 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Rectangle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' >>╫ε║├╘┌í░╚½─ú┐Θ▓Θ┐┤í▒─ú╩╜╧┬╘─╢┴íú<<
'
' ┤µ┤ó╡≈╩╘▒Ω╩╢║┼íú
Private mlngDebugID As Long
Implements IDebug

' Rectangle ╩╡╧╓┴╜╕÷╜╙┐┌ú║
'   ╘┌╫╘╝║╡─╜╙┐┌╔╧╙╨╥╗╕÷╩⌠╨╘ (Filled) ║═╥╗╕÷╖╜╖¿ (TimeTest)íú

Implements IShape
Implements Polygon

' ─┌▓┐╡─ Polygon ╢╘╧≤╩╡╝╩╔╧▒ú┤µ╩²╛▌▓ó═Ω│╔╥╗╨⌐╣ñ╫≈íú
'   Rectangle ▒ú│╓╢╘ Polygon ╜╙┐┌║═─┌▓┐ Polygon ╡─ IShape ╜╙┐┌╡─╥²╙├íú
Private mpyg As Polygon
Private mish As IShape

' ▒ú┤µ Color ╩⌠╨╘ (Polygon ╜╙┐┌╩╡╧╓)íú
Private mrgbColor As Long

' ▒ú┤µ Filled ╩⌠╨╘ (╘┌ Rectangle ╡─╚▒╩í╜╙┐┌)íú
Private mblnFilled As Boolean

' -------------------------------------
' ╒Γ╩╟ IShape ╜╙┐┌╡─ Rectangle ╡─╩╡╧╓╣²│╠╡─┐¬╩╝íú

' IShape. ╡≈╙├ DrawToPictureBox ╗¡╢α▒▀╨╬ú¼
' ======       ----------------   ╦∙╥╘├┐╕÷─ú╨═╡─└α▒╪╨δ╠ß╣⌐╞Σ╫╘╝║╡─╩╡╧╓╣²│╠íú
'
Private Sub IShape_DrawToPictureBox(ByVal pb As PictureBox)
    ' ╙δ─┌▓┐ Polygon ╡─ IShape ╜╙┐┌╧α▒╚╜╧ú¼
    '   └√╙├ Rectangle ╡─╙┼╩╞╘┌╙┌╦ⁿ╙╨╗¡┐≥╡─═╝╨╬├ⁿ┴εú¼╓╗╨Φ╥╗╕÷▓┘╫≈╢°▓╗╩╟ 4 ╕÷íú
    '   (═╝╨╬▒╗╚╧╬¬╩╟╫ε╖╤╩▒╝Σ╡─╥╗└α▓┘╫≈)
    Dim sngX1 As Single, sngY1 As Single
    Dim sngX2 As Single, sngY2 As Single
    Call mpyg.GetPoint(0, sngX1, sngY1)
    Call mpyg.GetPoint(1, sngX2, sngY2)
    If mblnFilled Then
        pb.Line (sngX1, sngY1)-(sngX2, sngY2), mrgbColor, BF
    Else
        pb.Line (sngX1, sngY1)-(sngX2, sngY2), mrgbColor, B
    End If
End Sub

' IShape.TimeTest ╖╜╖¿╙├└┤╧╘╩╛╝╕╕÷└α╩╡╧╓╡─╥╗╕÷╜╙┐┌╓╨╡≈╙├╡─╖╜╖¿╡─╝⌡╔┘╡─╡≈╙├┐¬╧·ú¼
' ====== --------
'   -- ╧α╢╘╙┌╘┌└α╡─╚▒╩í╜╙┐┌╡≈╙├└α╦╞╡─╖╜╖¿íú
'
Private Sub IShape_TimeTest()
End Sub

' -------------------------------------
' ╒Γ╩╟ Polygon ╜╙┐┌╡─╩╡╧╓╣²│╠┐¬╩╝íú

' Polygon.Color - ╙╔╙┌─┌▓┐ Polygon ▓╗╙├╙┌╗¡╛╪╨╬ú¼
' ======= -----   Color ╩⌠╨╘═Ω╚½▒╗╕▓╕╟íú
'   ╒Γ▓╗╩╟▒╪╨δ╡─ú╗Rectangle ┐╔╥╘░╤▒ú┤µ╡─ Color ╩⌠╨╘╕│╓╡╕°─┌▓┐ Polygon(╧±└α Triangle ╦∙╫÷╡─)ú¼
'   ▒ú┤µ╩╡╧╓┤·┬δ║═┤µ┤ó┐╒╝Σíú
'   ╤╒╔½╓╡┐╔╥╘╘┌╗¡╡─╣²│╠╓╨┤╙─┌▓┐ Polygon ┤ª╡├╡╜íú
Private Property Get Polygon_Color() As Long
    Polygon_Color = mrgbColor
End Property
'
Private Property Let Polygon_Color(ByVal RHS As Long)
    If 0 <> (RHS And &HFF000000) Then
        Err.Raise vbObjectError + 2080, , _
            "Polygon ╡─╬▐╨º╤╒╔½╓╡íú"
        Exit Property
    End If
    mrgbColor = RHS
End Property

' Polygon.TimeTest - Rectangle ╙╨╚²╕÷ TimeTest ╖╜╖¿ú¼
' ======= --------
'   ╥╗╕÷╘┌ IShape ╜╙┐┌ (╙├╙┌╧╘╩╛╢α╠¼╨╘║═╘τ╞┌░≤╢¿)ú¼
'   ╥╗╕÷╘┌╦ⁿ╫╘╝║╡─╜╙┐┌ (╙├╙┌╧╘╩╛║≤╞┌░≤╢¿)ú¼║═╒Γ╥╗╕÷íú
'   ╒Γ╥╗╕÷╩╟ Rectangle ╩╡╧╓ Polygon ╜╙┐┌╡─ú╗
'   ╦ⁿ▓╗╙├╙┌╞Σ╦√╚╬║╬╡╪╖╜íú
Private Sub Polygon_TimeTest()
End Sub

' Polygon.GetPoint
' ======= --------
'
Private Sub Polygon_GetPoint(ByVal intPoint As Integer, X As Single, Y As Single)
    ' ╕°─┌▓┐ Polygon ╕│╓╡íú
    Call mpyg.GetPoint(intPoint, X, Y)
End Sub

' Polygon.GetPointCount
' ======= -------------
'
Private Property Get Polygon_GetPointCount() As Integer
    ' ╥≥╬¬╫▄╩╟╙├┴╜╕÷╡π╛÷╢¿╥╗╕÷╛╪╨╬ú¼╒Γ└∩├╗╙╨╥¬╕│╓╡╕°─┌▓┐ Polygon ╡─╡π
    Polygon_GetPointCount = 2
End Property

' Polygon.SetPoints - ╡▒╩╡╧╓ Polygon ╜╙┐┌╡─ SetPoints ╖╜╖¿╩▒ú¼
' ======= ---------     Rectangle ╓┤╨╨╫╘╝║╡─┤·┬δú¼
'   ╚╖▒ú╩Σ╚δ╩²╫Θ╓╗░ⁿ└¿┴╜╕÷╡π (4 ╕÷ Single ╨═)ú¼
'   ▓ó╕│╓╡╕°─┌▓┐ Polygon ╢╘╧≤íú
Private Sub Polygon_SetPoints(asngPoints() As Single)
    Dim blnBadArray As Boolean
    On Error Resume Next
    ' ▒ú╓ñ╩Σ╚δ╩²╫Θ░ⁿ└¿▓╗│¼╣² 4 ╕÷╡πíú
    '   (Polygon ╡─ SetPoint ╖╜╖¿╥¬▒ú╓ñ╩²╫Θ╧┬▒Ω┤╙ 0 ┐¬╩╝íú)
    If UBound(asngPoints) <> 3 Then blnBadArray = True
    ' ╚τ╣√╡≈╙├ UBound ╩▒│÷┤φú¼═╦│÷╩²╫Θíú
    If Err.Number <> 0 Then blnBadArray = True
    If blnBadArray Then
        Err.Raise vbObjectError + 2083, , _
            "╥╗╕÷╛╪╨╬╥¬╙╔╧┬▒Ω┤╙ 0 ┐¬╩╝╡─╩²╫Θ╡─ 4 ╕÷╩² (left, top, right, bottom) ╓╕╢¿íú"
        Exit Sub
    End If
    ' ╔Φ╓├─┌▓┐ Polygonú¼═Ω│╔╤Θ╓ñ╩²╫Θ▓ó▒ú┤µíú
    Call mpyg.SetPoints(asngPoints)
End Sub

' --------------------------------------
' ╒Γ╩╟ Rectangle ╢╘╧≤╡─╚▒╩í╜╙┐┌╡─┐¬╩╝íú

' TimeTest ╖╜╖¿╬▐▓╬╩²ú¼▓╗╫÷╚╬║╬▓┘╫≈ú¼╢°╟╥┴ó╝┤╖╡╗╪íú
' --------      ╦ⁿ▒╗╙├╙┌╦╡├≈║≤╞┌░≤╢¿╡─╡≈╙├┐¬╧·ú¼
'   ╧α╢╘╙┌╘┌ IShape ╜╙┐┌╡≈╙├ TimeTest ╦∙╠ß╣⌐╡─╘τ╞┌░≤╢¿íú
Public Sub TimeTest()
End Sub

' Filled ╩⌠╨╘╛÷╢¿╩╟╖±╘┌╗¡╩▒╠ε│Σ╛╪╨╬íú
' ------
Public Property Get Filled() As Boolean
    Filled = mblnFilled
End Property
'
Public Property Let Filled(ByVal NewValue As Boolean)
    mblnFilled = NewValue
End Property

' --------------------------------------
' ╒Γ╩╟└α╡─╦╜╙╨╣²│╠┐¬╩╝ (╕¿╓·╣²│╠╝░╩┬╝■╣²│╠)íú

Private Sub Class_Initialize()
    Dim asngPoints(0 To 3) As Single
    ' ╡≈╩╘┤·┬δíú
    mlngDebugID = DebugInit(Me)
    '
    ' ┤┤╜¿─┌▓┐╡─ Polygon ╢╘╧≤ú¼▓ó╗±╡├╢╘ IShape ╜╙┐┌╡─╥²╙├íú
    Set mpyg = New Polygon
    Set mish = mpyg
    ' │⌡╩╝╗»─┌▓┐ Polygoníú
    Call mpyg.SetPoints(asngPoints)
End Sub

Private Sub Class_Terminate()
    DebugTerm Me
End Sub

' -------- IDebug ╩╡╧╓ --------
'
' IDebug.DebugID ╧≥─·╠ß╣⌐╥╗╓╓╩╢▒≡╢╘╧≤╡─╖╜╖¿íú
' ====== -------    ╦ⁿ╩╟ modFriend ╓╨╔∙├≈╡─ DebugInitíóDebugTerm
'   ║═ DebugShow ╡≈╩╘╣²│╠╦∙╥¬╟≤╡─íú
'
Private Property Get IDebug_DebugID() As Long
    IDebug_DebugID = mlngDebugID
End Property