File "Objet.cls"

Full Path: /home/analogde/www/DEV3/Objet.cls
File size: 3.85 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 PAD_ID As Long
Private PAD_Etat As Long
Private PAD_Type As String
Private PAD_Orientation As String
Private PAD_Position(1) As Integer
Private PAD_Gravite(1) As Integer

Private Bonding() As Connexion

Public Function SetPosition_PAD(ByVal X As Integer, ByVal Y As Integer, Optional ByVal Gravite_Pos_X As Integer, Optional ByVal Gravite_Pos_Y As Integer)

' dfini la position
PAD_Position(0) = X
PAD_Position(1) = Y
' dfini la position du point de gravite
If IsNumeric(Gravite_Pos_X) Then PAD_Gravite(0) = Gravite_Pos_X
If IsNumeric(Gravite_Pos_Y) Then PAD_Gravite(1) = Gravite_Pos_Y

End Function

Public Function GetID_PAD() As Long

' recupere l'ID
GetID_PAD = PAD_ID

End Function

Public Function GetOrientation_PAD() As String

' recupere l'orientation
GetOrientation_PAD = PAD_Orientation

End Function


Public Function GetPosition_PAD(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
If IsNumeric(PosX) Then PosX = PAD_Position(0)
If IsNumeric(PosY) Then PosY = PAD_Position(1)

' recupere la position du point de gravite
If IsNumeric(Gravite_Pos_X) Then Gravite_Pos_X = PAD_Gravite(0)
If IsNumeric(Gravite_Pos_Y) Then Gravite_Pos_Y = PAD_Gravite(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

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(NumPad As Long, Parent As Long)

' on defini un nouveau parent
Bonding(NumPad).Parent = Parent

End Function

Public Function GetParent(ByVal NumPad As Long)

' on renvoi le parent
GetParent = Bonding(NumPad).Parent

End Function

Public Function GetEtat_PAD() As Long

' on renvoie l'etat
GetEtat_PAD = PAD_Etat

End Function

Public Function GetType_PAD() As String

' on renvoie le type
GetType_PAD = PAD_Type

End Function

Public Function SetParametres_PAD(Type_PAD As String, ID As Long, X, Y, Type_Orientation As String)

' on defini les parametres  (initialisation)
PAD_Type = Type_PAD

PAD_Orientation = Type_Orientation

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

PAD_ID = ID
PAD_Position(0) = X
PAD_Position(1) = Y

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