[VB6] Aide sur un code

Version imprimable

Bonjour , j'ai trouvé sur le net un code permettant de dessiner un triangle , mais le soucis c'est qu'il y a aucun commentaire , et j'aimerai transformer ce triangle en un sablier , 2 triangles symétrique ayant un sommet en commun ...
merci d'avance
amicalement lucas

Code:

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
Private Type COORD
    x As Long
    y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Const ALTERNATE = 1
Const WINDING = 2
Const BLACKBRUSH = 4
Private Sub Form_Paint()
    Dim poly(1 To 4) As COORD, NumCoords As Long, hBrush As Long, hRgn As Long
    Me.Cls
    NumCoords = 2
    Me.ScaleMode = vbPixels
    poly(1).x = Form1.ScaleWidth / 2
    poly(1).y = Form1.ScaleHeight / 2
    poly(2).x = Form1.ScaleWidth / 4
    poly(2).y = 3 * Form1.ScaleHeight / 4
    poly(3).x = 3 * Form1.ScaleWidth / 4
    poly(3).y = 3 * Form1.ScaleHeight / 4
    Polygon Me.hdc, poly(1), NumCoords
    hBrush = GetStockObject(BLACKBRUSH)
    hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
    If hRgn Then FillRgn Me.hdc, hRgn, hBrush
    DeleteObject hRgn
End Sub
Private Sub Form_Resize()
    Form_Paint
End Sub

10/05/2006, 10h24
malhivertman1

Moi ton code ne me dessine pas un triangle..

si si , je me suis penché dessu , et maintenant ca dessine un sablier

Code:

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
 
Private Type COORD
    x As Long
    y As Long
End Type
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As Any, ByVal nCount As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Const ALTERNATE = 2
Const WINDING = 2
Const BLACKBRUSH = 4
Private Sub Form_Paint()
    Dim poly(1 To 5) As COORD, NumCoords As Long, hBrush As Long, hRgn As Long
    Me.Cls
    NumCoords = 5
    Me.ScaleMode = vbPixels
    poly(1).x = Form1.ScaleWidth / 2
    poly(1).y = Form1.ScaleHeight / 2
    poly(2).x = 2 * Form1.ScaleWidth / 3
    poly(2).y = 3 * Form1.ScaleHeight / 4
    poly(3).x = 1 * Form1.ScaleWidth / 3
    poly(3).y = 3 * Form1.ScaleHeight / 4
    poly(4).x = 2 * Form1.ScaleWidth / 3
    poly(4).y = 1 * Form1.ScaleHeight / 4
    poly(5).x = 1 * Form1.ScaleWidth / 3
    poly(5).y = 1 * Form1.ScaleHeight / 4
    Polygon Me.hdc, poly(1), NumCoords
    hBrush = GetStockObject(BLACKBRUSH)
    hRgn = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
    If hRgn Then FillRgn Me.hdc, hRgn, hBrush
    DeleteObject hRgn
End Sub
Private Sub Form_Resize()
    Form_Paint
End Sub

Maintenant j'aimerai faire clignoter mon dessin , comment faire ??

10/05/2006, 10h54
malhivertman1

Oui maintenant, ca dessine bien un sablier mais tout a l'heure, je n'avais qu'une barre diagonale. Pour le faire clignoter, pourquoi ne pas jouer sur le visible = true et visible = false, c'est le plus facile a faire
10/05/2006, 11h19
random

pour faire clignoter tu peux utiliser un timer et changer la couleur des traits
10/05/2006, 13h48
Lucas42

euh .... et bien j'ai regarder la source mais je ne trouve pas de moyen "simple" me permettant de faire clignoter , la propriété

Citation:

.visible = true
.visible = false

est exclu car je ne fait appel à aucun objet 8O

autre petit soucis , celui qui à codé à utilisé je ne sais quel fonction pour permettre de modifier la couleur , j'ai trouvé en essayant que je pouvait obtenit

Citation:

blanc en mettant 0
gris en mettant 1
noir en mettant 4
transparent en mettant 5

dans cette ligne de code

Code:

Const BLACKBRUSH = 4

mais impossible d'obtenir du rouge et du vert 8O 8O

votre aide est la bien venu
amicalement lucas

C'est cool , j'ai fait completement autre chose
Ceci dans un module

Code:

1
2
3
4
Declare Sub FloodFill Lib "gdi32" (ByVal hDC As Long, _
                                   ByVal X As Long, _
                                   ByVal Y As Long, _
                                   ByVal crColor As Long)

Ceci dans une feuille

Code:

1
2
3
4
5
6
7
8
9
10
11
Private Sub Form_Paint()
   ScaleMode = vbPixels
   ForeColor = vbBlack
   Line (100, 50)-(300, 50)
   Line (100, 50)-(300, 350)
   Line (300, 50)-(100, 350)
   Line (100, 350)-(300, 350)
   FillStyle = vbFSSolid
   FillColor = RGB(255, 0, 0)
   FloodFill hDC, 200, 100, ForeColor
End Sub

Donc je peut avoir toutes les couleurs que je veux grace au FillColor , il faut tout de même connaitre les taux de Rouge , ......