DrawRectangle couleur + hachure [Résolu]

Signaler
Messages postés
232
Date d'inscription
mercredi 25 octobre 2000
Statut
Membre
Dernière intervention
5 octobre 2012
-
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
-
Salut !

Est-il possible de créer un rectangle de couleur plein avec des hachures en plus ? fond jaune et hachure rouge par exemple sans devoir dessiner 2 rectangles supersposés ?

pour info voici ma procédure de dessin :

Public Sub DrawRectangle(ByRef hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal lWidth As Long, ByVal lheight As Long, _
                        ByVal lBackColor As Long, ByVal ColorLine As Long, ByVal Round As Long, ByVal lStyle As FillStyleConstants, _                        Optional ByVal BordGras As Integer 0, Optional ByVal DoRadio As Boolean True)
                  


    Dim hBrush    As Long
    Dim hOldBrush As Long
    Dim retval    As Long
    Dim R         As Long
    Dim g         As Long
    Dim B         As Long
    Dim hPen      As Long
    Dim hOldPen   As Long
    Dim lColor As Long
    Dim lColorLine As Long
    Dim tR     As RECT
   
    If DoRadio Then
        X1 = (X1 + glMgLeft) * md_Ratio
        Y1 = (Y1 + glMgTop) * md_Ratio
        lWidth = lWidth * md_Ratio
        lheight = lheight * md_Ratio
    End If
    X1 = ConvertTwipsToPixels(hDC, X1, 0)
    Y1 = ConvertTwipsToPixels(hDC, Y1, 1)
    lWidth = ConvertTwipsToPixels(hDC, lWidth, 0)
    lheight = ConvertTwipsToPixels(hDC, lheight, 1)


    Call OleTranslateColor(lBackColor, 0, lColor)
    Call OleTranslateColor(ColorLine, 0, lColorLine)
   
    R = (lColor And &HFF&)
    g = (lColor And &HFF00&) \ &H100&
    B = (lColor And &HFF0000) \ &H10000
    If lStyle = vbFSSolid Then
        hBrush = CreateSolidBrush(RGB(R, g, B))
    ElseIf lStyle = vbFSTransparent Then
        hBrush = GetStockObject(SO_NULL_BRUSH)
    Else
        hBrush = CreateHatchBrush(lStyle - 2, RGB(R, g, B))
    End If
    hOldBrush = SelectObject(hDC, hBrush)
   
    R = (lColorLine And &HFF&)
    g = (lColorLine And &HFF00&) \ &H100&
    B = (lColorLine And &HFF0000) \ &H10000
    hPen = CreatePen(PS_INSIDEFRAME, BordGras, RGB(R, g, B))
    hOldPen = SelectObject(hDC, hPen)
   
    retval = RoundRect(hDC, X1, Y1, X1 + lWidth, Y1 + lheight, Round, Round)


    retval = SelectObject(hDC, hOldBrush)
    retval = SelectObject(hDC, hOldPen)
    retval = DeleteObject(hBrush)
    retval = DeleteObject(hPen)
End Sub

5 réponses

Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
43
salut,

2 pinceaux donc 2 dessins (sur un même rectangle)
++

<hr size="2" width="100%" />
Prenez un instant pour répondre à [sujet-SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp 
Messages postés
232
Date d'inscription
mercredi 25 octobre 2000
Statut
Membre
Dernière intervention
5 octobre 2012

oups j'oubliais : Joyeux Noël à tous !
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
43
nb : tu peux aussi utiliser l'API FillRect
Messages postés
232
Date d'inscription
mercredi 25 octobre 2000
Statut
Membre
Dernière intervention
5 octobre 2012

merci!
2 pinceaux ?
Dans ce genre :
         (...)
      'backcolor
        hBrush2 = CreateSolidBrush(RGB(255, 120, 120))
        hOldBrush2 = SelectObject(hDC, hBrush2)
       'Hachure 
       hBrush = CreateHatchBrush(lStyle - 2, RGB(R, g, B))
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
43
peut-être plutôt avec CreateBrushIndirect pour avoir le même code et 2 Flags différents mais sinon pourquoi pas
surtout ne pas oublier de libérer
++, bonne fêtes