Discussion :

[scr]

Quelqu'un connaitrait il un moyen de dessiner un losange plein dans un picture box ?

[leroissejp]

Bonsoir,
Pour un losange, je ne connais pas mais il doit surement y avoir moyen,je te laisse toujours le code pour un cercle au cas ou celà pourrait te servir.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Private Sub Picture1_Click()
   ' Définit l'échelle à 100.
   Picture1.ScaleHeight = 100
   Picture1.ScaleWidth = 100
   ' Active la propriété AutoRedraw.
   Picture1.AutoRedraw = True
   ' Définit la propriété ForeColor.
   Picture1.ForeColor = 0
   ' Définit la propriété FillColor.
   Picture1.FillColor = QBColor(9)
   ' Définit la propriété FillStyle.
   Picture1.FillStyle = 0
   ' Dessine un cercle.
   Picture1.Circle (50, 50), 30
   ' Désactive la propriété AutoRedraw.
   Picture1.AutoRedraw = False
End Sub

jpleroisse

[scr]

Il semblerait qu'il n'existe pas de fonction vb destinée à ça...
Le seul moyen que j'ai trouvé c'est de dessiner un losange avec une serie de rectangle d'un pixel de hauteur.

Un rond, pour dessiner un losange, tu te fouts de ma gueule !
Quoi que j'aurai pu dessiner une serie de rond d'un pixel de diametre pour alumer chaque pixel de mon losange...

[ProgElecT]

Bonjour
le code suivant répondrat peut-être à la question (en VB6)

dans une form mettre 2 label, 2 picturebox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Option Explicit
'pour lire la couleur d'un pixel
Private Declare Function GetPixel Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal X As Long, _
    ByVal Y As Long) As Long
' pour colorer une surface avec un pinceau image ou une couleur
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) 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 Declare Function ExtFloodFill Lib "gdi32" ( _
    ByVal hdc As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal crColor As Long, _
    ByVal wFillType As Long) As Long
Private Const FLOODFILLBORDER = 0
Private Const FLOODFILLSURFACE = 1
 
Private Sub Form_Load()
Me.ScaleMode = 3
Me.AutoRedraw = True
Label1.Top = 6: Label1.Left = 6
Label1 = "Maj. plus Click peinture de la couleur dans picture1"
Label2.Top = 26: Label2.Left = 6
Label2 = "Ctrl. plus Click peinture de l'image dans picture1"
Picture1.ScaleMode = 3
Picture1.Top = 44: Picture1.Left = 6
Picture1.Height = 149: Picture1.Width = 149
Picture1.AutoRedraw = True
Picture2.BackColor = &HFFFF&
Me.Height = 3420: Me.Width = 4110
Dim A, B As Integer
A = 27: B = 7
'dessin d'un pseudo losange dans Picture1
Picture1.Line (A, A * 2)-(A * 3, B / 4), 255
Picture1.Line -(A * 5, B * 8), 255
Picture1.Line -(A * 3, B * 16), 255
Picture1.Line -(A, A * 2), 255
End Sub
 
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Shift = 1 Or Shift = 2 Then Else Exit Sub
'pour remplir le losange
Dim mBrush As Long
Dim FB As String
Dim objPic As Picture
If Shift = 2 Then 'Ctrl
 FB = "C:\PersoFrancis\GrdPersonage2Zoom.bmp" '******* adapter ************
 Set objPic = LoadPicture(FB) 'Chargement du bitmap
 mBrush = CreatePatternBrush(objPic) 'Création de la brosse
 SelectObject Picture1.hdc, mBrush 'Activation de la brosse
 'Peinture dans la zone x,y dans l'image "Picture1", avec le pinceau image "FB"
 ExtFloodFill Picture1.hdc, X, Y, GetPixel(Picture1.hdc, X, Y), FLOODFILLSURFACE
 DeleteObject mBrush 'Nettoyage de la brosse
End If
If Shift = 1 Then 'Maj.
 'Peinture dans la zone x,y de la couleur Picture2.BackColor
 Set objPic = Picture2.Image  'Chargement de l'objet model
 mBrush = CreatePatternBrush(objPic)
 SelectObject Picture1.hdc, mBrush
 ExtFloodFill Picture1.hdc, X, Y, GetPixel(Picture1.hdc, X, Y), FLOODFILLSURFACE
 DeleteObject mBrush
End If
Picture1.Refresh
End Sub

Le code est un peu long pour la demonstration, mais ne prendre que ce qui vous interésse.

Salut

[scr]

Merci, c'est exactement ce que je cherchais

[cari]

mettre résolu!