Changer l'epaisseur d'un trait /creer une gomme sous visual basic 6

Changer l'epaisseur d'un trait /creer une gomme sous visual basic 6 - VB/VBA/VBS - Programmation

Marsh Posté le 08-10-2005 à 18:56:12    

Slt,
J'ai fait un petit programme qui fonctionne comme un paint. Je suis sous visual basic 6.
Je voudrais faire des dessin avec une epaisseure de trait defini grace à des options (gerer par select case).
Le probleme est que je ne sais pas comment gerer l'epaisseur.
Voisi mon bout de programme :
 
Option Explicit
 
Private FoncGraph As Integer
Private Couleur As Integer
Private EpTrait As Integer
Private EpGomme As Integer
Private Orx, Ory As Single
Private Oldx, Oldy As Single
Private XF, YF As Single
Private NomFichier As String
Private TempNom As String
Private Dessin As Integer
Private R As Single
 
 
Private Sub Couleurs_Click(Index As Integer)
Couleur = Index
Select Case Couleur
Case 0
Couleur = 0
Case 1
Couleur = 4
Case 2
Couleur = 2
Case 3
Couleur = 1
End Select
 
End Sub
 
Private Sub Form_Load()
Const Gomme = 0
Const Ligne = 1
Const Segment = 2
Const Cercle = 3
 
End Sub
 
 
Private Sub OutilsDessin_Click(Index As Integer)
Dessin = Index
Select Case Dessin
Case 0
Infos.Caption = "Outil Spline"
Case 1
Infos.Caption = "Outil Trait"
Case 2
Infos.Caption = "Outil Cercle"
Case 3
Infos.Caption = "Outil Gomme"
End Select
End Sub
 
 
 
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Orx = X
Ory = Y
Oldx = X
Oldy = Y
End Sub
 
 
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Dessin = 0 And Button = 1 Then Picture1.Line (Oldx, Oldy)-(X, Y), QBColor(Couleur)
Oldx = X
Oldy = Y
 
If Dessin = 1 And Button = 1 Then Picture1.Line (Orx, Ory)-(XF, YF)
 
If Dessin = 2 And Button = 1 Then
R = (Val(XF - Orx) ^ 2 + Val(YF - Ory) ^ 2) ^ (0.5)
Picture1.Circle (Orx, Ory), R, QBColor(Couleur)
'Picture1.DrawWidth = EpTrait C'est un essais que j'ai fait pour l'epaisseur du cercle mais ça ne fonctionne pas
End If
Oldx = X
Oldy = Y
End Sub
 
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
XF = X
YF = Y
End Sub
 
Private Sub Trait_Click(Index As Integer)  PARTIE qui gere la selection de l'epaisseur (1,2,3 sont mis au hasard car je connais pas l'unité ni le fonctionnement de la fonction)
Epaisseur = Index
Select Case Epaisseur
Case 0
EpTrait = 1
Case 1
EpTrait = 2
Case 3
EpTrait = 3
End Sub

 
Voila si vous pouvez m'aider sur le cercle la fonction serra la même pour le trait...
Merci d'avance
 
 
PS : est-ce que le click up et down fonctionnent bien ? Car sur mon portable c'est pas super... Je me sert de ces reperes pour choisir les points de depart et d'arrivé des traits.


Message édité par TopFrunix le 09-10-2005 à 18:43:20
Reply

Marsh Posté le 08-10-2005 à 18:56:12   

Reply

Marsh Posté le 08-10-2005 à 19:42:00    

La propriété DrawWidth est bien celle qu'il faut utiliser.
Mais il faut la renseigner ... avant de faire le cercle et non pas après  :)  (excuse-moi de rire, c'est nerveux).
A part ça les click up et down devraient marcher sur tous les windows ou sur aucun.

Reply

Marsh Posté le 08-10-2005 à 20:26:31    

je viens d'essayer ça ne fonctionne toujours pas...
 
J'ai egalement essayé de le placer avant les conditions de ligne ou cercle et ça ne fonctionne toujours pas...
D'ou vient le probleme ?
Il faut bien mettre des chiffres comme 1,2,3 en epaisseur ou est-ce un pb d'organisation ?

Reply

Marsh Posté le 09-10-2005 à 00:13:31    

La différence entre les valeurs 1, 2, et 3 sont assez fines, donc peut-être que cela ne se voit pas bien.
Mais le problème peut venir d'ailleurs, par exemple du "End Select" manquant à la fin de Trait_Click.
Le plus simple serait de faire un test en traçant juste un rectangle avec un DrawWidth=5, pour s'affranchir des problèmes annexes éventuels de variables mal renseignées.

Reply

Marsh Posté le 09-10-2005 à 13:43:03    

Je m'en suis sorti pour l'epaisseur mais j'ai un pb avec la gomme et le cercle...
Pour la gomme je voulais me servir de l'outil pour faire des courbe et mettre une couleur blanche mzis j'ai un message d'erreur.
Pour le cercle ça ne fonctionne pas tres bien , le cercle se trace mais je defini pas bien le rayon en bougeant la souris...
Pouvez vous m'aider ?
 
Voici mon code :
 
Option Explicit
 
Private FoncGraph As Integer
Private Couleur As Integer
Private EpTrait As Integer
Private EpGomme As Integer
Private Orx, Ory As Single
Private Oldx, Oldy As Single
Private XF, YF As Single
Private NomFichier As String
Private TempNom As String
Private Dessin As Integer
Private Epaisseur As Integer
Private R As Single
 
 
Private Sub ClearAll_Click()
If ClearAll = True Then Picture1.Cls
End Sub
 
Private Sub Couleurs_Click(Index As Integer)
Couleur = Index
Select Case Couleur
Case 0
Couleur = 0
Case 1
Couleur = 4
Case 2
Couleur = 2
Case 3
Couleur = 1
End Select
 
End Sub
 
Private Sub Form_Load()
Const Gomme = 0
Const Ligne = 1
Const Segment = 2
Const Cercle = 3
EpTrait = 2
End Sub
 
 
Private Sub OutilsDessin_Click(Index As Integer)
Dessin = Index
Select Case Dessin
Case 0
Infos.Caption = "Outil Spline"
Case 1
Infos.Caption = "Outil Trait"
Case 2
Infos.Caption = "Outil Cercle"
Case 3
Infos.Caption = "Outil Gomme"
End Select
End Sub
 
 
 
Private Sub Picture1_Click()
If Dessin = 1 Then
Picture1.DrawWidth = EpTrait
Picture1.Line (Orx, Ory)-(XF, YF), QBColor(Couleur)
End If
End Sub
 
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Orx = X
Ory = Y
Oldx = X
Oldy = Y
If Dessin = 2 And Button = 1 Then fonction cercle, il dois y avoir une erreur qq part.
Picture1.DrawWidth = EpTrait
R = (Val(XF - Orx) ^ 2 + Val(YF - Ory) ^ 2) ^ (0.5)
Picture1.Circle (Orx, Ory), R, QBColor(Couleur)
End If

 
End Sub
 
 
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
If Dessin = 0 And Button = 1 Then
Picture1.DrawWidth = EpTrait
Picture1.Line (Oldx, Oldy)-(X, Y), QBColor(Couleur)
End If
Oldx = X
Oldy = Y
 
If Dessin = 3 And Button = 1 Then  fonction gomme mais je sais pas si le 16 est bien le blanc
Picture1.DrawWidth = EpTrait                             ni si la syntaxe est bonne.
Picture1.Line (Oldx, Oldy)-(X, Y), QBColor(16)
End If

Oldx = X
Oldy = Y
 
End Sub
 
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
XF = X
YF = Y
End Sub
 
Private Sub Trait_Click(Index As Integer)
Epaisseur = Index
Select Case Epaisseur
Case 0
EpTrait = 1
Case 1
EpTrait = 2
Case 2
EpTrait = 3
End Select
End Sub


Message édité par TopFrunix le 09-10-2005 à 13:45:40
Reply

Marsh Posté le 09-10-2005 à 18:41:20    

J'ai corrigé le cercle si qq connais l'erreur pour la gomme...

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed