File "SchemaFrm.frm"
Full Path: /home/analogde/www/DEV3/SchemaFrm.frm
File size: 13.59 KB
MIME-type: text/plain
Charset: 8 bit
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 = "Crer 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 = "Entres :"
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 & "Sbastien 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 dfaut
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 connectes 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