File "Prog_Frm.frm"
Full Path: /home/analogde/www/css/DEV3/Prog_Frm.frm
File size: 28.5 KB
MIME-type: text/plain
Charset: 8 bit
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 = "Crer 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
'traage 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 dveloppement (Fvrier 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 & "Sbastien 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 dfaut
'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'accs)
'Else
'Instructions (refuser l'accs et quitter le programme) 'Fin de la procdure
'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'arrive et bouger le pad
MouseX = X
MouseY = Y
' cherche le pad qui vient d'tre slctionner
Objet_pad_actif = Trouve_PAD(X, Y, DifX, DifY)
Objet_pad_Lbl = Objet_pad_actif
' cherche la broche qui vient d'tre slctionner
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 = "dbut:" & 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 connectes 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
' gomtrie du curseur de la souris
Prog_Frm.MousePointer = vbCrosshair
'Les proprits Width et Height de Screen donnent les dimensions de l'cran en twips.
'On utilise les proprits 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()
'traage 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