VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "Gate" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False ' la classe Porte ' c'est un peu le bordel, les fonctions ont etaient rajoute au cas par cas, ' on peu faire bcp mieux ! Private m_ID As Long Private m_Etat As Long Private m_GateType As String Private m_Entrees() As pin Private m_NbEntree As Long Private m_Position(1) As Integer Private m_SortiePosition(1) As Integer Public Function SetPosition(ByVal PosX As Integer, ByVal PosY As Integer, Optional ByRef PinPos, Optional ByVal SortiePosX As Integer, Optional ByVal SortiePosY As Integer) ' defini la position de la porte et des pins m_Position(0) = PosX m_Position(1) = PosY If IsNumeric(SortiePosX) Then m_SortiePosition(0) = SortiePosX If IsNumeric(SortiePosY) Then m_SortiePosition(1) = SortiePosY If IsArray(PinPos) Then For i = 0 To m_NbEntree - 1 m_Entrees(i).PosX = PinPos(0, i) m_Entrees(i).PosY = PinPos(1, i) Next i End If End Function Public Function GetID() As Long ' recupere l'ID de la porte GetID = m_ID End Function Public Function GetPosition(Optional ByRef PosX As Integer, Optional ByRef PosY As Integer, Optional ByRef PinPos, Optional ByRef SortiePosX As Integer, Optional ByRef SortiePosY As Integer) ' recupere la position de la porte et des pins If IsNumeric(PosX) Then PosX = m_Position(0) If IsNumeric(PosY) Then PosY = m_Position(1) If IsNumeric(SortiePosX) Then SortiePosX = m_SortiePosition(0) If IsNumeric(SortiePosY) Then SortiePosY = m_SortiePosition(1) If IsArray(PinPos) Then ReDim PinPos(1, m_NbEntree - 1) For i = 0 To m_NbEntree - 1 PinPos(0, i) = m_Entrees(i).PosX PinPos(1, i) = m_Entrees(i).PosY Next i End If 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 SetEntree(Parent As Long, Etat As Long) 'on averti la porte qu'une porte a changer d'etat, on regarde si on est concern� ' si le systeme boucle a l'infini, une erreur de conception existe On Error GoTo boucle For i = 0 To (m_NbEntree - 1) If m_Entrees(i).Parent = Parent Then ' le parent indique est bien mon parent m_Entrees(i).Etat = Etat ' je change l'etat de mon entree tmp = Me.CalculEtat() ' recalcul l'etat de la porte End If Next i GoTo fin boucle: MsgBox ("Le systeme est instable, verifiez vos liens !") fin: End Function Public Function CalculEtat() ' calcul l'etat de la porte en fonction des entrees et du type de porte ' previent ensuite les autres portes en cas de changemant d'etat Dim Etat As Long Select Case m_GateType Case "AND" Etat = 1 For i = 0 To (m_NbEntree - 1) If m_Entrees(i).Etat = 0 Then Etat = 0 Next i Case "NAND" Etat = 0 For i = 0 To (m_NbEntree - 1) If m_Entrees(i).Etat = 0 Then Etat = 1 Next i Case "OR" Etat = 0 For i = 0 To (m_NbEntree - 1) If m_Entrees(i).Etat = 1 Then Etat = 1 Next i Case "NOR" Etat = 1 For i = 0 To (m_NbEntree - 1) If m_Entrees(i).Etat = 1 Then Etat = 0 Next i Case "XOR" Etat = 0 If (m_Entrees(0).Etat = 1 And m_Entrees(1).Etat = 0) Or (m_Entrees(1).Etat = 1 And m_Entrees(0).Etat = 0) Then Etat = 1 Case "XNOR" Etat = 1 If (m_Entrees(0).Etat = 1 And m_Entrees(1).Etat = 0) Or (m_Entrees(1).Etat = 1 And m_Entrees(0).Etat = 0) Then Etat = 0 Case "NOT" Etat = 0 If m_Entrees(i).Etat = 0 Then Etat = 1 Case "Clock" If m_Entrees(0).Etat = 0 Then Etat = 0 If m_Entrees(0).Etat = 1 Then Etat = 1 Case "DetectMont" If m_Entrees(0).Etat = 1 And m_Etat = 0 Then Etat = 1 Else Etat = m_Etat End If Case "DetectDesc" If m_Entrees(0).Etat = 0 And m_Etat = 1 Then Etat = 0 Else Etat = m_Etat End If Case "LED" If m_Entrees(0).Etat = 0 Then Etat = 0 If m_Entrees(0).Etat = 1 Then Etat = 1 End Select If m_Etat <> Etat Then m_Etat = Etat ' si le systeme boucle a l'infini, une erreur de conception existe On Error GoTo boucle ' previent toutes les portes du changement d'etat For i = 0 To NBGates - 1 If GatesStatus(i) = 1 Then tmp = Gates(i).SetEntree(m_ID, m_Etat) Next i GoTo fin boucle: MsgBox ("Le systeme est instable, verifiez vos liens !") fin: End If ' Pour les detecteurs, le changement est temporaire, on relance la maj If m_GateType = "DetectMont" Or m_GateType = "DetectDesc" Then Etat = 0 If m_Etat <> Etat Then m_Etat = Etat ' si le systeme boucle a l'infini, une erreur de conception existe On Error GoTo boucle2 ' previent toutes les portes du changement d'etat For i = 0 To NBGates - 1 If GatesStatus(i) = 1 Then tmp = Gates(i).SetEntree(m_ID, m_Etat) Next i GoTo fin2 boucle2: MsgBox ("Le systeme est instable, verifiez vos liens !") fin2: 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 de porte GetType = m_GateType End Function Public Function GetPinEtat(ByVal Pinnum As Long) As Long ' on renvoie l'etat d'une pin GetPinEtat = m_Entrees(Pinnum).Etat End Function Public Function SetPinEtat(Pinnum As Long, Etat As Long) As Long ' on defini l'etat d'une pin m_Entrees(Pinnum).Etat = Etat tmp = Me.CalculEtat() End Function Public Function SetParametres(GateType As String, NbEntree As Long, ID As Long, PosX, PosY) ' on defini les parametres de la porte (a l'initionalisation) m_GateType = GateType ' certaines portes ont un nb d'entree fixe If GateType = "NOT" Then NbEntree = 1 If GateType = "Clock" Then NbEntree = 1 If GateType = "XOR" Then NbEntree = 2 If GateType = "XNOR" Then NbEntree = 2 If GateType = "DetectMont" Then NbEntree = 1 If GateType = "DetectDesc" Then NbEntree = 1 If GateType = "LED" Then NbEntree = 1 m_Etat = 0 ' etat par defaut, inverse pour les portes N- If GateType = "NOT" Or GateType = "NAND" Or GateType = "NOR" Or GateType = "XNOR" Then m_Etat = 1 ReDim m_Entrees(NbEntree - 1) ' creer les entrees m_NbEntree = NbEntree m_ID = ID m_Position(0) = PosX m_Position(1) = PosY For i = 0 To NbEntree - 1 ' defini un parent a vide (-1) m_Entrees(i).Parent = -1 m_Entrees(i).Etat = 0 Next i End Function Public Function ChargePorte(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, PinPos, SortiePosX, SortiePosY) End Function