Tiny File Manager

File "dessin.bas"
Full Path: /home/analogde/www/css/DEV3/dessin.bas
File size: 8.17 KB
MIME-type: text/plain
Charset: 8 bit
Open Edit Advanced Editor Back
Attribute VB_Name = "padring"
Public Function Insert_PAD(ByVal X As Integer, ByVal Y As Integer, ByVal Type_PAD As String, ByVal PAD_Orientation 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_PAD(Type_PAD, NB_PAD - 1, X, Y, PAD_Orientation)

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

Public Function bouger(ByVal X As Integer, ByVal Y As Integer, ByVal Reference As Long) As Long

' Defini la nouvelle position du pad
tmp = Objet_PAD(Reference).SetPosition_PAD(X, Y)
    
End Function

Public Sub ReDraw_PAD(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_PAD(PosX, PosY)
            Type_PAD = Objet_PAD(i).GetType_PAD()
            Orientation_PAD = Objet_PAD(i).GetOrientation_PAD()
            '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_PAD(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_PAD(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_PAD(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, PAD_Orientation As String, ByVal Etat As Long, ByVal Type_PAD As String, pic As PictureBox, Optional ByRef Selectionne As Long = 0)
            
           

Dim L As Double
Dim W As Double
Dim couleur_rouge As String
Dim couleur_vert As String
Dim couleur_bleu As String
Dim couleur_noir As String
Dim A As Point_A
Dim B As Point_A
Dim C As Point_A
Dim D As Point_A


' dfinition
couleur_rouge = RGB(255, 0, 0)
couleur_vert = RGB(0, 255, 0)
couleur_bleu = RGB(0, 0, 255)
couleur_noir = RGB(0, 0, 0)
L = 400
W = 200

' calcul
A.X = X - (L / 2)
A.Y = Y - (W / 2)
B.X = X + (L / 2)
B.Y = Y - (W / 2)
C.X = X + (L / 2)
C.Y = Y + (W / 2)
D.X = X - (L / 2)
D.Y = Y + (W / 2)

If PAD_Orientation = "r" Then


End If

If PAD_Orientation = "n" Then
'corps du rectangle
pic.Line (A.X, -A.Y)-(B.X, -B.Y), couleur_bleu
pic.Line (B.X, -B.Y)-(C.X, -C.Y), couleur_bleu
pic.Line (C.X, -C.Y)-(D.X, -D.Y), couleur_bleu
pic.Line (D.X, -D.Y)-(A.X, -A.Y), couleur_bleu
' dessine le point de gravit
pic.Circle (X, -Y), taillepuce, couleur_rouge

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
Dim message As String


'MsgBox "X: " & X & "Y:" & -Y

' correction de l'offset
Y = -Y

' 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_PAD(PosX, PosY)
    
    ' Q1
    If ((X > 0) And (Y > 0)) Then
    End If
    ' Q1
    If ((X < 0) And (Y > 0)) Then
    End If
    ' Q1
    If ((X < 0) And (Y < 0)) Then
    End If
    ' Q1
    If ((X > 0) And (Y < 0)) Then
    End If
    
    ' si le clic est dans le pad, c'est gagn
    If X > PosX - 50 And X < PosX + 50 And Y > PosY - 50 And Y < PosY + 50 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

' offset
Y = -Y


For i = 0 To NB_PAD - 1
    
    tmp = Objet_PAD(i).GetPosition_PAD(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