VERSION 5.00
Begin VB.Form Prog_Frm 
   Caption         =   "Bonding diagram"
   ClientHeight    =   7560
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   10035
   Icon            =   "SchemaFrm.frx":0000
   LinkTopic       =   "Form2"
   ScaleHeight     =   7560
   ScaleWidth      =   10035
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer TimerClock 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   9360
      Top             =   7200
   End
   Begin VB.CommandButton SupLien 
      Caption         =   "Supprimer un lien"
      Height          =   495
      Left            =   120
      TabIndex        =   9
      Top             =   4560
      Width           =   1095
   End
   Begin VB.CommandButton SupprimerPorte 
      Caption         =   "Supprimer "
      Height          =   495
      Left            =   120
      TabIndex        =   6
      Top             =   2400
      Width           =   1095
   End
   Begin VB.CommandButton CreeLien 
      Caption         =   "Créer un lien"
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   3960
      Width           =   1095
   End
   Begin VB.TextBox NbEntreeTxt 
      Height          =   285
      Left            =   720
      TabIndex        =   4
      Text            =   "2"
      Top             =   1200
      Width           =   375
   End
   Begin VB.CommandButton DeplacePorte 
      Caption         =   "Deplacer "
      Height          =   495
      Left            =   120
      TabIndex        =   3
      Top             =   3000
      Width           =   1095
   End
   Begin VB.CommandButton AjoutePorte 
      Caption         =   "Ajouter"
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   1800
      Width           =   1095
   End
   Begin VB.PictureBox Schema 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   6135
      Left            =   1440
      ScaleHeight     =   6075
      ScaleWidth      =   8475
      TabIndex        =   0
      Top             =   1080
      Width           =   8535
   End
   Begin VB.Image PAD 
      Height          =   660
      Left            =   1800
      Picture         =   "SchemaFrm.frx":08CA
      Top             =   240
      Width           =   945
   End
   Begin VB.Image PAD_Ajouter 
      Appearance      =   0  'Flat
      BorderStyle     =   1  'Fixed Single
      Height          =   735
      Left            =   240
      Top             =   240
      Width           =   855
   End
   Begin VB.Label Type_PAD_Lbl 
      Alignment       =   2  'Center
      Caption         =   "Type"
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   960
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Entrées :"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   1200
      Width           =   615
   End
   Begin VB.Label ActionEnCours 
      Height          =   255
      Left            =   1440
      TabIndex        =   2
      Top             =   7320
      Width           =   5775
   End
   Begin VB.Menu Fichier 
      Caption         =   "Fichier"
      Begin VB.Menu Sauver 
         Caption         =   "Sauver"
      End
      Begin VB.Menu Ouvrir 
         Caption         =   "Ouvrir"
      End
   End
   Begin VB.Menu Composants 
      Caption         =   "Composants"
      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 Sub AjoutePorte_Click() ' ajouter une nouvelle porte
ActionEnCours.Caption = "Ajoute une porte"
Action = "ajout"
End Sub

Private Sub APropos_Click()

MsgBox "Simulogic v 1.0 (10/03)" & vbNewLine & "Par Tobby" & 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 la puce
ActionEnCours.Caption = "Change un etat"
Action = "changeetat"
End Sub

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

Private Sub DeplacePorte_Click() ' deplace une porte
ActionEnCours.Caption = "Deplace une porte"
Action = "deplace"
End Sub

Private Sub Detecteurs_Click() ' ouvre la form de selection de detecteur de front
DetecteursFrm.Show
End Sub

Private Sub Form_Load()
PinNumSelectionnee = -1 ' Ne selectionne rien par defaut
PinPorteSelectionnee = -1
PinTypeSelectionnee = -1

PAD_Ajouter.Picture = PAD.Picture ' PAD actif par défaut

Type_PAD_Lbl.Caption = "AND"

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.Width = SchemaFrm.Width - 1600
Schema.Height = SchemaFrm.Height - 2150
ActionEnCours.Top = SchemaFrm.Height - 1050
ReDraw Me.Schema
End Sub

Private Sub PAD_Click() ' selectionne un pad
PAD_Ajouter.Picture = PAD.Picture

TypePorteLbl.Caption = "AND"
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
tmp = Sauvegarde()
End Sub

Private Sub Schema_DblClick() ' annule le lien en cours

PinNumSelectionnee = -1
PinPorteSelectionnee = -1
PinTypeSelectionnee = -1

End Sub

Private Sub Schema_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
Dim Porte As Long, Pinnum As Long ' variables communes
Dim PinType As String
Dim Etat As Long

If Action = "ajout" Then ' mode ajout de porte

    TypePorte = TypePorteLbl.Caption
    NbEntree = NbEntreeTxt.Text

    ' insert la porte
    PorteRef = InsertPorte(X, Y, TypePorte, NbEntree)
    ReDraw Me.Schema

End If

If Action = "deplace" Then ' deplace une porte

    MouseX = X ' on enregistre les valeurs de depart, pour comparer
    MouseY = Y ' a l'arriver et bouger la porte
    PorteSelectionnee = TrouvePorte(X, Y, DifX, DifY) ' cherche la porte cliquee

End If

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

    PorteSelectionnee = TrouvePorte(X, Y)
    If PorteSelectionnee <> -1 Then
        ' arrete l'horloge si on efface la derniere horloge
        If Gates(PorteSelectionnee).GetType = "Clock" Then
            For i = 0 To NBGates - 1
                If GatesStatus(i) = 1 And i <> PorteSelectionnee Then
                    If Gates(i).GetType() = "Clock" Then horlogepresente = 1
                End If
            Next i
            If horlogepresente = 0 Then ' il n'y a plus d'horloge
                TimerClock.Enabled = False
                StartClock.Caption = "Demarrer l'horloge"
            End If
        End If
        ' detruit l'objet, et indique le tag effacé(0) dans le tableau
        Set Gates(PorteSelectionnee) = Nothing
        GatesStatus(PorteSelectionnee) = 0
        ReDraw Me.Schema
    End If
End If

If Action = "suplien" Then ' mode suppression de lien
    Dim LienPorteNum As Long
    Dim LienPinNum As Long
    
    tmp = TrouveLien(X, Y, LienPorteNum, LienPinNum)
    
    If LienPorteNum <> -1 Then
        tmp = Gates(LienPorteNum).SetParent(LienPinNum, -1)
        ReDraw Me.Schema
    End If
End If

If Action = "changeetat" Then ' change manuellement l'etat d'une entree

    tmp = TrouvePin(X, Y, Porte, Pinnum, PinType) ' trouve la pin cliquee
    If Porte <> -1 Then ' la porte n'est pas effacee
        If Gates(Porte).GetParent(Pinnum) = -1 And PinType = "entree" Then ' la puce n'a pas de parent et est une entree
            Etat = Gates(Porte).GetPinEtat(Pinnum) ' recupere l'etat pour l'inverser
        If Etat = 0 Then
            Etat = 1
        Else
            Etat = 0
        End If
            tmp = Gates(Porte).SetPinEtat(Pinnum, Etat) ' affecte le nouvel etat
            ReDraw Me.Schema
        Else ' la puce est une sortie, ou elle possede un parent
            MsgBox "Impossible de changer l'etat"
        End If
    End If
End If

If Action = "lien" Then ' creer un lien

    tmp = TrouvePin(X, Y, Porte, Pinnum, PinType) ' trouve la pin cliquee
    If Porte <> -1 Then ' elle est reconnue
        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 = Gates(PinPorteSelectionnee).SetParent(PinNumSelectionnee, Porte)
                    Etat = Gates(Porte).GetEtat()
                    tmp = Gates(PinPorteSelectionnee).SetEntree(Porte, Etat)
                Else
                    tmp = Gates(Porte).SetParent(Pinnum, PinPorteSelectionnee)
                    Etat = Gates(PinPorteSelectionnee).GetEtat()
                    tmp = Gates(Porte).SetEntree(PinPorteSelectionnee, Etat)
                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 Me.Schema
    End If
End If

End Sub




Private Sub Schema_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.Width Or Y >= Schema.Height Then Exit Sub

If Action = "deplace" And Button = 1 Then ' on deplace une porte
    
    deltaX = X - MouseX
    deltaY = Y - MouseY
    
    MouseX = X
    MouseY = Y
    
    If PorteSelectionnee <> -1 Then ' on bouge la porte
        tmp = MovePorte(X - DifX + deltaX, Y - DifY + deltaY, PorteSelectionnee)
        ReDraw Me.Schema
    End If

End If

If Action = "lien" Then ' on creer un lien
    If PinPorteSelectionnee <> -1 Then
        
            Dim PosX As Integer, PosY As Integer
            Dim SortiePosX As Integer, SortiePosY As Integer
            Dim PinPos() As Integer
            
            tmp = Gates(PinPorteSelectionnee).GetPosition(PosX, PosY, PinPos, SortiePosX, SortiePosY)
            ReDraw Me.Schema
            If PinTypeSelectionnee = "entree" Then ' on trace une ligne de la pin au curseur
                SchemaFrm.Schema.Line (PinPos(0, PinNumSelectionnee), PinPos(1, PinNumSelectionnee))-(X, Y), RGB(255, 0, 0)
            Else
                SchemaFrm.Schema.Line (SortiePosX, SortiePosY)-(X, Y), RGB(255, 0, 0)
            End If
            
    End If
End If

End Sub

Private Sub Schema_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

End Sub

Private Sub StartClock_Click()
' demarre ou arrete l'horloge

If TimerClock.Enabled = True Then ' on arrete le timer
    TimerClock.Enabled = False
    StartClock.Caption = "Demarrer l'horloge"
Else
    For i = 0 To NBGates - 1 ' on recherche une horloge avant de la demarrer
    If GatesStatus(i) = 1 Then
        If Gates(i).GetType() = "Clock" Then
            TimerClock.Enabled = True
            StartClock.Caption = "Arrete l'horloge"
        End If
    End If
    Next i ' il n'y a pas d'horloge !
    If TimerClock.Enabled = False Then MsgBox "Inserez d'abord une horloge !"
End If
    
End Sub

Private Sub SupLien_Click()
'on supprime un lien

ActionEnCours.Caption = "Supprimer un lien"
Action = "suplien"

End Sub

Private Sub SupprimerPorte_Click()
'on supprime une porte

ActionEnCours.Caption = "Supprimer une porte"
Action = "supporte"

End Sub

Private Sub TimerClock_Timer()
' recherche les horloges et change leur etat
' remarque toutes les horloges sont synchrone et de meme frequence

For i = 0 To NBGates - 1
If GatesStatus(i) = 1 Then
    If Gates(i).GetType() = "Clock" Then
        If Gates(i).GetEtat() = 1 Then
            tmp = Gates(i).SetPinEtat(0, 0)
        Else
            tmp = Gates(i).SetPinEtat(0, 1)
        End If
    End If
End If
Next i
ReDraw Me.Schema

End Sub

Private Sub ValidFreq_Click()
' verifie la validiter de la frequence et la sauvegarde

On Error GoTo erreur
    TimerClock.Interval = 1000 / Frequence.Text
GoTo fin:
erreur:
    TimerClock.Interval = 1000
    Frequence.Text = 1
    MsgBox "Valeur non correcte : utilisez une virgule au lieu du point pour les chiffres decimaux (ex: 0,5)"
fin:
End Sub