File "dessin.bas"

Full Path: /home/analogde/www/Prog_JAVA/Source/dessin.bas
File size: 9.66 KB
MIME-type: text/plain
Charset: 8 bit

Attribute VB_Name = "dessin"
Public Function InsertPorte(ByVal cX As Integer, ByVal cY As Integer, ByVal TypePorte As String, ByVal NbEntrees As Long) As Long
' insere une nouvelle porte

NBGates = NBGates + 1
ReDim Preserve Gates(NBGates - 1) ' agrandit le tableau de liens
Set Gates(NBGates - 1) = New Gate ' instancie une nouvelle porte


ReDim Preserve GatesStatus(NBGates - 1) ' agrandit le tableau d'etat
GatesStatus(NBGates - 1) = 1 ' stocke l'etat de la porte (1-presente 0-effacee)

' defini les parametre de la nouvelle porte
tmp = Gates(NBGates - 1).SetParametres(TypePorte, NbEntrees, NBGates - 1, cX, cY)

' retourne l'ID de la porte
InsertPorte = NBGates - 1
    
End Function

Public Function MovePorte(ByVal cX As Integer, ByVal cY As Integer, ByVal PorteRef As Long) As Long

' Defini la nouvelle position de la porte
tmp = Gates(PorteRef).SetPosition(cX, cY)

    
End Function

Public Sub ReDraw(pic As PictureBox)
    
    'on redessine tout le tableau
    Dim i As Integer, j As Integer
    Dim PosX As Integer, PosY As Integer
    Dim EtatEntrees() As Long
    Dim EntreePos() As Integer
    Dim SortiePosX As Integer, SortiePosY As Integer
    Dim Selectionnee As Long
    Dim TypePorte As String
    PosX = 0
    PosY = 0
    pic.Cls
    
    
    'on dessine les portes
    For i = 0 To NBGates - 1
    If GatesStatus(i) = 1 Then
            Etat = Gates(i).GetEtat()
            NbEntrees = Gates(i).GetNbEntree(EtatEntrees)
            ' recupere la position de la porte
            tmp = Gates(i).GetPosition(PosX, PosY)
            TypePorte = Gates(i).GetType()
            
            'dessine la porte
            Selectionnee = 0
            If PorteSelectionnee = i Then Selectionnee = 1
            tmp = DessinePorte(PosX, PosY, NbEntrees, EtatEntrees, Etat, TypePorte, pic, EntreePos, SortiePosX, SortiePosY, Selectionnee)
            tmp = Gates(i).SetPosition(PosX, PosY, EntreePos, SortiePosX, SortiePosY)
            
    End If
    Next i
    
    'on dessine les liens
    For i = 0 To NBGates - 1
    If GatesStatus(i) = 1 Then
        DessineLiens (i)
    End If
    Next i
    
End Sub

Public Function DessineLiens(Porte As Long)

Dim PosX As Integer, PosY As Integer
Dim PinPos() As Integer
Dim Parent As Long
Dim ParentPosX As Integer, ParentPosY As Integer
Dim SortiePosX As Integer, SortiePosY As Integer
Dim i As Long

NbEntrees = Gates(Porte).GetNbEntree()
' recupere la position de la porte
tmp = Gates(Porte).GetPosition(PosX, PosY, PinPos)

For i = 0 To NbEntrees - 1
    Parent = Gates(Porte).GetParent(i)
    If Parent <> -1 Then
        If GatesStatus(Parent) = 1 Then
            tmp = Gates(Parent).GetPosition(ParentPosX, ParentPosY, , SortiePosX, SortiePosY)
            If ParentPosX = 0 And ParentPosY = 0 Then
                MsgBox "0"
            End If
            SchemaFrm.Schema.Line (PinPos(0, i), PinPos(1, i))-(SortiePosX, SortiePosY)
        End If
    End If
    
Next i


End Function


Public Function DessinePorte(ByVal X As Integer, ByVal Y As Integer, ByVal NbEntrees As Long, ByRef EtatEntrees() As Long, ByVal Etat As Long, ByVal TypePorte As String, pic As PictureBox, ByRef EntreePos() As Integer, ByRef SortiePosX As Integer, ByRef SortiePosY As Integer, Optional ByRef Selectionne As Long = 0)
' dessine une porte

ReDim EntreePos(1, NbEntrees)

hauteur = NbEntrees * hauteurStd + hauteurStd
largeur = largeurStd
If Etat = 1 Then couleur = RGB(255, 0, 0)
If Etat = 0 Then couleur = RGB(0, 255, 0)

If Selectionne = 1 Then couleurboite = RGB(0, 0, 255)
If Selectionne = 0 Then couleurboite = RGB(0, 0, 0)

' definit le symbole et inverse

Dim symbole As String
Dim inverse As Long
Dim Sortie As Long
Dim Boite As Long

Sortie = 1 ' la porte a une sortie (oui par defaut, non si output -LED..-)
Boite = 1 ' porte standard

If TypePorte = "AND" Then
    symbole = "&"
    inverse = 0
End If
If TypePorte = "NAND" Then
    symbole = "&"
    inverse = 1
End If
If TypePorte = "OR" Then
    symbole = ">=1"
    inverse = 0
End If
If TypePorte = "NOR" Then
    symbole = ">=1"
    inverse = 1
End If
If TypePorte = "XOR" Then
    symbole = "=1"
    inverse = 0
End If
If TypePorte = "XNOR" Then
    symbole = "=1"
    inverse = 1
End If
If TypePorte = "NOT" Then
    symbole = "1"
    inverse = 1
End If
If TypePorte = "Clock" Then
    symbole = "Clk"
    inverse = 0
    NbEntrees = 0
End If
If TypePorte = "DetectMont" Then
    symbole = "Det"
    inverse = 0
End If
If TypePorte = "DetectDesc" Then
    symbole = "Det"
    inverse = 1
End If
If TypePorte = "LED" Then
    symbole = ""
    inverse = 0
    Sortie = 0
    Boite = 0
End If

offsetsortie = 0
If inverse = 1 Then offsetsortie = taillepuce * 2


' dessine la boite
If Boite = 1 Then
    pic.Line (X, Y)-(X + largeur, Y), couleurboite
    pic.Line -(X + largeur, Y + hauteur), couleurboite
    pic.Line -(X, Y + hauteur), couleurboite
    pic.Line -(X, Y), couleurboite
End If
' dessine la sortie
If Sortie = 1 Then
    pic.Line (X + largeur + offsetsortie, Y + hauteur / 2)-(X + largeur + taillepin, Y + hauteur / 2), couleurboite
    pic.Circle (X + largeur + taillepin + taillepuce, Y + hauteur / 2), taillepuce, couleur
         ' symbole inverse
    If inverse = 1 Then pic.Circle (X + largeur + taillepuce, Y + hauteur / 2), taillepuce
    SortiePosX = X + largeur + taillepin + taillepuce
    SortiePosY = Y + hauteur / 2
End If
' dessine les entrees
For i = 0 To NbEntrees - 1
    If EtatEntrees(i) = 1 Then couleur = RGB(255, 0, 0)
    If EtatEntrees(i) = 0 Then couleur = RGB(0, 255, 0)
    pic.Line (X, Y + (i + 1) * hauteurStd)-(X - taillepin, Y + (i + 1) * hauteurStd), couleurboite
    pic.Circle (X - taillepin - taillepuce, Y + (i + 1) * hauteurStd), taillepuce, couleur
    EntreePos(0, i) = X - taillepin - taillepuce
    EntreePos(1, i) = Y + (i + 1) * hauteurStd
Next i

' dessine le symbole
pic.CurrentX = X + 100
pic.CurrentY = Y - 80 + hauteur / 2
pic.Print symbole

' affichages speciaux
If TypePorte = "LED" Then
    If Etat = 0 Then couleur = RGB(200, 200, 200)
    pic.FillStyle = 0
    pic.FillColor = couleur
    pic.Circle (X + taillepin - taillepuce, Y + hauteur / 2), taillepuce * 2
    pic.FillStyle = 1
End If

End Function

Public Function TrouvePorte(ByVal X As Integer, ByVal Y As Integer, Optional ByRef DifX As Integer, Optional ByRef DifY As Integer)
' trouve une porte en fonction des coordonnees

Dim PosX As Integer, PosY As Integer
Dim Porte As Integer

' par defaut porte non trouvee
Porte = -1

For i = 0 To NBGates - 1
If GatesStatus(i) = 1 Then
    tmp = Gates(i).GetPosition(PosX, PosY) ' on recupere les positions de la porte
    NbEntree = Gates(i).GetNbEntree() ' on recup le nb d'entree (conditionne la taille de la porte)
    hauteur = NbEntree * hauteurStd + NbEntree ' on calcule la taille de la porte
    
    ' si le clic est dans la porte, c'est gagn
    If X > PosX And X < PosX + largeurStd And Y > PosY And Y < PosY + hauteur Then
        Porte = i
        If IsNumeric(DifX) Then DifX = X - PosX
        If IsNumeric(DifY) Then DifY = Y - PosY
    End If
End If
Next i

TrouvePorte = Porte

End Function



Public Function TrouvePin(ByVal X As Integer, ByVal Y As Integer, ByRef Porte As Long, ByRef Pinnum As Long, ByRef PinType As String)
' on trouve une pin en fonction de coordonnes

Dim PosX As Integer, PosY As Integer
Dim PinPos() As Integer
Dim SortiePosX As Integer, SortiePosY As Integer

' par defaut, pas trouve
Porte = -1

For i = 0 To NBGates - 1
If GatesStatus(i) = 1 Then
    tmp = Gates(i).GetPosition(PosX, PosY, PinPos, SortiePosX, SortiePosY)
    NbEntree = Gates(i).GetNbEntree()
    ' teste les entrees
   For j = 0 To NbEntree - 1
        Dist = (Abs(PinPos(0, j) - X) + Abs(PinPos(1, j) - Y))
        If Dist <= taillepuce Then
            Porte = i
            Pinnum = j
            PinType = "entree"
        End If
    Next j
    ' teste les sorties
    Dist = (Abs(SortiePosX - X) + Abs(SortiePosY - Y))
    If Dist <= taillepuce Then
        Porte = i
        Pinnum = 0
        PinType = "sortie"
    End If
    
End If
Next i


End Function


Public Function TrouveLien(ByVal X As Integer, ByVal Y As Integer, ByRef PorteNum As Long, ByRef Pinnum As Long)
' trouve un lien en fonction de coordonnes

Dim PosX As Integer, PosY As Integer
Dim PinPos() As Integer
Dim SortiePosX As Integer, SortiePosY As Integer

PorteNum = -1

' on prend un peu de marge, un lien etant tres fin, il est dur a cliquer
For i = 0 To NBGates - 1
If GatesStatus(i) = 1 Then
    tmp = Gates(i).GetPosition(, , PinPos)
    NbEntree = Gates(i).GetNbEntree()
    ' teste les entrees
   For j = 0 To NbEntree - 1
        Parent = Gates(i).GetParent(j)
        If Parent <> -1 Then
            tmp = Gates(Parent).GetPosition(, , , SortiePosX, SortiePosY)
            ' calcule l'equation affine du lien y = ax + b
            a = (PinPos(1, j) - SortiePosY) / (PinPos(0, j) - SortiePosX)
            b = SortiePosY - a * SortiePosX
            ' si le point est sur cette droite, on tient le lien
            If Y < (a * X + b) + 50 And Y > (a * X + b) - 50 Then
                ' si le point est bien entre les 2 pins, et non dans la prolongation
                If (((X < SortiePosX + 50) And (X > PinPos(0, j) - 50)) Or ((X < PinPos(0, j) + 50) And (X > SortiePosX - 50))) And (((Y < SortiePosY + 50) And (Y > PinPos(1, j) - 50)) Or ((Y < PinPos(1, j) + 50) And (Y > SortiePosY - 50))) Then
                    PorteNum = i
                    Pinnum = j
                End If
            End If
        End If
    Next j
End If
Next i

End Function