File "Template.bas"
Full Path: /home/analogde/www/Dessin/Template.bas
File size: 7.63 KB
MIME-type: text/plain
Charset: 8 bit
Attribute VB_Name = "Module1"
Public Function Import_Template()
flag_retour = ouvrir_document("BROCHE")
If (flag_retour = 1) Then
Template_charger = 1
End If
'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 = "Slction 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 Import_PAD()
flag_retour = ouvrir_document("PAD")
If (flag_retour = 1) Then
Padring_charger = 1
End If
If (Template_charger = 1) Then
Affiche_BROCHE Form_principale.Graphe
Affiche_PAD Form_principale.Graphe
End If
End Function
Public Function ouvrir_document(ByVal traitement As String)
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 = False
.CmDlg.DialogTitle = "Slction du fichier ouvrir"
.CmDlg.Filter = filtre_champ
.CmDlg.FilterIndex = 1
.CmDlg.ShowOpen
End With
Fichier_Nom = Form_principale.CmDlg.FileName
If Fichier_Nom = "" Then
Exit Function
End If
tmp = traitement_fichier_unix(Fichier_Nom, traitement)
ouvrir_document = 1
If (traitement = "PAD") Then
Affiche_PAD Form_principale.Graphe
End If
If (traitement = "BROCHE") Then
Affiche_BROCHE Form_principale.Graphe
End If
End Function
Public Function traitement_fichier_unix(ByVal fichier As String, ByVal traitement 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 sparateur 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
If (traitement = "PAD") Then
pipo = Insert_PAD(Pos_X, Pos_Y, Num)
End If
If (traitement = "BROCHE") Then
pipo = Insert_BROCHE(Pos_X, Pos_Y, Num)
End If
' stockage dans MSFlexgrid
'Num
'Pos_X
'Pos_Y
'Type_Instance
'Orientation
Next
End Function
Public Function Insert_BROCHE(ByVal x As Double, ByVal y As Double, ByVal Num) As Long
' incrmente 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, x, y)
' 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).GetPosition_BROCHE()
'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
Form_principale.Axes
Form_principale.Grille
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 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
couleur = &H80000007
L = 200
H = 200
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)
' rectangle
Form_principale.Graphe.Line (Point_A.x, -Point_A.y)-(Point_B.x, -Point_B.y)
Form_principale.Graphe.Line (Point_B.x, -Point_B.y)-(Point_C.x, -Point_C.y)
Form_principale.Graphe.Line (Point_C.x, -Point_C.y)-(Point_D.x, -Point_D.y)
Form_principale.Graphe.Line (Point_D.x, -Point_D.y)-(Point_A.x, -Point_A.y)
'Graphe.PSet (X, -Y), RGB(255, 0, 0)
'Rectangle Graphe.hdc, 2, 2, 8, 6
'Graphe.Line (X1, -Y1)-(X2, -Y2)
'Graphe.Line (X1, -Y1)-(X2, -Y2)
'Graphe.Line (X1, -Y1)-(X2, -Y2)
'Graphe.PSet (X, -Y), RGB(255, 0, 0)
'Rectangle Graphe.hdc, 2, 2, 8, 6
'Trace des croix centres 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 centres 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
Public Function Trouve_BROCHE(ByVal x As Double, ByVal y As Double, Optional ByRef DifX As Double, Optional ByRef DifY As Double)
' trouve une broche en fonction des coordonnees
Dim PosX As Double, PosY As Double
Dim BROCHE As Integer
Dim message As String
'MsgBox "X: " & X & "Y:" & -Y
' correction de l'offset
y = -y
' par defaut pad non trouve
BROCHE = -1
For i = 0 To NB_BROCHE - 1
' on recupere les positions du pad
tmp = Objet_BROCHE(i).GetPosition_BROCHE()
' 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 la zonne de selection, c'est gagn
If x > PosX - 50 And x < PosX + 50 And y > PosY - 50 And y < PosY + 50 Then
BROCHE = i
If IsNumeric(DifX) Then DifX = x - PosX
If IsNumeric(DifY) Then DifY = y - PosY
End If
Next i
Trouve_BROCHE = BROCHE
End Function