trait à angle droit

Question

Bonjour

Avec la commande LINE, je trace des traits à 45° mais leurs extrémités sont arrondies.

Comment puis obtenir ces extrémités plates (à angles droit)??

d'avance merci, car j'en ai très besoin

Guy

cs_DARKSIDIOUS · Answer

Heu... tu fait des angles de 45° et tu voudrais des extrémité à angles droits... là je ne comprend pas !!!

Si tu veux parler d'avoir une extrémité de ligne "plat" alors au lieu de tracer une seule ligne avec une certaine épaisseur, trace plusieurs lignes cote à cote pour obtenir l'épaisseur (car les lignes tracés avec une épaisseur 3 par exemple auront forcément une extrémité arrondie car VB utilise des pinceaux ronds pour les tracer...)

DarK Sidious

[Responsable de la rubrique API et responsable VB du site www.ProgOtoP.com]

Renfield · Answer

En fait, il s'agit de modifier la propriete EndCap du Crayon (PEN) attaché a ton DeviceContext ( celle d'une pictureBox, je suppose)

voici un petit exemple de code qui trace des traits carré....
place juste ca dans le code d'une feuille, qui comprends un picturebox ( appele Picture1 ). Fais le assez grand......


Option Explicit

Private Const PS_ENDCAP_SQUARE = &H100 '# Bout carré pour la ligne
Private Const PS_ENDCAP_FLAT = &H200 '# Bout Plat pour la ligne
Private Const PS_ENDCAP_ROUND = &H0   '# Bout Rond pour la ligne

Private Const PS_GEOMETRIC = &H10000 '# Utiliser les valeurs précisée et non celles par default

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ExtCreatePen Lib "gdi32" (ByVal dwPenStyle As Long, ByVal dwWidth As Long, lplb As LOGBRUSH, ByVal dwStyleCount As Long, lpStyle As Long) As Long
Private Type LOGBRUSH
        lbStyle As Long
        lbColor As Long
        lbHatch As Long
End Type

Private Sub Picture1_Paint()
    Picture1.DrawWidth = 15
    Picture1.ScaleMode = vbPixels

    '# Ligne classique : bouts ronds !
    Picture1.Line (10, 10)-(100, 100)
    
    Dim Brush As LOGBRUSH
    Dim Pen As Long
    Dim OldPen As Long
    
    '# via le Brush, on peut controler certains parametres du tracé (couleur...)
    
    '# On crée un nouveau crayon
    Pen = ExtCreatePen(PS_ENDCAP_FLAT Or PS_GEOMETRIC, Picture1.DrawWidth, Brush, 0, ByVal 0&)
    
    '# On sauvegarde le crayon utilisé, et on affecte le crayon precedemment crée
    OldPen = SelectObject(Picture1.hdc, Pen)
    
    '# Cette ligne a les bouts plats
    Picture1.Line (110, 110)-(200, 200)
    
    '# On rattache l'ancien crayon au PictureBox, et on supprime le crayon crée
    SelectObject Picture1.hdc, OldPen
    DeleteObject Pen
End Sub



By Renfield

[mailto:thomas_reynald@msn.com thomas_reynald@msn.com]

Aucune touche n'a ete blessee lors de la saisie de ce texte.......... ;)

TouTenN · Answer

Pour DARKSIDIOUS : j'avais déjà essayé la méthode du multitrait, mais il ne se touche pas....

Pour Renfield : C'est tout bonnement génial, ;-))))
J'aurais pu encore longtemps chercher sans ton intervention. Cela fonctionne très bien aussi directement sur une form.

Tant que je te tiens : est-il possible de définir une fois pour toute cette propriété dans un projet et puis tracer à ma guise tous les autres traits en ayant la possibilté de jouer sur l'épaisseur et la couleur???

Un grand merci

Guy

Renfield · Answer

J'ai realisé un second code, qui sera normallement plus reutilisable, et sans doute bon, pour ton cas ......

[mailto:thomas_reynald@msn.com thomas_reynald@msn.com]

Aucune touche n'a ete blessee lors de la saisie de ce texte.......... ;)

TouTenN · Answer

Bonjour thomas et merci pour ton aide très préciseuse

Je viens de télécharger ton projet, malheureusement je m'apercois que le trait du bas n'est pas modifié.
Dois-je activer une option de VB????

Sans quoi, hier soir je me suis créé une fonction pour obtenir le résultat que je souhaitais.

Pour pousser le bouchon encore plus loin, est-il possible de :
* Créer un dégradé de couleur
* D'obtenir que le contour (avec possibilité de le remplir) comme un rectangle que l'on ferait tourner (rotation)
* D'avoir 2 types d'extrémités sur un même trait

Merci encore

Guy

TouTenN · Answer

Bonjour

Je viens de comprendre pourquoi cela ne fonctionne pas. Il n'y a que les versions Win_NT qui supportent ces API....
(je travaille sur les deux types Win_32 et Win_NT)

Allez on recommence tout pourtant c'était bien parti :-((

Guy

TouTenN · Answer

C'est bon j'ai trouvé...Ouf

Je viens de manipuler un vieux projet. Il permet de tracer un trait avec des extrémités plates, quelque soit la plateforme windows :

N'oubliez pas de mettre un bouton de commande!!!!

Option Explicit
Dim ExtendedPen&
Dim BrushInfo As LOGBRUSH

Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StrokePath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ExtCreatePen Lib "gdi32" (ByVal dwPenStyle As Long, ByVal dwWidth As Long, lplb As LOGBRUSH, ByVal dwStyleCount As Long, lpStyle As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Type LOGBRUSH
        lbStyle As Long
        lbColor As Long
        lbHatch As Long
End Type

Private Const PS_ENDCAP_FLAT = &H200
Private Const PS_GEOMETRIC = &H10000
Private Const BS_SOLID = 0
Private Sub Command1_Click()
    Dim oldpen&, di&
    If ExtendedPen Then di = DeleteObject(ExtendedPen)
    BrushInfo.lbColor = QBColor(4)
    BrushInfo.lbStyle = BS_SOLID
    ExtendedPen = ExtCreatePen(PS_GEOMETRIC Or PS_ENDCAP_FLAT, 10, BrushInfo, 0, ByVal 0&)
    oldpen = SelectObject(Me.hdc, ExtendedPen&)
    di = BeginPath(Me.hdc)
    Me.Line (100, 100)-(150, 150)
    di = EndPath(Me.hdc)
    di = StrokePath(Me.hdc)
    di = SelectObject(Me.hdc, oldpen)
End Sub
Private Sub Form_Load()
    Dim di&
    If ExtendedPen Then di = DeleteObject(ExtendedPen)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim di&
    If ExtendedPen Then di = DeleteObject(ExtendedPen)
End Sub

Guy - TouTenN

Renfield · Answer

Je ne veux pas dire, mais mon code est similaire au tien !!!!

mise a part le fait d'utiliser les API pour dessiner....
mais j'ai mis .Line, pour ne pas surcharger inutillement (je le pensait)le code en API...

enfin bref, le principal c'est que ca fonctionne !!

By Renfield

[mailto:thomas_reynald@msn.com thomas_reynald@msn.com]

Aucune touche n'a ete blessee lors de la saisie de ce texte.......... ;)

peug · Answer

salut, Juste que j'ai remarqué qu'utilisait ExtCreatePen  était beaucoup plus lent que CreatePen. C'est vraiment dommage. Ok ExtCreatePen offre que de bon plus mais on le voit passé au raffraichissement. y aurait-il un moyen d'accelerer son affichage ?

Trait à angle droit

9 réponses

Discussions similaires