Create New Item
Item Type
File
Folder
Item Name
Search file in folder and subfolders...
Are you sure want to rename?
File Manager
/
Dessin
:
Module3.bas
Advanced Search
Upload
New Item
Settings
Back
Back Up
Advanced Editor
Save
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 ' incr�mente 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