Create New Item
Item Type
File
Folder
Item Name
Search file in folder and subfolders...
Are you sure want to rename?
File Manager
/
Dessin
:
VB452.tmp
Advanced Search
Upload
New Item
Settings
Back
Back Up
Advanced Editor
Save
Attribute VB_Name = "Module1" Public Function Import_Template() On Error GoTo OpenError Dim Fichier_Nom As String Dim Data As String Dim chaine(200) As String Dim nbre_ligne As Integer Dim position As Integer Dim cpt_BROCHE As Integer nbre_ligne = 1 With Form_principale .CmDlg.CancelError = True .CmDlg.DialogTitle = "S�l�ction du fichier � ouvrir" .CmDlg.Filter = filtre_champ .CmDlg.FilterIndex = 1 .CmDlg.ShowOpen End With Fichier_Nom = Form_principale.CmDlg.FileName traitement_fichier_unix (Fichier_Nom) ' lecture du fichier 'Open Fichier_Nom For Input As #1 'Dim temp As String 'Dim PAD_toto As Integer ' While Not EOF(1) ' Input #1, Data$ ' cpt_BROCHE = cpt_BROCHE + 1 ' chaine(nbre_ligne) = Data$ ' temp = chaine(nbre_ligne) ' temp = extraction_champ(temp, "Template") ' ajouter ' pipo = Insert_BROCHE(Pos_X, Pos_Y, Num) ' Affiche_BROCHE Form_principale.Graphe ' nbre_ligne = nbre_ligne + 1 ' Wend 'Close #1 OpenError: End Function Public Function traitement_fichier_unix(ByVal fichier As String) Dim ligne As String Dim Buffer As String Dim Lignes As Variant Dim Pnt As Integer Open fichier For Binary As #2 Buffer = String(LOF(2), 0) 'on dimensionne buffer � la taille du fichier Get #2, , Buffer 'on lit le fichier en entier Close #2 Lignes = Split(Buffer, vbLf) 'on decoupe le buffer dans un tableau For Pnt = 0 To UBound(Lignes) - 1 ' remplace le s�parateur par un espace Lignes(Pnt) = Replace(Lignes(Pnt), Chr(9), " ") ' remplace le point par une virgule Lignes(Pnt) = Replace(Lignes(Pnt), ".", ",") ' temporaire ligne = Lignes(Pnt) temp = extraction_champ(ligne, "Template") 'ajouter pipo = Insert_BROCHE(Pos_X, Pos_Y, Num) Next tmp = "55" Affiche_BROCHE Form_principale.Graphe End Function Public Function Insert_BROCHE(ByVal cX As Double, ByVal cY As Double, ByVal Num) As Long ' incr�mente le nombre de broche NB_BROCHE = NB_BROCHE + 1 ' redimensionne le tableau de liens ReDim Preserve Objet_BROCHE(NB_BROCHE - 1) ' instancie une nouvelle broche Set Objet_BROCHE(NB_BROCHE - 1) = New BROCHE ' defini les parametres de la nouvelle broche tmp = Objet_BROCHE(NB_BROCHE - 1).Set_BROCHE_Parametres(NB_BROCHE - 1, cX, cY) ' retourne l'ID Insert_BROCHE = NB_BROCHE - 1 End Function Public Sub Affiche_BROCHE(picture As PictureBox) Dim i As Integer picture.Cls For i = 0 To NB_BROCHE - 1 ' recupere la position de la pin tmp = Objet_BROCHE(i).Get_BROCHE_Position() 'dessine la pin 'tmp = Dessine_BROCHE(Pos_X, Pos_Y, picture) 'tmp = Objet_PAD(i).SetPosition(PosX, PosY, Gravite_Pos_X, Gravite_Pos_Y) Next i End Sub Public Function Dessine_BROCHE(ByVal X As Double, ByVal Y As Double, picture As PictureBox) Dim i As Integer Dim couleur As String Dim largeur As Double Dim longueur As Double Dim Point_A As A Dim Point_B As B Dim Point_C As C Dim Point_D As D couleur = &H80000007 Dim X1 As Integer Dim X2 As Integer Dim Y1 As Integer Dim Y2 As Integer 'Graphe.PSet (X, -Y), RGB(255, 0, 0) 'Rectangle Graphe.hdc, 2, 2, 8, 6 longueur = 5000 largeur = 5000 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) X1 = 10000 Y1 = 10000 X2 = 22000 Y2 = 16000 Graphe.Line (X1, -Y1)-(X2, -Y2) 'Trace des croix centr�es sur le curseur 'For i = -5 To 5 ' pic.PSet (X - 66 + i, Y - 48), couleur ' pic.PSet (X - 66, Y - 48 + i), couleur 'Trace des croix centr�es sur le curseur 'Next i ' dessine une croix pour indiquer la position dans le plan 'pic.Line (X, Y)-(X + 50, Y), couleurboite 'pic.Line (X + 25, Y - 25)-(X, Y + 25), couleurboite ' dessine le point de gravit� ' pic.Circle (X + largeur / 2, Y + hauteur / 2), taillepuce, couleur 'For i = 0 To 50 'pic.PSet (X, Y + i), couleurboite 'Next i 'For i = 0 To 50 'pic.PSet (X + 25, Y - 25 + i), couleurboite 'Next i End Function