VERSION 5.00 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Begin VB.Form Form_principale Caption = "Bonding diagram" ClientHeight = 14310 ClientLeft = 60 ClientTop = 750 ClientWidth = 18885 Icon = "Form_principale.frx":0000 LinkTopic = "Form1" ScaleHeight = 14310 ScaleMode = 0 'User ScaleWidth = 26667.78 Begin VB.ComboBox Epaisseur_Combo Height = 315 Left = 16320 TabIndex = 16 Top = 10320 Width = 1935 End Begin VB.CommandButton Deplace Caption = "Deplacer " Height = 495 Left = 16560 TabIndex = 14 Top = 7800 Width = 1095 End Begin VB.Timer Timer_Splash Interval = 1000 Left = 17040 Top = 6600 End Begin VB.CheckBox Affiche_Grille_Check Caption = "Afficher Grille" Height = 375 Left = 16080 TabIndex = 4 Top = 2400 Value = 1 'Checked Width = 2295 End Begin VB.Timer Timer1 Interval = 50 Left = 5760 Top = 6120 End Begin VB.CheckBox Affiche_Axes_Check Caption = "Afficher les axes" Height = 255 Left = 16080 TabIndex = 3 Top = 2160 Value = 1 'Checked Width = 2415 End Begin MSComDlg.CommonDialog CmDlg Left = 6240 Top = 6240 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.Frame Frame1 Caption = "Echelle" Height = 1695 Left = 16080 TabIndex = 2 Top = 360 Width = 2655 Begin VB.TextBox Echelle_Y_max_Txt Height = 285 Left = 960 TabIndex = 13 Text = "Text2" Top = 1320 Width = 855 End Begin VB.TextBox Echelle_Y_min_Txt Height = 285 Left = 960 TabIndex = 12 Text = "Text1" Top = 240 Width = 855 End Begin VB.TextBox Echelle_X_max_Txt Height = 285 Left = 1680 TabIndex = 11 Text = "Text2" Top = 720 Width = 855 End Begin VB.TextBox Echelle_X_min_Txt Height = 285 Left = 120 TabIndex = 10 Text = "Text1" Top = 720 Width = 855 End Begin VB.Line Line1 BorderWidth = 3 X1 = 1395 X2 = 1395 Y1 = 360 Y2 = 1320 End Begin VB.Line Line2 BorderWidth = 3 X1 = 480 X2 = 2400 Y1 = 840 Y2 = 840 End End Begin VB.PictureBox Graphe AutoRedraw = -1 'True BackColor = &H00FFFFFF& Height = 13485 Left = 0 ScaleHeight = 38.661 ScaleLeft = -10 ScaleMode = 0 'User ScaleTop = -10 ScaleWidth = 44.881 TabIndex = 0 Top = 0 Width = 15645 Begin VB.PictureBox Zoom Height = 255 Left = 3840 ScaleHeight = 195 ScaleWidth = 555 TabIndex = 9 Top = 6240 Visible = 0 'False Width = 615 End End Begin MSComctlLib.StatusBar Status_Barre Align = 2 'Align Bottom Height = 255 Left = 0 TabIndex = 8 Top = 14055 Width = 18885 _ExtentX = 33311 _ExtentY = 450 _Version = 393216 BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} NumPanels = 7 BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} AutoSize = 2 Object.Width = 1058 MinWidth = 1058 Key = "Info_X" EndProperty BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} AutoSize = 2 Key = "Info_Y" EndProperty BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} AutoSize = 2 Object.Width = 3519 MinWidth = 3528 Key = "Distance" EndProperty BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} AutoSize = 1 Object.Width = 19475 MinWidth = 2 Key = "Angle" EndProperty BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628} AutoSize = 2 Object.Width = 1773 MinWidth = 1764 Key = "Infos" EndProperty BeginProperty Panel6 {8E3867AB-8586-11D1-B16A-00C0F0283628} AutoSize = 2 Object.Width = 1773 MinWidth = 1764 Key = "Date" EndProperty BeginProperty Panel7 {8E3867AB-8586-11D1-B16A-00C0F0283628} AutoSize = 2 Key = "Heure" EndProperty EndProperty End Begin VB.Label DrawWidthLbl Caption = "Epaisseur:" Height = 255 Left = 16320 TabIndex = 17 Top = 9960 Width = 1935 End Begin VB.Label Objet_pad_Lbl Height = 495 Left = 16080 TabIndex = 15 Top = 8880 Width = 1095 End Begin VB.Label Y_Lbl Caption = "Y:" Height = 615 Left = 16560 TabIndex = 7 Top = 5520 Width = 1575 End Begin VB.Label X_Lbl Caption = "X:" Height = 495 Left = 16560 TabIndex = 6 Top = 4560 Width = 1455 End Begin VB.Label Quadrant_Lbl Caption = "Quadrant:" Height = 615 Left = 16560 TabIndex = 5 Top = 3480 Width = 1575 End Begin VB.Label Coordonnees_Lbl Alignment = 2 'Center BackColor = &H00000000& ForeColor = &H00FFFFFF& Height = 315 Left = 0 TabIndex = 1 Top = 13560 Width = 15615 End Begin VB.Menu fichier Caption = "&Fichier" Begin VB.Menu Menu_Template Caption = "&Ouvrir Template" End Begin VB.Menu Menu_PAD Caption = "&Ouvrir PAD " End Begin VB.Menu Menu_Bonding_generator Caption = "&Bonding generator" End Begin VB.Menu Menu_Traitement Caption = "&Traitement" End Begin VB.Menu enregistrer Caption = "&Enregistrer" Shortcut = ^S End Begin VB.Menu Menu_Excel Caption = "&Exporter vers Excel" End Begin VB.Menu quitter Caption = "&Quitter" Shortcut = ^Q End End Begin VB.Menu Affichage Caption = "&Affichage" Begin VB.Menu Voir Caption = "&Voir " End End Begin VB.Menu choixzoom Caption = "&Zoom" Begin VB.Menu zoom_standard Caption = "&Zoom plein �cran" Shortcut = ^{F1} End Begin VB.Menu zoom_in Caption = "&Zoom In" Shortcut = ^{F2} End Begin VB.Menu zoom_out Caption = "&Zoom Out" Shortcut = ^{F3} End Begin VB.Menu zoomdecimal Caption = "&Zoom Decimal" Shortcut = ^{F4} End End Begin VB.Menu precision Caption = "&Infos" Begin VB.Menu Menu_A_Propos Caption = "&A Propos" End End End Attribute VB_Name = "Form_principale" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long Private Declare Function ScreenToClient Lib "USER32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function GetKeyState Lib "USER32" (ByVal nVirtKey As Long) As Integer Public A As Double Public B As Double Public C As Long Public Ay As Double Public Ax As Double Public STO_P As Long Private Type POINTAPI x As Long y As Long End Type Private Sub Deplace_Click() Status_Barre.Panels(4) = "ACTION: Deplace un pad" Status_Barre.Panels(4).Width = Len(Status_Barre.Panels(4).Text) 'redimensionnement action = "deplace" End Sub Private Sub Epaisseur_Combo_click() Dim str As String str = Epaisseur_Combo.Text Form_principale.Graphe.DrawWidth = CStr(str) End Sub Private Sub Graphe_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) ' variables communes Dim pad As Long, Pinnum As Long Dim PinType As String Dim Etat As Long Dim angle As String Dim aqw As Long 'mode ajout un pad If action = "ajout" Then Titre$ = "Orientation du pad" message$ = "Tapez N pour normal et R pour une rotation de 90�" angle$ = InputBox$(message$, Titre$) angle = LCase(angle) If (angle <> "n") And (angle <> "r") Then ' avorter Exit Sub End If type_pad = Type_PAD_Lbl.Caption ' insert un pad PAD_Ref = Insert_PAD(x, y, type_pad) Affiche_PAD Form_principale.Graphe End If ' deplace un pad If action = "deplace" Then ' cherche le pad qui vient d'�tre s�l�ctionner Objet_pad_actif = Trouve_PAD(x, y, DifX, DifY) Objet_pad_Lbl = Objet_pad_actif ' cherche la broche qui vient d'�tre s�l�ctionner Objet_broche_actif = Trouve_BROCHE(x, y, DifX, DifY) Objet_broche_Lbl = Objet_broche_actif End If ' mode suppression du pad If action = "supprime" Then Objet_pad_actif = Trouve_PAD(x, y) If Objet_pad_actif <> -1 Then ' detruit l'objet, et indique le tag effac�(0) dans le tableau Set Objet_PAD(Objet_pad_actif) = Nothing Affiche_PAD Form_principale.Graphe End If End If ' mode suppression de lien If action = "suplien" Then 'Dim LienPorteNum As Long 'Dim LienPinNum As Long 'tmp = TrouveLien(x, y, LienPorteNum, LienPinNum) 'If LienPorteNum <> -1 Then ' tmp = Objet_PAD(LienPorteNum).SetParent(LienPinNum, -1) ' Affiche_PAD Form_principale.Graphe 'End If End If ' creer un lien If action = "lien" Then ' trouve l'objet que l'on veut activer Objet_pad_actif = Trouve_PAD(x, y, DifX, DifY) ' on le tient If Objet_pad_actif <> -1 Then pad_selection = Objet_pad_actif Objet_pad_Lbl = "d�but:" & pad_selection Objet_broche_actif = Trouve_BROCHE(x, y, DifX, DifY) Objet_broche_Lbl = Objet_broche_actif End If End If 'prise des coordonn�es pour le zoom A = x B = y If Button = 2 Then 'valide le zoom si clic droit C = 1 Zoom.picture = Graphe.Image End If End Sub Private Sub Graphe_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 'hors des limites de la picturebox 'If X <= 0 Or Y <= 0 Then Exit Sub 'If X >= Graphe.Width Or Y >= Graphe.Height Then Exit Sub ' on deplace le pad If action = "deplace" And Button = 1 Then deltaX = x - MouseX deltaY = y - MouseY MouseX = x MouseY = y ' on bouge le pad If Objet_pad_actif <> -1 Then 'efface l'objet de l'on souhaite d�placer Efface_PAD Form_principale.Graphe 'Clipboard.Clear 'Clipboard.SetData Graphe.Image, vbCFBitmap 'Graphe.picture = Clipboard.GetData(vbCFBitmap) ' fixer les nouvelles coordon�es 'tmp = bouger(x - DifX + deltaX, -y - DifY + deltaY, Objet_pad_actif) tmp = bouger(x, -y, Objet_pad_actif) ' redessine l'objet Graphe.Cls 'Placer_PAD Form_principale.Graphe ' ins�re la copie 'Graphe.picture = Clipboard.GetData(vbCFBitmap) 'Placer_PAD Form_principale.Graphe 'Graphe.picture = Clipboard.GetData(vbCFBitmap) 'Clipboard.Clear 'Clipboard.SetData Graphe.Image, vbCFBitmap 'Graphe.picture = Clipboard.GetData(vbCFBitmap) 'Graphe.picture = LoadPicture(vbNullString) 'tmp = bouger(x - DifX + deltaX, -y - DifY + deltaY, Objet_pad_actif) Affiche_PAD Form_principale.Graphe tmp = Dessine_Liens() 'Efface_PAD Form_principale.Graphe 'a_PAD Form_principale.Graphe ' efface le pad ' sauvegarde ' nouvelles coordonn�es ' copie ' dessin End If End If ' on creer un lien If action = "lien" Then If pad_selection <> -1 Then 'Objet_broche_actif = Trouve_BROCHE(X, Y, DifX, DifY) 'Objet_broche_Lbl = Objet_broche_actif Dim PosX As Integer, PosY As Integer Dim Gravite_Pos_X As Integer, Gravite_Pos_Y As Integer Dim PinPos() As Integer tmp = Objet_PAD(pad_selection).GetPosition_PAD(PosX, PosY, Gravite_Pos_X, Gravite_Pos_Y) Affiche_PAD Form_principale.Graphe Affiche_BROCHE Form_principale.Graphe ' on trace une ligne de la pin au curseur 'If PinTypeSelectionnee = "entree" Then ' Form_principale.Graphe.Line (PinPos(0, PinNumSelectionnee), PinPos(1, PinNumSelectionnee))-(X, Y), RGB(255, 0, 0) 'Else Form_principale.Graphe.Line (PosX, -PosY)-(x, y), RGB(255, 0, 0) 'End If End If End If 'affichage de la box de zoom If C = 1 Then 'tra�age de la box Graphe.Cls Graphe.picture = Zoom.picture Graphe.Line (A, B)-(x, B), RGB(0, 255, 0) Graphe.Line (A, B)-(A, y), RGB(0, 255, 0) Graphe.Line (A, y)-(x, y), RGB(0, 255, 0) Graphe.Line (x, B)-(x, y), RGB(0, 255, 0) End If 'rafra�chissement des coordonn�es Coordonnees_Lbl.Caption = "X: " & x & " Y: " & -y End Sub Public Sub Axes() ' axes If Not Affiche_Axes_Check.Value = 1 Then Exit Sub 'ne pas tracer si pas coch� Graphe.Line (Graphe.ScaleLeft, 0)-(Graphe.ScaleWidth, 0), RGB(0, 0, 255) Graphe.Line (0, Graphe.ScaleTop)-(0, Graphe.ScaleHeight), RGB(0, 0, 255) End Sub Public Sub Grille() ' Grille If Not Affiche_Grille_Check.Value = 1 Then Exit Sub 'ne pas tracer si pas coch� Dim i As Single Dim j As Single Dim Echelle_X As Integer Dim Echelle_Y As Integer 'Graphe.DrawWidth = 1 'Graphe.DrawMode = 6 'Graphe.DrawStyle = 0 'Graphe.PSet (0, 0), vbBlack Echelle_X = 1000 'CSng(txt_Grille_X.Text) Echelle_Y = 1000 'CSng(txt_Grille_Y.Text) 'Graphe.DrawWidth = 1 'Graphe.DrawMode = 13 'Graphe.DrawStyle = 0 For i = 0 To Graphe.ScaleWidth / 2 Step Echelle_X For j = 0 To Graphe.ScaleHeight / 2 Step Echelle_Y Graphe.PSet (i, j), vbBlack ' Q4 Graphe.PSet (i, -j), vbBlack ' Q1 Graphe.PSet (-i, j), vbBlack ' Q3 Graphe.PSet (-i, -j), vbBlack 'Q2 Next j Next i End Sub Private Sub Affiche_Axes_Check_Click() Graphe.Cls Call Axes flag_retour = rafraichir_ecran() End Sub Private Sub Affiche_Grille_Check_Click() Graphe.Cls Call Grille flag_retour = rafraichir_ecran() End Sub Private Sub copier_Click() 'copie de l'image dans le clipboard Clipboard.Clear Clipboard.SetData Picture1.Image, vbCFBitmap End Sub Private Sub enregistrerimage_Click() 'enregistrement de l'image au format *.bmp On Error GoTo AnnulerErr With CD1 .CancelError = True .DialogTitle = "Sauvegarder l'image de la courbe" .Filter = "Image Bitmap |*.bmp" .ShowSave End With If Not UCase$(Right$(CD1.FileName, 4)) = ".BMP" Then CD1.FileName = CD1.FileName + ".bmp" SavePicture Picture1.Image, CD1.FileName AnnulerErr: End Sub Private Sub Init() 'd�finition de l'�cran Dim x_pixel As Long, y_pixel As Long Objet_pad_actif = -1 Objet_broche_actif = -1 Objet_lien_actif = -1 pad_selection = -1 NB_LIEN = 0 'd�finition de l'�chelle Graphe.ScaleLeft = -8000 Graphe.ScaleWidth = 16000 Graphe.ScaleTop = -8000 Graphe.ScaleHeight = 16000 ' zone d'affichage du zoom (infos) Echelle_X_min_Txt.Text = Graphe.ScaleLeft Echelle_X_max_Txt.Text = Graphe.ScaleWidth Echelle_Y_min_Txt.Text = Graphe.ScaleTop Echelle_Y_max_Txt.Text = Graphe.ScaleHeight 'resolution horizontale ' 19200 x_pixel = Screen.Width 'resolution verticale ' 15360 y_pixel = Screen.Height ' change la g�om�trie du curseur de la souris : croix Form_principale.MousePointer = vbCrosshair ' initialisation numero_lien = 0 couleur_vert = RGB(0, 255, 0) couleur_bleu = RGB(0, 0, 255) couleur_noir = RGB(0, 0, 0) couleur_rouge = RGB(255, 0, 0) couleur_blanc = RGB(255, 255, 255) 'Epaisseur_Combo.List(0) = 1 'Epaisseur_Combo.List(1) = 2 'Epaisseur_Combo.List(2) = 3 Epaisseur_Combo.AddItem ("1") Epaisseur_Combo.AddItem ("2") Epaisseur_Combo.AddItem ("3") Epaisseur_Combo.AddItem ("4") Epaisseur_Combo.AddItem ("5") End Sub Private Sub Form_Load() 'Call Splash C = 0 'invalide la box de zoom ' plein �cran Form_principale.WindowState = vbMaximized Call Init Call Axes Call Grille Call charge_padring End Sub Sub charge_padring() Dim i As Integer ' insert des pads retour = Insert_PAD(1000, 1000, type_pad, "n") retour = Insert_PAD(2000, 2000, type_pad, "n") retour = Insert_PAD(3000, 3000, type_pad, "n") Affiche_PAD Form_principale.Graphe End Sub Sub t() Dim X1 As Double Dim X2 As Double Dim Y1 As Double Dim Y2 As Double 'Graphe.PSet (X, -Y), RGB(255, 0, 0) 'Rectangle Graphe.hdc, 2, 2, 8, 6 X1 = 2000 Y1 = 2000 X2 = 18000 Y2 = 6000 Graphe.Line (X1, -Y1)-(X2, -Y2) End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) End End Sub Private Sub Form_Unload(Cancel As Integer) ' Quitter l'application ' � pr�ciser ... End End Sub Private Sub Graphe_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Not Button = 2 Then Exit Sub C = 0 'invalide la box de zoom 'zoom On Error Resume Next Graphe.ScaleLeft = A Graphe.ScaleWidth = x + Abs(A) Graphe.ScaleHeight = y + Abs(B) Graphe.ScaleTop = B Echelle_X_min_Txt.Text = A Echelle_X_max_Txt.Text = x Echelle_Y_min_Txt.Text = -B Echelle_Y_max_Txt.Text = -y 'enl�ve la picture de sauvegarde temporaire Graphe.picture = LoadPicture(vbNullString) Graphe.Cls flag_retour = rafraichir_ecran() End Sub Private Sub Menu_A_Propos_Click() apropos_Frm.Show End Sub Private Sub Menu_Bonding_generator_Click() Dim i As Integer For i = 0 To NB_BROCHE flag_retour = Insert_Lien(i + 1, i + 1) Next i flag_retour = Dessine_Liens() End Sub Private Sub Menu_Excel_Click() ' passerelle vers EXCEL ' en cours ... End Sub Private Sub Menu_Traitement_Click() traitement_bonding End Sub Private Sub Menu_Template_Click() Call Import_Template End Sub Private Sub Menu_PAD_Click() Call Import_PAD End Sub Private Sub quitter_Click() End End Sub Private Sub reconstruire_Click() On Error Resume Next Graphe.ScaleLeft = Val(Echelle_X_min_Txt.Text) Graphe.ScaleHeight = Val(Echelle_Y_max_Txt.Text) Graphe.ScaleWidth = Val(Echelle_X_max_Txt.Text) Graphe.ScaleTop = Val(Echelle_Y_min_Txt.Text) Graphe.Cls flag_retour = rafraichir_ecran() End Sub Private Sub Timer1_Timer() Dim souris As POINTAPI Status_Barre.Panels(5) = " En cours de debug..." Status_Barre.Panels(6) = Date Status_Barre.Panels(6).Width = Len(Status_Barre.Panels(6).Text) 'redimensionnement Status_Barre.Panels(7) = Time Status_Barre.Panels(7).Width = Len(Status_Barre.Panels(7).Text) 'redimensionnement Call GetCursorPos(souris) ScreenToClient Graphe.hwnd, souris 'x=533 pixels (width) 'y=453 pixels (height) 'X_Lbl = souris.X 'Y_Lbl = souris.Y If GetKeyState(&H28) < 0 Then MsgBox "Fl�che curseur bas" End If If GetKeyState(&H27) < 0 Then MsgBox "Fl�che curseur droit" End If If GetKeyState(&H26) < 0 Then MsgBox "Fl�che curseur haut" End If If GetKeyState(&H25) < 0 Then MsgBox "Fl�che curseur gauche" End If If GetKeyState(&H52) < 0 Then ' Rafraichir 'r' Graphe.Cls Call Axes Call Grille flag_retour = rafraichir_ecran() End If If GetKeyState(&H46) < 0 Then ' Fit 'f' pour le plein �cran flag_retour = plein_ecran() End If End Sub Private Sub Voir_Click() Dim A As Integer A = toto(128) Form1.Show End Sub Private Sub zoom_in_Click() 'un zoom in Echelle_X_min_Txt.Text = Val(Echelle_X_min_Txt.Text) / 1.5 Echelle_X_max_Txt.Text = Val(Echelle_X_max_Txt.Text) / 1.5 Echelle_Y_min_Txt.Text = Val(Echelle_Y_min_Txt.Text) / 1.5 Echelle_Y_max_Txt.Text = Val(Echelle_Y_max_Txt.Text) / 1.5 ' Call reconstruire_Click End Sub Private Sub zoom_out_Click() 'un zoom out Echelle_X_min_Txt.Text = Val(Echelle_X_min_Txt.Text) * 1.5 Echelle_X_max_Txt.Text = Val(Echelle_X_max_Txt.Text) * 1.5 Echelle_Y_min_Txt.Text = Val(Echelle_Y_min_Txt.Text) * 1.5 Echelle_Y_max_Txt.Text = Val(Echelle_Y_max_Txt.Text) * 1.5 ' Call reconstruire_Click End Sub Private Sub zoom_standard_Click() flag_retour = plein_ecran() End Sub Private Sub Splash() Call frmSplash.Show End Sub Private Sub Timer_Splash_Timer() sec = sec + 1 If sec >= delai Then Unload frmSplash Form_principale.Timer_Splash.Enabled = False End If End Sub Private Function plein_ecran() 'zoom standard Echelle_X_min_Txt.Text = -8000 Echelle_X_max_Txt.Text = 16000 Echelle_Y_min_Txt.Text = -8000 Echelle_Y_max_Txt.Text = 16000 'recadre la zone d'affichage Call reconstruire_Click End Function Private Function rafraichir_ecran() If (Template_charger = 1) Then ' retracer Affiche_BROCHE Form_principale.Graphe End If If (Padring_charger = 1) Then ' retracer Affiche_PAD Form_principale.Graphe End If flag_retour = Dessine_Liens() End Function