Tiny File Manager

Back Back Up Advanced Editor

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form Prog_Frm 
   AutoRedraw      =   -1  'True
   Caption         =   "Bonding diagram"
   ClientHeight    =   9630
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   12855
   Icon            =   "Prog_Frm.frx":0000
   LinkTopic       =   "Form2"
   ScaleHeight     =   169.863
   ScaleMode       =   0  'User
   ScaleWidth      =   226.748
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox Schema_Box 
      BackColor       =   &H00FFFFFF&
      Height          =   6615
      Left            =   2400
      ScaleHeight     =   6555
      ScaleMode       =   0  'User
      ScaleWidth      =   7395
      TabIndex        =   15
      Top             =   1920
      Width           =   7455
   End
   Begin VB.CheckBox Affiche_Axe_Chk 
      Caption         =   "Afficher axes"
      Height          =   375
      Left            =   5280
      TabIndex        =   14
      Top             =   720
      Width           =   1335
   End
   Begin VB.Timer Timer1 
      Interval        =   50
      Left            =   10800
      Top             =   7800
   End
   Begin MSComDlg.CommonDialog CmDlg 
      Left            =   11280
      Top             =   6720
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.TextBox txt_Grille_X 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Height          =   285
      Left            =   720
      TabIndex        =   10
      Text            =   "5"
      Top             =   7320
      Width           =   495
   End
   Begin VB.TextBox txt_Grille_Y 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      Height          =   285
      Left            =   1200
      TabIndex        =   9
      Text            =   "5"
      Top             =   7320
      Width           =   495
   End
   Begin VB.CheckBox Grille_Check 
      BackColor       =   &H00E0E0E0&
      Caption         =   "Grille"
      Height          =   285
      Left            =   240
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   7320
      Value           =   1  'Checked
      Width           =   540
   End
   Begin VB.CheckBox Affiche_Grille_Chk 
      Caption         =   "Afficher Grille"
      Height          =   375
      Left            =   7320
      TabIndex        =   7
      Top             =   720
      Width           =   2295
   End
   Begin VB.CommandButton Supprimer_Lien 
      Caption         =   "Supprimer un lien"
      Height          =   495
      Left            =   120
      TabIndex        =   6
      Top             =   4560
      Width           =   1095
   End
   Begin VB.CommandButton Supprimer 
      Caption         =   "Supprimer "
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   2400
      Width           =   1095
   End
   Begin VB.CommandButton Creer_Lien 
      Caption         =   "Cr�er un lien"
      Height          =   495
      Left            =   120
      TabIndex        =   3
      Top             =   3960
      Width           =   1095
   End
   Begin VB.CommandButton Deplace 
      Caption         =   "Deplacer "
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   3000
      Width           =   1095
   End
   Begin VB.CommandButton Ajouter 
      Caption         =   "Ajouter"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   1800
      Width           =   1095
   End
   Begin MSComctlLib.ImageList Icones_Barre 
      Left            =   240
      Top             =   5760
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   18
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":08CA
            Key             =   "New"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":09DC
            Key             =   "Open"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":0AEE
            Key             =   "Save"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":0C00
            Key             =   "Print"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":0D12
            Key             =   "Excel"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":1064
            Key             =   "Cut"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":1176
            Key             =   "Copy"
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":1288
            Key             =   "Paste"
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":139A
            Key             =   "Bold"
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":14AC
            Key             =   "Italic"
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":15BE
            Key             =   "Underline"
         EndProperty
         BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":16D0
            Key             =   "Align Left"
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":17E2
            Key             =   "Center"
         EndProperty
         BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":18F4
            Key             =   "Align Right"
         EndProperty
         BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":1A06
            Key             =   "FitToScreen"
         EndProperty
         BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":1C5A
            Key             =   "ZoomIn"
         EndProperty
         BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":1EAE
            Key             =   "ZoomOut"
         EndProperty
         BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Prog_Frm.frx":2102
            Key             =   "ZoomWindow"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.StatusBar Status_Barre 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   11
      Top             =   9375
      Width           =   12855
      _ExtentX        =   22675
      _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           =   8839
            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 Objet_broche_Lbl 
      Height          =   735
      Left            =   11520
      TabIndex        =   19
      Top             =   4800
      Width           =   1215
   End
   Begin VB.Label Selection_broche_Lbl 
      Caption         =   "Broche actif:"
      Height          =   495
      Left            =   10080
      TabIndex        =   18
      Top             =   4800
      Width           =   1095
   End
   Begin VB.Label Selection_pad_Lbl 
      Caption         =   "Pad actif:"
      Height          =   495
      Left            =   10080
      TabIndex        =   17
      Top             =   3840
      Width           =   735
   End
   Begin VB.Label Objet_pad_Lbl 
      Height          =   495
      Left            =   10920
      TabIndex        =   16
      Top             =   3840
      Width           =   1695
   End
   Begin VB.Label Lbl_Y 
      Caption         =   "Label2"
      Height          =   495
      Left            =   480
      TabIndex        =   13
      Top             =   8760
      Width           =   1575
   End
   Begin VB.Label Lbl_X 
      Caption         =   "Label1"
      Height          =   375
      Left            =   480
      TabIndex        =   12
      Top             =   8040
      Width           =   1335
   End
   Begin VB.Image PAD 
      Height          =   660
      Left            =   1800
      Picture         =   "Prog_Frm.frx":2356
      Top             =   600
      Width           =   945
   End
   Begin VB.Image PAD_Actif 
      Appearance      =   0  'Flat
      BorderStyle     =   1  'Fixed Single
      Height          =   735
      Left            =   240
      Top             =   600
      Width           =   855
   End
   Begin VB.Label Type_PAD_Lbl 
      Alignment       =   2  'Center
      Caption         =   "Type"
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   960
      Width           =   855
   End
   Begin VB.Label ActionEnCours 
      Height          =   255
      Left            =   2640
      TabIndex        =   1
      Top             =   8760
      Width           =   5775
   End
   Begin VB.Menu Fichier 
      Caption         =   "Fichier"
      Begin VB.Menu Mnu_Import_Pad 
         Caption         =   "Importer pad"
      End
      Begin VB.Menu Mnu_Import_Template 
         Caption         =   "Importer Template"
      End
      Begin VB.Menu Sauver 
         Caption         =   "Sauver"
      End
      Begin VB.Menu Espace 
         Caption         =   "-"
      End
      Begin VB.Menu Mnu_Quitter 
         Caption         =   "Quitter"
      End
   End
   Begin VB.Menu Mnu_Affichage 
      Caption         =   "Affichage"
      Begin VB.Menu Mnu_PleineFenetre 
         Caption         =   "Pleine Fenetre"
      End
      Begin VB.Menu Mnu_ZoomPlus 
         Caption         =   "Zoom +"
      End
      Begin VB.Menu Mnu_ZoomMoins 
         Caption         =   "Zoom -"
      End
   End
   Begin VB.Menu Composants 
      Caption         =   "Composants"
      Begin VB.Menu Ouvrir 
         Caption         =   "Ouvrir"
      End
      Begin VB.Menu Detecteurs 
         Caption         =   "Detecteurs de Front"
      End
      Begin VB.Menu OutPut 
         Caption         =   "OutPut"
      End
   End
   Begin VB.Menu APropos 
      Caption         =   "A Propos"
   End
End
Attribute VB_Name = "Prog_Frm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
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 TextOut Lib "gdi32" Alias _
"TextOutA" _
(ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal lpString As String, _
ByVal nCount As Long) As Long

Const PS_SOLID = 0

Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Private Type Point
    X As Single
    Y As Single
    
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private x_Schema_Box_pixel As Long
Private y_Schema_Box_pixel As Long

Private Sub Affiche_Axe_Chk_Click()

Schema_Box.Cls

'tra�age des axes
Call Axes

End Sub

Private Sub Ajouter_Click() ' ajouter un nouveau pad
ActionEnCours.Caption = "Ajoute un pad"
Action = "ajout"
End Sub

Private Sub APropos_Click()

MsgBox "En cours de d�veloppement (F�vrier 2007)" & vbNewLine & "Par Patrice" & vbNewLine & vbNewLine & "Freeware - OpenSource" & vbNewLine & "Vous pouvez modifier ce logiciel librement," & vbNewLine & "mais tenez-moi au courant de vos �volutions !" & vbNewLine & "S�bastien LADEN - seb79fr@yahoo.fr"

End Sub

Private Sub ChangeEtat_Click() ' change manuellement un etat en cliquant sur un objet
ActionEnCours.Caption = "Change un etat"
Action = "changeetat"
End Sub

Private Sub Affiche_Grille_Chk_Click()

'If Affiche_Grille_Chk.Value = vbChecked Then Dessine_Grille

'Call Points_Click
Call Dessine_Grille

End Sub

Private Sub Creer_Lien_Click() ' creer un nouveau lien
ActionEnCours.Caption = "Creer un lien"
Action = "lien"
End Sub

Private Sub Deplace_Click() ' deplace un pad
ActionEnCours.Caption = "Deplace un pad"
Action = "deplace"
End Sub

Private Sub Form_Load()

'PinNumSelectionnee = -1 ' Ne selectionne rien par defaut
'PinPad_Actif = -1
'PinTypeSelectionnee = -1

'PAD_Actif.Picture = PAD.Picture ' PAD actif par d�faut

'Type_PAD_Lbl.Caption = "PAD"

'hRPen = CreatePen(PS_SOLID, 3, vbBlue)
'
'Rectangle Prog_Frm.Schema_Box, 0, 0, 400, 400
'TextOut Prog_Frm.Schema_Box, 50, 50, "Salut", 5

'couleur = &H80000007

Call init

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
' propose de sauvegarder avant de quitter

If NBGates > 0 Then
    reponse = MsgBox("Voulez-vous sauvegarder avant de quitter?", vbYesNo)
    If reponse = vbYes Then
        Cancel = 1
        Sauvegarde
    End If
End If

End Sub

Private Sub Form_Resize() ' redimmensionne la picture box avec la fenetre
'Schema_Box.Width = Prog_Frm.Width - 1600
'Schema_Box.Height = Prog_Frm.Height - 2150
'ActionEnCours.Top = Prog_Frm.Height - 1050

ReDraw_PAD Prog_Frm.Schema_Box
ReDraw_BROCHE Prog_Frm.Schema_Box

End Sub

Private Sub Minuterie_Timer()

Dim nt As POINTAPI
GetCursorPos nt
'Etiquette1.Caption = "x=" + Str$(lppt.X) + ";y=" + Str$(lppt.Y)

End Sub

Private Sub Mnu_Import_Pad_Click()
 
Call Ouvrir_Document
TextOut Prog_Frm.Schema_Box, 50, 50, "Salut", 5
 
End Sub
Private Sub Mnu_Import_Template_Click()
 
Dim X1 As Integer
Dim Y1 As Integer
Dim X2 As Integer
Dim Y2 As Integer

Dim temp As Integer

X1 = 200
Y1 = 200
X2 = 100
Y2 = 100

temp = calculer_angle(X1, Y1, X2, Y2)
Call Import_Template
 
End Sub
 
 Private Sub Mnu_Quitter_Click()

message$ = "Voulez vous vraiment quitter le programme ?"
reponse% = MsgBox(message$, 4 + 32, T$)
If reponse% = 6 Then
'Sortir du programme
End
End If

End Sub

Private Sub PAD_Click() ' selectionne un pad
PAD_Actif.Picture = PAD.Picture
Type_PAD_Lbl.Caption = "bidule"
End Sub

Private Sub OutPut_Click()
Outputfrm.Show
End Sub

Private Sub Ouvrir_Click()
tmp = Charge()
End Sub

Private Sub Sauver_Click()  ' Sauvegarde le Schema_Box
tmp = Sauvegarde()
End Sub

Private Sub Schema_Box_DblClick() ' annule le lien en cours

Objet_pad_actif = -1

'PinNumSelectionnee = -1
'PinTypeSelectionnee = -1

End Sub

Private Sub Schema_Box_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
 
 
 'Instructions (autoriser l'acc�s)
 'Else
 'Instructions (refuser l'acc�s et quitter le programme)  'Fin de la proc�dure
 'End If

Type_PAD = Type_PAD_Lbl.Caption
   ' insert un pad
    PAD_Ref = Insert_PAD(X, Y, Type_PAD, angle)
    ReDraw_PAD Prog_Frm.Schema_Box

End If

' deplace un pad
If Action = "deplace" Then

' on enregistre les valeurs de depart, pour comparer a l'arriv�e et bouger le pad
    MouseX = X
    MouseY = Y
    ' 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
        ReDraw_PAD Prog_Frm.Schema_Box
    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)
        ReDraw_PAD Me.Schema_Box
    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
     
     'Objet_broche_actif = Trouve_BROCHE(X, Y, DifX, DifY)
     'Objet_broche_Lbl = Objet_broche_actif
     'MsgBox "blog"
     'End If
     
     
     
     'If Objet_broche_actif <> -1 Then
     'MsgBox "connexion"
     ' si c'est la fin du lien, on le sauvegarde
     'tmp = Objet_PAD(Objet_pad_actif).SetParent(Objet_pad_actif, Objet_broche_actif)
     'End If
     
    ' trouve la pin cliquee
    'tmp = Trouve_Gravite(X, Y, PAD, Pinnum, PinType)
    ' elle est reconnue
    'If PAD <> -1 Then
    '    If PinNumSelectionnee = -1 Then ' si c'est le debut du lien
    '        PinNumSelectionnee = Pinnum ' on sauvegarde la puce
    '        PinPad_Actif = Porte
    '        PinTypeSelectionnee = PinType
    '    Else ' c'est la fin du lien, on le creer
    '        If PinTypeSelectionnee <> PinType Then ' on connect une entree a une sortie, pas de type identique
    '            If PinType = "sortie" Then
    '                tmp = Objet_PAD(PinPad_Actif).SetParent(PinNumSelectionnee, PAD)
                   
                   
    '            Else
                   ' tmp = Objet_PAD(Porte).SetParent(Pinnum, PinPad_Actif)
                   
    '            End If
    '            PinNumSelectionnee = -1 ' on deselectionne tout
    '            PinPad_Actif = -1
    '            PinTypeSelectionnee = -1
    '        Else ' impossible de creer le lien
    '            MsgBox "Deux " & PinType & "s ne peuvent pas etre connect�es ensemble !"
    '        End If
    '    End If
    '    ReDraw_PAD Prog_Frm.Schema_Box
    'End If
End If

End Sub

Private Sub Schema_Box_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 >= Schema_Box.Width Or Y >= Schema_Box.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
    tmp = bouger(X - DifX + deltaX, -Y - DifY + deltaY, Objet_pad_actif)
    ReDraw_PAD Prog_Frm.Schema_Box
    ReDraw_BROCHE Prog_Frm.Schema_Box
    
 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)
            
            ReDraw_PAD Prog_Frm.Schema_Box
            ReDraw_BROCHE Prog_Frm.Schema_Box
           
            
            ' on trace une ligne de la pin au curseur
            'If PinTypeSelectionnee = "entree" Then
            '    Prog_Frm.Schema_Box.Line (PinPos(0, PinNumSelectionnee), PinPos(1, PinNumSelectionnee))-(X, Y), RGB(255, 0, 0)
            'Else
                Prog_Frm.Schema_Box.Line (PosX, -PosY)-(X, Y), RGB(255, 0, 0)
            'End If
            
    End If
End If

End Sub

Private Sub Schema_Box_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
' on leve le clic, on deselectionne tout
MouseX = -1
MouseY = -1
'Objet_pad_actif = -1

ReDraw_PAD Prog_Frm.Schema_Box
ReDraw_BROCHE Prog_Frm.Schema_Box

End Sub

Private Sub Supprimer_Lien_Click()
'on supprime un lien
ActionEnCours.Caption = "Supprimer un lien"
Action = "supprime_lien"

End Sub

Private Sub Supprimer_Click()
'on supprime une pad
ActionEnCours.Caption = "Supprimer une porte"
Action = "supprime"

End Sub

Private Sub Dessine_Grille()

Dim i As Single
Dim j As Single

Schema_Box.DrawWidth = 1
Schema_Box.DrawMode = 6
Schema_Box.DrawStyle = 0

Schema_Box.PSet (0, 0), vbBlack
Echelle_X = 400 'CSng(txt_Grille_X.Text)
Echelle_Y = 400 'CSng(txt_Grille_Y.Text)

Schema_Box.DrawWidth = 1
Schema_Box.DrawMode = 13
Schema_Box.DrawStyle = 0

For i = 0 To Schema_Box.ScaleWidth Step Echelle_X
    For j = 0 To Schema_Box.ScaleHeight Step Echelle_Y
        Schema_Box.PSet (i, j), vbBlack
    Next j
Next i

End Sub

Private Sub Points_Click()

Dim i As Integer
Dim j As Integer

For j = 0 To Schema_Box.ScaleWidth
      For i = 0 To Schema_Box.ScaleHeight
         Schema_Box.PSet (400 * j, 400 * i)
      Next i
Next j
End Sub

Private Sub Timer1_Timer()

Dim souris As POINTAPI
      Dim coord_x As Integer
      Dim coord_y As Integer
           
     
      Dim x_Schema_Box_Utilisateur As Long, y_Schema_Box_Utilisateur As Long

x_Schema_Box_Utilisateur = Schema_Box.ScaleWidth
      y_Schema_Box_Utilisateur = Schema_Box.ScaleHeight
           
      Call GetCursorPos(souris)
                   
      ScreenToClient Schema_Box.hwnd, souris
         
      'x=533 pixels (width)
      'y=453 pixels (height)
      tmp_x = souris.X
      tmp_y = souris.Y
         
      tmp_x = (souris.X * x_Schema_Box_Utilisateur) / x_Schema_Box_pixel
      tmp_y = (souris.Y * x_Schema_Box_Utilisateur) / y_Schema_Box_pixel
            
      
      Prog_Frm.Lbl_X = tmp_x
      Prog_Frm.Lbl_Y = -tmp_y
      'Prog_Frm.Lbl_X = souris.x
      'Prog_Frm.Lbl_Y = souris.y
      
      'Prog_Frm.Lbl_X = Screen.TwipsPerPixelX * Prog_Frm.Lbl_X
      'Prog_Frm.Lbl_Y = Screen.TwipsPerPixelY * Prog_Frm.Lbl_Y
                  
      Status_Barre.Panels(1) = "X : " & tmp_x & " "  'ecriture de x
      Status_Barre.Panels(1).Width = Len(Status_Barre.Panels(1).Text) 'redimensionnement
      Status_Barre.Panels(2) = "Y : " & tmp_y & " " 'ecriture de y
      Status_Barre.Panels(2).Width = Len(Status_Barre.Panels(2).Text) 'redimensionnement
      
      Status_Barre.Panels(5) = " En cours de debug..."
      
      Status_Barre.Panels(3) = "Objet actif: " & Objet_pad_actif & " "
      
      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
      
      
End Sub

Sub init()

Objet_pad_actif = -1
Objet_broche_actif = -1

pad_selection = -1

' g�om�trie du curseur de la souris
Prog_Frm.MousePointer = vbCrosshair

'Les propri�t�s Width et Height de Screen  donnent les dimensions de l'�cran en twips.
'On utilise les propri�t�s TwipsPerPixelX et TwipsPerPixelYde Screen
'pour transformer ces dimensions en pixels.

'declaration des variables
Dim x_pixel As Long, y_pixel As Long

'resolution horizontale
x_pixel = Screen.Width / Screen.TwipsPerPixelX

'resolution verticale
y_pixel = Screen.Height / Screen.TwipsPerPixelY

x_Schema_Box_pixel = Schema_Box.ScaleWidth  ' / Screen.TwipsPerPixelX
y_Schema_Box_pixel = Schema_Box.ScaleHeight ' / Screen.TwipsPerPixelY

'Schema_Box.Scale (OffH, EchV + Offv)-(EchH + OffH, Offv)
'Picture1.Scale (Xmin, Ymax)-(Xmax, Ymin)

'ScaleLeft = XMIN
'ScaleTop = YMAX
'ScaleWidth = XMAX - XMIN
'ScaleHeight = -(YMAX - YMIN)
    
   
   Schema_Box.ScaleLeft = -4000
   Schema_Box.ScaleWidth = 8000
   Schema_Box.ScaleTop = -4000
   Schema_Box.ScaleHeight = 8000
   
   ' mise en place des axes
   'Axe_Y.X1 = -10
   'Axe_Y.X2 = 10
   'Axe_Y.Y1 = 0
   'Axe_Y.Y2 = 0
   'Axe_X.X1 = 0
   'Axe_X.X2 = 0
   'Axe_X.Y1 = -10
   'Axe_X.Y2 = 10
   
   'Affiche_Axe_Chk.Value = 1
   'Call Axes
   
   'charge template
   Call Charge_BROCHE
   
   'charge pad
   Call charge_padring

'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vb98/html/vbproScaleLeft.asp

End Sub

Sub Charge_BROCHE()

' insert des broches du leadframe
retour = Insert_BROCHE(-1500, 500, Type_PAD, "n")
retour = Insert_BROCHE(-2000, 1500, Type_PAD, "n")
retour = Insert_BROCHE(-2500, 2000, Type_PAD, "n")
ReDraw_BROCHE Prog_Frm.Schema_Box

End Sub

Sub charge_padring()

' insert des pads
retour = Insert_PAD(1000, 1000, Type_PAD, "n")
retour = Insert_PAD(1000, 2000, Type_PAD, "n")
retour = Insert_PAD(1000, 3000, Type_PAD, "n")
ReDraw_PAD Prog_Frm.Schema_Box

End Sub

Public Sub Axes()
    'tra�age des axes
    
    If Not Affiche_Axe_Chk.Value = 1 Then Exit Sub 'ne pas tracer si pas coch�
    Schema_Box.Line (Schema_Box.ScaleLeft, 0)-(Schema_Box.ScaleWidth, 0), RGB(0, 0, 255)
    Schema_Box.Line (0, Schema_Box.ScaleTop)-(0, Schema_Box.ScaleHeight), RGB(0, 0, 255)
End Sub