File "dessin.bas"

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

Attribute VB_Name = "dessin"
Public Function Insert(ByVal cX As Integer, ByVal cY As Integer, ByVal Type_PAD As String, ByVal Orientation_PAD As String) As Long

' incrmente le nombre de pad
NB_PAD = NB_PAD + 1

' redimensionne le tableau de liens
ReDim Preserve Objet_PAD(NB_PAD - 1)

' instancie un nouveau pad
Set Objet_PAD(NB_PAD - 1) = New PAD

' defini les parametres du nouveau pad
 tmp = Objet_PAD(NB_PAD - 1).SetParametres(Type_PAD, NB_PAD - 1, cX, cY, Orientation_PAD)

' retourne l'ID du PAD
Insert = NB_PAD - 1
    
End Function

Public Function bouger(ByVal cX As Integer, ByVal cY As Integer, ByVal Refer As Long) As Long

' Defini la nouvelle position du pad
tmp = Objet_PAD(Refer).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 Gravite_Pos_X As Integer, Gravite_Pos_Y As Integer
    Dim Selectionnee As Long
    Dim Type_PAD As String
    Dim Orientation_PAD As String
    
    
    PosX = 0
    PosY = 0
    pic.Cls
    
    
    'on dessine les objets
    For i = 0 To NB_PAD - 1
           ' recupere la position du pad
            tmp = Objet_PAD(i).GetPosition(PosX, PosY)
            Type_PAD = Objet_PAD(i).GetType()
            Orientation_PAD = Objet_PAD(i).Get_Orientation()
            'dessine le pad
            Selectionnee = 0
            If PorteSelectionnee = i Then Selectionnee = 1
            tmp = Dessine_PAD(PosX, PosY, Gravite_Pos_X, Gravite_Pos_Y, Orientation_PAD, Etat, Type_PAD, pic, Selectionnee)
            tmp = Objet_PAD(i).SetPosition(PosX, PosY, Gravite_Pos_X, Gravite_Pos_Y)
                       
            
    Next i
    
    'on dessine les liens
    For i = 0 To NB_PAD - 1
            DessineLiens (i)
    Next i
    
End Sub

Public Function DessineLiens(PAD 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

' recupere la position du pad
tmp = Objet_PAD(PAD).GetPosition(PosX, PosY)

For i = 0 To NbEntrees - 1
    Parent = Objet_PAD(PAD).GetParent(i)
    If Parent <> -1 Then
        If PAD_Status(Parent) = 1 Then
            tmp = Objet_PAD(Parent).GetPosition(ParentPosX, ParentPosY)
            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 Dessine_PAD(ByVal X As Integer, ByVal Y As Integer, ByRef Gravite_Pos_X As Integer, ByRef Gravite_Pos_Y As Integer, Orientation_PAD As String, ByVal Etat As Long, ByVal Type_PAD As String, pic As PictureBox, Optional ByRef Selectionne As Long = 0)
            
Dim symbole As String
Dim inverse As Long
Dim Boite As Long

' dessine un pad

hauteur = 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)

' pad standard
Boite = 1

' dessine le corps du pad (gomtrie)

If Orientation_PAD = "r" Then
pic.Line (X, Y)-(X + hauteur, Y), couleurboite
pic.Line (X + hauteur, Y)-(X + hauteur, Y + largeur), couleurboite
pic.Line (X, Y)-(X, Y + largeur), couleurboite
pic.Line (X, Y + largeur)-(X + hauteur, Y + largeur), couleurboite
' dessine le point de gravit
pic.Circle (X + hauteur / 2, Y + largeur / 2), taillepuce, couleur
' position
Gravite_Pos_X = X + hauteur / 2
Gravite_Pos_Y = Y + largeur / 2

End If

If Orientation_PAD = "n" Then
'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
' dessine le point de gravit
pic.Circle (X + largeur / 2, Y + hauteur / 2), taillepuce, couleur
' position
Gravite_Pos_X = X + largeur / 2
Gravite_Pos_Y = Y + hauteur / 2

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



End Function

Public Function Trouve_PAD(ByVal X As Integer, ByVal Y As Integer, Optional ByRef DifX As Integer, Optional ByRef DifY As Integer)

' trouve un pad en fonction des coordonnees

Dim PosX As Integer, PosY As Integer
Dim PAD As Integer

' par defaut pad non trouve
PAD = -1

For i = 0 To NB_PAD - 1
    ' on recupere les positions du pad
    tmp = Objet_PAD(i).GetPosition(PosX, PosY)
    
    ' si le clic est dans le pad, c'est gagn
    If X > PosX And X < PosX + largeurStd And Y > PosY And Y < PosY + hauteurStd Then
        PAD = i
        If IsNumeric(DifX) Then DifX = X - PosX
        If IsNumeric(DifY) Then DifY = Y - PosY
    End If
Next i

Trouve_PAD = PAD

End Function



Public Function Trouve_Gravite(ByVal X As Integer, ByVal Y As Integer, ByRef PAD As Long, ByRef Pinnum As Long, ByRef PinType As String)

' on trouve le centre du pad en fonction de coordonnes

Dim PosX As Integer, PosY As Integer
Dim Gravite_Pos_X As Integer, Gravite_Pos_Y As Integer

' par defaut, pas trouve
PAD = -1

For i = 0 To NB_PAD - 1
    
    tmp = Objet_PAD(i).GetPosition(PosX, PosY, Gravite_Pos_X, Gravite_Pos_Y)
    
        Distance = (Abs(Gravite_Pos_X - X) + Abs(Gravite_Pos_Y - Y))
        If Distance <= taillepuce Then
        ' youpi ! on a trouv le pad
            PAD = i
        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 NB_PAD - 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