Create New Item
Item Type
File
Folder
Item Name
Search file in folder and subfolders...
Are you sure want to rename?
File Manager
/
css
/
DEV3
:
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 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) ' d�fini la position PAD_Position(0) = X PAD_Position(1) = Y ' d�fini 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