Create New Item
Item Type
File
Folder
Item Name
Search file in folder and subfolders...
Are you sure want to rename?
File Manager
/
Documents
/
DEV2
:
Objet.cls
Advanced Search
Upload
New Item
Settings
Back
Back Up
Advanced Editor
Save
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) ' d�fini la position du pad m_Position(0) = PosX m_Position(1) = PosY ' d�fini 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