File "Module3.bas"

Full Path: /home/analogde/www/Dessin/Module3.bas
File size: 5.26 KB
MIME-type: text/plain
Charset: 8 bit

Attribute VB_Name = "PAD_DIE"
Public Function Insert_PAD(ByVal x As Double, ByVal y As Double, Optional ByVal type_pad As String, Optional 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 une nouvelle PAD
    Set Objet_PAD(NB_PAD - 1) = New pad

    ' defini les parametres de la nouvelle PAD
    tmp = Objet_PAD(NB_PAD - 1).Set_PAD_Parametres(NB_PAD - 1, x, y)

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

Public Function bouger(ByVal x As Double, ByVal y As Double, ByVal Reference As Long) As Long

    ' Definir la nouvelle position du pad
    tmp = Objet_PAD(Reference).Set_PAD_Parametres(Reference, x, y)
    
End Function

Public Sub Affiche_PAD(picture As PictureBox)
    
    Dim i As Integer
    
    'picture.Cls
            
    For i = 0 To NB_PAD - 1
        ' recupere la position de la pin
        tmp = Objet_PAD(i).GetPosition_PAD()
        'dessine la pin
        tmp = Dessine_PAD(Pos_X, Pos_Y, "dessine", picture)
        'tmp = Objet_PAD(i).SetPosition(PosX, PosY, Gravite_Pos_X, Gravite_Pos_Y)
    Next i
    
    Form_principale.Axes
    Form_principale.Grille
        
End Sub

Public Function Efface_PAD(picture As PictureBox)
   
    ' recupere la position de la pin
    tmp = Objet_PAD(Objet_pad_actif).GetPosition_PAD()
    tmp = Dessine_PAD(Pos_X, Pos_Y, "efface", picture)
        
End Function

Public Function Placer_PAD(picture As PictureBox)
   
    ' recupere la position de la pin
    tmp = Objet_PAD(Objet_pad_actif).GetPosition_PAD()
    tmp = Dessine_PAD(Pos_X, Pos_Y, "dessine", picture)
        
End Function


Public Function Dessine_PAD(ByVal x As Double, ByVal y As Double, ByVal action As String, picture As PictureBox)
    
    Dim i As Integer
    Dim L As Double
    Dim H As Double
   
    Dim Point_A As A
    Dim Point_B As B
    Dim Point_C As C
    Dim Point_D As D
   
    Dim X1 As Double
    Dim X2 As Double
    Dim Y1 As Double
    Dim Y2 As Double
    
    Dim couleur_corps As String
    Dim couleur_centre As String
    
    L = 86
    H = 99
   
    Point_A.x = x - (L / 2)
    Point_A.y = y - (H / 2)
   
    Point_B.x = x + (L / 2)
    Point_B.y = y - (H / 2)
   
    Point_C.x = x + (L / 2)
    Point_C.y = y + (H / 2)
   
    Point_D.x = x - (L / 2)
    Point_D.y = y + (H / 2)
   
    
    If (action = "dessine") Then
    couleur_corps = couleur_bleu
    couleur_centre = couleur_rouge
    End If
    
    If (action = "efface") Then
    couleur_corps = couleur_blanc
    couleur_centre = couleur_blanc
    End If
        
    ' rectangle
   
    
 
    'If PAD_Orientation = "r" Then
    
    'End If

    'If PAD_Orientation = "n" Then
    'corps du rectangle
    ' rectangle
    Form_principale.Graphe.Line (Point_A.x, -Point_A.y)-(Point_B.x, -Point_B.y), couleur_corps
    Form_principale.Graphe.Line (Point_B.x, -Point_B.y)-(Point_C.x, -Point_C.y), couleur_corps
    Form_principale.Graphe.Line (Point_C.x, -Point_C.y)-(Point_D.x, -Point_D.y), couleur_corps
    Form_principale.Graphe.Line (Point_D.x, -Point_D.y)-(Point_A.x, -Point_A.y), couleur_corps
    ' dessine le point de gravit
    Form_principale.Graphe.Circle (x, -y), taillepuce, couleur_centre
    'End If
 
End Function

Public Function Trouve_PAD(ByVal x As Double, ByVal y As Double, Optional ByRef DifX As Double, Optional ByRef DifY As Double)

    ' recherche un pad en fonction des coordonnees

    Dim PosX As Double, PosY As Double
    Dim pad As Integer
    Dim message As String

    ' 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()
        ' 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 > Pos_X - 50 And x < Pos_X + 50 And y > Pos_Y - 50 And y < Pos_Y + 50 Then
            pad = i
            If IsNumeric(DifX) Then DifX = x - Pos_X
            If IsNumeric(DifY) Then DifY = y - Pos_Y
        End If
    Next i

    Trouve_PAD = pad

End Function

Public Function Dessine_Liens()
    
    Dim i As Long

    If (NB_LIEN <> 0) Then
        For i = 0 To 125   'NB_LIEN - 1
            flag_retour = Objet_LIEN(i).Get_LIEN()
                If (i <= NB_PAD) Then
                    tmp = Objet_PAD(pad_lien).GetPosition_PAD()
                    Ax = Pos_X
                    Ay = Pos_Y
                End If
                If (i <= NB_BROCHE) Then
                    tmp = Objet_BROCHE(broche_lien).GetPosition_BROCHE()
                    Bx = Pos_X
                    By = Pos_Y
                End If
            Form_principale.Graphe.DrawWidth = 3
            Form_principale.Graphe.Line (Ax, -Ay)-(Bx, -By), RGB(255, 0, 0)
        Next i
    End If
    
    

End Function


Public Function Zone_recouvrement()



End Function