File "Objet.cls"

Full Path: /home/analogde/www/Documents/DEV2/Objet.cls
File size: 3.98 KB
MIME-type: text/plain
Charset: 8 bit

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Pad"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' la classe Pad

Private m_ID As Long
Private m_Etat As Long
Private m_PAD_Type As String
Private m_PAD_Orientation As String
'Private m_Entrees() As pin
Private m_NbEntree As Long
Private m_Position(1) As Integer
Private m_Gravite_Position(1) As Integer

Public Function SetPosition(ByVal PosX As Integer, ByVal PosY As Integer, Optional ByVal Gravite_Pos_X As Integer, Optional ByVal Gravite_Pos_Y As Integer)

' dfini la position du pad
m_Position(0) = PosX
m_Position(1) = PosY


' dfini la position du point de gravite

If IsNumeric(Gravite_Pos_X) Then m_Gravite_Position(0) = Gravite_Pos_X
If IsNumeric(Gravite_Pos_Y) Then m_Gravite_Position(1) = Gravite_Pos_Y

End Function

Public Function GetID() As Long

' recupere l'ID du pad
GetID = m_ID

End Function

Public Function Get_Orientation() As String

' recupere l'orientation du pad
Get_Orientation = m_PAD_Orientation

End Function


Public Function GetPosition(ByRef PosX As Integer, ByRef PosY As Integer, Optional ByRef Gravite_Pos_X As Integer, Optional ByRef Gravite_Pos_Y As Integer)

' recupere la position du pad
If IsNumeric(PosX) Then PosX = m_Position(0)
If IsNumeric(PosY) Then PosY = m_Position(1)

' recupere la position du point de gravite du  pad
If IsNumeric(Gravite_Pos_X) Then Gravite_Pos_X = m_Gravite_Position(0)
If IsNumeric(Gravite_Pos_Y) Then Gravite_Pos_Y = m_Gravite_Position(1)


End Function

Public Function GetNbEntree(Optional ByRef EtatEntrees As Variant) As Long
' recupere le nombre d'entrees et leurs etats

If IsArray(EtatEntrees) Then

 '   ReDim EtatEntrees(m_NbEntree - 1)

    For i = 0 To m_NbEntree - 1
        EtatEntrees(i) = m_Entrees(i).Etat
    Next i

End If

GetNbEntree = m_NbEntree

End Function

Public Function SetEntreeParPin(pin As Long, Etat As Long)
' defini l'etat d'une pin

If m_Entrees(pin).Parent = -1 Then
    m_Entrees(pin).Etat = Etat
    
    tmp = CalculEtat()

    For i = 0 To NBGates - 1
        If GatesStatus(i) = 1 Then tmp = Gates(i).SetEntree(m_ID, m_Etat)
    Next i
    
Else
    MsgBox "Impossible de modifier l'etat d'entree, un parent existe!"
End If

End Function

Public Function SetParent(NumPin As Long, Parent As Long)

' on defini un nouveau parent pour la pin
m_Entrees(NumPin).Parent = Parent

End Function

Public Function GetParent(ByVal NumPin As Long)

' on renvoi le parent de la pin
GetParent = m_Entrees(NumPin).Parent

End Function

Public Function GetEtat() As Long

' on renvoie l'etat de la porte
GetEtat = m_Etat

End Function

Public Function GetType() As String

' on renvoie le type du PAD
GetType = m_PAD_Type

End Function

Public Function SetParametres(Type_PAD As String, ID As Long, PosX, PosY, Type_Orientation As String)

' on defini les parametres du pad (initialisation)
m_PAD_Type = Type_PAD

m_PAD_Orientation = Type_Orientation

' etat par defaut
m_Etat = 0 '
If Type_PAD = "PAD" Or Type_PAD = "PAD2" Or Type_PAD = "PAD2" Or Type_PAD = "PAD2" Then m_Etat = 1

m_ID = ID
m_Position(0) = PosX
m_Position(1) = PosY

End Function


Public Function Charge_PAD(ID As Long, PorteType As String, NbEntrees As Long, PinParents() As Long, PinEtat() As Long, PosX As Integer, PosY As Integer, PinPos() As Integer, SortiePosX As Integer, SortiePosY As Integer)
' fonction globale pour charger une porte a partir d'une sauvegarde

Dim i As Long

tmp = Me.SetParametres(PorteType, NbEntrees, ID, PosX, PosY)
For i = 0 To NbEntrees - 1
    tmp = Me.SetParent(i, PinParents(i))
    tmp = Me.SetPinEtat(i, PinEtat(i))
Next i
tmp = Me.SetPosition(PosX, PosY, SortiePosX, SortiePosY)

End Function