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        =   17
      Top             =   1920
      Width           =   7455
   End
   Begin VB.CheckBox Affiche_Axe_Chk 
      Caption         =   "Afficher axes"
      Height          =   375
      Left            =   5280
      TabIndex        =   16
      Top             =   720
      Width           =   1335
   End
   Begin VB.CommandButton Q2_Btn 
      Caption         =   "Q2"
      Height          =   615
      Left            =   11160
      TabIndex        =   15
      Top             =   1680
      Width           =   975
   End
   Begin VB.CommandButton Q1_Btn 
      Caption         =   "Q1"
      Height          =   615
      Left            =   11160
      TabIndex        =   14
      Top             =   480
      Width           =   975
   End
   Begin VB.Timer Timer2 
      Left            =   11160
      Top             =   4680
   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 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
PinPorteSelectionnee = -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 Me.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 Q1_Btn_Click()

  Schema_Box.Line (5, 5)-(7, 5)
  Schema_Box.Line (1, 3)-(1, 5)
  
  

End Sub

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

Private Sub Schema_Box_DblClick() ' annule le lien en cours

PinNumSelectionnee = -1
PinPorteSelectionnee = -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

' 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(X, Y, Type_PAD, angle)
    ReDraw 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
    PorteSelectionnee = Trouve_PAD(X, Y, DifX, DifY)

End If

' mode suppression de porte
If Action = "supprime" Then

    PorteSelectionnee = Trouve_PAD(X, Y)
    If PorteSelectionnee <> -1 Then
        ' arrete l'horloge si on efface la derniere horloge
        If Objet_PAD(PorteSelectionnee).GetType = "Clock" Then
            For i = 0 To NBGates - 1
                If PAD_Status(i) = 1 And i <> PorteSelectionnee Then
                    If Objet_PAD(i).GetType() = "Clock" Then horlogepresente = 1
                End If
            Next i
        End If
        
        ' detruit l'objet, et indique le tag effacé(0) dans le tableau
        Set Objet_PAD(PorteSelectionnee) = Nothing
        PAD_Status(PorteSelectionnee) = 0
        ReDraw 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 Me.Schema_Box
    End If
End If

' creer un lien
If Action = "lien" Then

    ' 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
            PinPorteSelectionnee = 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(PinPorteSelectionnee).SetParent(PinNumSelectionnee, PAD)
                   
                   
                Else
                    tmp = Objet_PAD(Porte).SetParent(Pinnum, PinPorteSelectionnee)
                   
                End If
                PinNumSelectionnee = -1 ' on deselectionne tout
                PinPorteSelectionnee = -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 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 PorteSelectionnee <> -1 Then
    tmp = bouger(X - DifX + deltaX, Y - DifY + deltaY, PorteSelectionnee)
    ReDraw Prog_Frm.Schema_Box
 End If

End If

' on creer un lien
If Action = "lien" Then
    If PinPorteSelectionnee <> -1 Then
        
            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(PinPorteSelectionnee).GetPosition(PosX, PosY, Gravite_Pos_X, Gravite_Pos_Y)
            
            ReDraw 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 (Gravite_Pos_X, Gravite_Pos_Y)-(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
PorteSelectionnee = -1
ReDraw Me.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 Main_Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button)

'Quand on clique sur un bouton de la toolbar, on appelle les sub definient par le menu
    On Error Resume Next
    Select Case Button.Key
        Case "FitToScreen"
            Mnu_PleineFenetre_Click
        Case "ZoomIn"
            Mnu_ZoomPlus_Click
        Case "ZoomOut"
            Mnu_ZoomMoins_Click
    End Select
End Sub

Private Sub Mnu_PleineFenetre_Click()
'======================================================================================
'Mettre l'image en pleine fenetre
'======================================================================================
    Call FitChildToParentScreen(Pct_Main_Parent, Pct_Main_Child, Img_Photo, _
            Hsb_Main_Parent, Vsb_Main_Parent)
End Sub

Private Sub Mnu_ZoomMoins_Click()
'======================================================================================
'Zoom -
'======================================================================================
    'on diminue la photo --> multiplie sa taille par un coeff de 0.8 Verticalement et
    'Horizontalement
    Call Zoom(Pct_Main_Parent, Pct_Main_Child, Img_Photo, Hsb_Main_Parent, _
            Vsb_Main_Parent, 0.8, 0.8, FlagDrawGrid)
End Sub

Private Sub Mnu_ZoomPlus_Click()
'======================================================================================
'Zoom +
'======================================================================================
    'on augmente la photo --> multiplie sa taille par un coeff de 1.2 Verticalement et
    'Horizontalement
    Call Zoom(Pct_Main_Parent, Pct_Main_Child, Img_Photo, Hsb_Main_Parent, _
            Vsb_Main_Parent, 1.2, 1.2, FlagDrawGrid)
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(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()


' 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 = -10
   Schema_Box.ScaleWidth = 20
   Schema_Box.ScaleTop = -10
   Schema_Box.ScaleHeight = 20
   
   ' 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

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

End Sub


Private Sub Timer2_Timer()
   Dim i   ' Declare variable.
   ' Plot dots randomly within a range.
   For i = -1 To 1 Step 0.05
      Schema_Box.PSet (i * Rnd, i * Rnd)   ' Draw a point.
   Next i
End Sub


' tracage des fonctions
 Sub Command3_Click(Index As Integer)
' efface le graph précedant
Picture1.Cls
' selection du zoom et remet l'echelle à jour
Select Case Index
Case 0
zoom_valeur = 0.5
Case 1
zoom_valeur = 2
End Select

'mise à jour de l'échelle
Picture1.ScaleHeight = Picture1.ScaleHeight * zoom_valeur
Picture1.ScaleWidth = Picture1.ScaleWidth * zoom_valeur
Picture1.ScaleLeft = Picture1.ScaleLeft * zoom_valeur
Picture1.ScaleTop = Picture1.ScaleTop * zoom_valeur
' adapte le pas de calcul en fcontion du zoom
pas = pas * zoom_valeur
'rappel de la dernière fonction pour la retracer
Call Command1_Click(derniere_fct)

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