~ Edito ~
12/03/2006 @ 13:39
Depuis la dernière mise à jour (qui remonte à... oulala plusieurs mois), un petit ménage de printemps s'impose. Ca tombe bien, c'est presque la période. Au menu, et progressivement sur les jours à venir, rafraîchissement de plusieurs fonctions et procédures, nouvelles APIs et nouveaux programmes. ~ Rechercher ~
~ Annuaire VB ~
~ Partenaires ~
|
Divers : Figures L'idée est de permettre à un développeur d'orienter à peu près n'importe quel dessin (sans trop de
prise de tête !) grâce à une routine de calcul - RPoint - qui renvoit les coordonnées utiles. Cliquer ici pour télécharger le code complet. ' Figures est un exercice didactique réalisé par Cath' S'il vous a aidé ou agacé, adressez un mail à h.cathelineau@infonie.fr ' Merci! Private Declare Function GetTickCount& Lib "KERNEL32" () Private Declare Function FloodFill& Lib "gdi32" (_ ByVal hDestDC&, ByVal X1&, ByVal Y1&, ByVal Couleur&) Private Sub Cmd_Click(Index As Integer) Select Case Index Case 0 'Polygone DemoPolygone Case 6 Dim Msg As String, LRC As String Dim I As Integer For I = 0 To 10 Text1(I).BackColor = QBColor(7) Next Text1(11).Visible = False Text1(12).Visible = False LRC = Chr$(13) & Chr$(10) Msg = LRC & " A propos de Figures..." & LRC & LRC Msg = Msg & " Démonstration des calculs de rotation de la routine RPoint." & LRC & LRC Msg = Msg & " - Go : Rotation de trois points paramétrables." & LRC Msg = Msg & " - Demo 1 : Polygone quelconque" & LRC Msg = Msg & " - Demo 2 : Ellipse" & LRC Msg = Msg & " - Demo 3 : Spirale" & LRC Msg = Msg & " - Demo 4 : Polygone régulier" & LRC & LRC Msg = Msg & " Par Cath" & LRC Msg = Msg & " h.cathelineau@infonie.fr" & LRC Me.Tag = "APropos" Picture1.BackColor = QBColor(15) Picture1.Cls Picture1.Print Msg Case 7 'Animation AnimPolygone Case 1 'Test ellipse DemoEllipse Case 8 'Engrenage AEngrenage Case 5 'Demo Spirale DemoSpirale Case 2 DemoPoints 'Go : Rotation de trois points Case 3 Picture1.Cls Case 4 Unload Me End Case 9 'Texte RTexte Case 11 RLettres Case 10 PolygoneRegul Case Else End Select End Sub Private Sub Form_Activate() Cmd_Click 6 End Sub Private Sub Form_Load() Left = (Screen.Width - Width) \ 2 Top = (Screen.Height - Height) \ 2 End Sub Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) If KeyAscii = 13 Then KeyAscii = 0 Select Case Me.Tag Case "Démo1": DemoPolygone Case "Démo2": DemoEllipse Case "Démo3": DemoSpirale Case "Anim1": AnimPolygone Case "Anim2": AEngrenage Case "Texte1": RTexte Case "Démo4": PolygoneRegul Case "Texte2": RLettres Case "APropos" Case Else: DemoPoints End Select End If End Sub Public Function VirguleP$(Chaine As String) A$ = Chaine Z& = InStr(A$, ",") If Z& > 0 Then Mid$(A$, Z&) = "." End If VirguleP$ = A$ End Function Public Sub RPoint(Rotation As Single, CentreX As Single, CentreY As Single, _ X1 As Single, Y1 As Single, X2 As Single, Y2 As Single, _ Rayon As Single, Ratio As Single) Dim AngleR As Double, Rapport As Double, PI As Double Dim CoteX As Single, CoteY As Single PI = 3.14159265358979 CoteX = X1 - CentreX If Ratio > 1 Then CoteX = CoteX * Ratio CoteY = Y1 - CentreY If Ratio < 1 Then CoteY = CoteY * (1 / Ratio) If CoteX = 0 And CoteY = 0 Then Rayon = 0 X2 = X1 Y2 = Y1 Exit Sub End If 'Merci Pythagore Rayon = Sqr(CoteX ^ 2 + CoteY ^ 2) If CoteX <> 0 Then Rapport = CoteY / CoteX Else Rapport = PI * 96 End If AngleR = Atn(Rapport) + Rotation If CoteX < 0 Or (CoteX = 0 And CoteY < 0) Then AngleR = AngleR + PI End If X2 = Cos(AngleR) * Rayon If Ratio > 1 Then X2 = X2 * (1 / Ratio) X2 = X2 + CentreX Y2 = Sin(AngleR) * Rayon If Ratio < 1 Then Y2 = Y2 * Ratio Y2 = Y2 + CentreY End Sub Public Sub DemoEllipse() Dim Plan As PictureBox Dim Rotation As Single, Rayon As Single Dim CentreX As Single, CentreY As Single Dim Ecart As Single Dim Ratio As Single Dim Couleur As Long Dim Debut As Single, Fin As Single Dim PI As Double Dim RepAPI As Long Dim I As Integer For I = 0 To 9 Text1(I).BackColor = QBColor(7) Next Text1(10).BackColor = vbWhite Text1(11).Visible = False Text1(12).Visible = False Set Plan = Picture1 Plan.BackColor = QBColor(0) Plan.Cls Me.Tag = "Démo2" PI = 3.14159265358979 CentreX = 200 CentreY = 170 Couleur = QBColor(Val(Text1(10).Text) Mod 16) 'Rotation = (Val(VirguleP$(Text1(8).Text)) * PI) / 180 Rayon = 150 Ratio = 0.4 'Debut = PI / 2 'Fin = (3 * PI) / 2 'Fin = PI / 2 'Debut = (3 * PI) / 2 'Fin = PI + (PI / 4) 'Debut = (PI / 2) + (PI / 4) Debut = 0 Fin = 0 'Plan.Circle (CentreX, CentreY), Rayon0, QBColor(7), , , Ratio0 'Plan.Circle (CentreX, CentreY), Rayon0, QBColor(9), Debut, Fin, Ratio0 Rotation = 0 Ecart = 0 'Plan.FillStyle = 0 'Plan.FillColor = Couleur For I = 0 To 36 Plan.Cls Rotation = Ecart REllipse Plan, CentreX, CentreY, Rayon, Debut, Fin, Ratio, Rotation, Couleur 'RepAPI = FloodFill(Plan.hDC, CentreX, CentreY, Couleur) Rotation = (PI * 2) - Ecart REllipse Plan, CentreX, CentreY, Rayon, Debut, Fin, Ratio, Rotation, Couleur Plan.Refresh Retard 30 Ecart = Ecart + (PI / 48) Next Set Plan = Nothing End Sub Public Sub DemoSpirale() Dim Plan As PictureBox Dim Rotation As Single, Rayon As Single, Rayon0 As Single Dim CentreX As Single, CentreY As Single Dim X1 As Single, Y1 As Single Dim X2 As Single, Y2 As Single Dim PX0 As Single, PY0 As Single Dim PX1 As Single, PY1 As Single Dim ACC As Single Dim Ratio0 As Single, RatioR As Single Dim Couleur As Long Dim Angle As Double, PI As Double Dim I As Integer For I = 0 To 9 Text1(I).BackColor = QBColor(7) Next Text1(8).BackColor = vbWhite Text1(10).BackColor = vbWhite Text1(11).Visible = False Set Plan = Picture1 Plan.BackColor = QBColor(0) Plan.Cls Plan.DrawWidth = 2 Me.Tag = "Démo3" PI = 3.14159265358979 CentreX = 200 CentreY = 170 Rotation = (Val(VirguleP$(Text1(8).Text)) * PI) / 180 Rayon0 = 50 Ratio0 = 0.4 RatioR = 1 Couleur = QBColor(Val(Text1(10).Text) Mod 16) PX1 = -1 ACC = 0.05 For I = 0 To 2 Angle = 0 ACC = ACC + 0.1 Do X1 = Cos(Angle) * Rayon0 If Ratio0 > 1 Then X1 = X1 * (1 / Ratio0) X1 = X1 + CentreX Y1 = Sin(Angle) * Rayon0 If Ratio0 < 1 Then Y1 = Y1 * Ratio0 Y1 = Y1 + CentreY RPoint Rotation, CentreX, CentreY, X1, Y1, X2, Y2, Rayon, RatioR If PX1 = -1 Then PX0 = X2 PY0 = Y2 Else Plan.Line (X2, Y2)-(PX1, PY1), Couleur End If PX1 = X2 PY1 = Y2 Rayon0 = Rayon0 + ACC If Angle = PI * 2 Then Exit Do End If Angle = Angle + (PI / 100) If Angle > (PI * 2) Then Angle = PI * 2 End If Loop Next Plan.DrawWidth = 1 Set Plan = Nothing End Sub Public Sub DemoPolygone() Dim Plan As PictureBox 'Modifier pour affecter la variable Plan 'à une PictureBox autre que Picture1 Set Plan = Picture1 Dim Rotation As Single Dim CentreX As Single, CentreY As Single Dim PTX(3) As Single, PTY(3) As Single Dim PTRX(3) As Single, PTRY(3) As Single Dim Rayon As Single Dim PI As Double Dim Couleur As Long Dim RepAPI As Long Dim I As Integer, J As Integer For I = 0 To 1 Text1(I).BackColor = vbWhite Next For I = 2 To 9 Text1(I).BackColor = QBColor(7) Next Text1(10).BackColor = vbWhite Text1(11).Visible = False Text1(12).Visible = False PI = 3.14159265358979 'Acquisition des paramètres Couleur = QBColor(Val(Text1(10).Text) Mod 16) CentreX = Val(Text1(0).Text) CentreY = Val(Text1(1).Text) Plan.BackColor = QBColor(0) Plan.DrawWidth = 1 Plan.FillStyle = 0 Plan.FillColor = Couleur& Plan.Cls Me.Tag = "Démo1" Rotation = 0 'Coordonnées du polygone PTX(0) = CentreX + 160 PTY(0) = CentreY PTX(1) = CentreX + 145 PTY(1) = CentreY - 18 PTX(2) = CentreX + 60 PTY(2) = CentreY PTX(3) = CentreX + 145 PTY(3) = CentreY + 18 'Reproduire 24 fois la figure For J = 0 To 23 For I = 0 To 3 RPoint Rotation, CentreX, CentreY, PTX(I), PTY(I), PTRX(I), PTRY(I), Rayon, 1 If I > 0 Then Plan.Line (PTRX(I - 1), PTRY(I - 1))-(PTRX(I), PTRY(I)), Couleur End If If I = 3 Then Plan.Line (PTRX(3), PTRY(3))-(PTRX(0), PTRY(0)), Couleur RepAPI = FloodFill(Plan.hDC, (PTRX(0) + PTRX(2)) \ 2, _ (PTRY(0) + PTRY(2)) \ 2, Couleur&) End If Next I 'Retarder l'affichage pour la démonstration Plan.Refresh Retard 25 Rotation = Rotation + (PI / 12) Next J Plan.FillStyle = 1 Set Plan = Nothing End Sub Public Sub AnimPolygone() Dim Plan As PictureBox Dim Rotation As Single Dim CentreX As Single, CentreY As Single Dim PTX(3) As Single, PTY(3) As Single Dim PTRX(3) As Single, PTRY(3) As Single Dim Rayon As Single Dim PI As Double Dim Couleur As Long, RepAPI As Long Dim I As Integer, J As Integer, K As Integer Dim EcartX As Integer, EcartY As Integer For I = 0 To 9 Text1(I).BackColor = QBColor(7) Next Text1(10).BackColor = vbWhite Text1(11).Visible = False Text1(12).Visible = False PI = 3.14159265358979 CentreX = Val(Text1(0).Text) CentreY = Val(Text1(1).Text) Couleur = QBColor(Val(Text1(10).Text) Mod 16) 'Modifier pour affecter la variable Plan 'à une PictureBox autre que Picture1 Set Plan = Picture1 Plan.BackColor = QBColor(15) Plan.DrawWidth = 1 Plan.FillStyle = 0 Plan.FillColor = Couleur Me.Tag = "Anim1" 'Coordonnées du polygone PTX(0) = CentreX - 110 PTY(0) = CentreY PTX(1) = CentreX - 95 PTY(1) = CentreY - 10 PTX(2) = CentreX - 10 PTY(2) = CentreY PTX(3) = CentreX - 95 PTY(3) = CentreY + 10 For K = 1 To 14 Retard 50 Rotation = 0 If K < 9 Then EcartX = -10 EcartY = -1 Else EcartX = 10 EcartY = 1 End If Plan.Cls PTX(0) = PTX(0) + EcartX PTX(1) = PTX(1) + EcartX PTY(1) = PTY(1) + EcartY PTX(2) = PTX(2) + EcartX PTX(3) = PTX(3) + EcartX PTY(3) = PTY(3) - EcartY For J = 0 To 23 For I = 0 To 3 RPoint Rotation, CentreX, CentreY, PTX(I), PTY(I), PTRX(I), PTRY(I), Rayon, 0.75 If I > 0 Then Plan.Line (PTRX(I - 1), PTRY(I - 1))-(PTRX(I), PTRY(I)), QBColor(7) End If If I = 3 Then Plan.Line (PTRX(3), PTRY(3))-(PTRX(0), PTRY(0)), QBColor(7) RepAPI = FloodFill(Plan.hDC, (PTRX(0) + PTRX(2)) \ 2, _ (PTRY(0) + PTRY(2)) \ 2, QBColor(7)) End If Next I Rotation = Rotation + (PI / 12) Next J Next K Plan.FillStyle = 1 Set Plan = Nothing End Sub Public Sub Retard(RTD&) T1& = GetTickCount& Do DoEvents T2& = GetTickCount& If T2& < T1& Or T2& > T1& + RTD& Then Exit Do Loop End Sub Public Sub AEngrenage() Dim Plan As PictureBox Dim Rotation As Single, Rotation2 As Single Dim CentreX As Single, CentreY As Single Dim PTX(4) As Single, PTY(4) As Single Dim PTRX(4) As Single, PTRY(4) As Single Dim Rayon As Single, Ratio As Single Dim Rayon2 As Single Dim PI As Double Dim Couleur As Long Dim I As Integer, J As Integer, K As Integer For I = 0 To 9 Text1(I).BackColor = QBColor(7) Next Text1(10).BackColor = vbWhite Text1(11).Visible = False 'PI = 3.141593 PI = 3.14159265358979 Couleur = QBColor(Val(Text1(10).Text) Mod 16) 'Modifier pour affecter la variable Plan 'à une PictureBox autre que Picture1 Set Plan = Picture1 Plan.BackColor = QBColor(0) Plan.DrawWidth = 1 Plan.FillStyle = 1 Plan.FillColor = Couleur Me.Tag = "Anim2" Plan.Cls CentreX = 150 CentreY = 170 Rayon = 100 Ratio = 1 'CoordonnéeX du coloriage X3& = CentreX - Rayon + 12 Y3& = CentreY 'Rayon du cercle intérieur If Ratio > 1 Then Rayon2 = (Rayon * Ratio) - (20 * Ratio) Else Rayon2 = Rayon - 20 End If PTX(0) = CentreX - Rayon PTY(0) = CentreY RPoint (3 * PI) / 144, CentreX, CentreY, PTX(0), PTY(0), PTX(1), PTY(1), Rayon, Ratio RPoint PI / 36, CentreX, CentreY, PTX(0) + 10, PTY(0), PTX(2), PTY(2), Rayon, Ratio RPoint (7 * PI) / 144, CentreX, CentreY, PTX(0) + 10, PTY(0), PTX(3), PTY(3), Rayon, Ratio RPoint PI / 18, CentreX, CentreY, PTX(0), PTY(0), PTX(4), PTY(4), Rayon, Ratio Rotation2 = 0 For K = 1 To 50 Plan.Cls Plan.FillStyle = 1 Plan.Circle (CentreX, CentreY), Rayon2, Couleur, , , Ratio Rotation = Rotation2 For I = 1 To 36 For J = 0 To 4 RPoint Rotation, CentreX, CentreY, PTX(J), PTY(J), PTRX(J), PTRY(J), Rayon, Ratio If J > 0 Then Plan.Line (PTRX(J - 1), PTRY(J - 1))-(PTRX(J), PTRY(J)), Couleur End If Next J Rotation = Rotation + PI / 18 Next I Plan.FillStyle = 0 API& = FloodFill(Plan.hDC, X3&, Y3&, Couleur) Retard 50 Rotation2 = Rotation2 + (PI / 72) Next K Plan.FillStyle = 1 Set Plan = Nothing End Sub Public Sub RTexte() Dim Plan As PictureBox Dim RTxt As String Dim HTxt As Long, WTxt As Long Dim I As Integer Dim HY As Integer, WX As Integer Dim RX As Single, RY As Single Dim CX As Single, CY As Single Dim CX2 As Single, CY2 As Single Dim Rotation As Single, Rayon As Single, Ratio As Single Dim Couleur As Long Dim PI As Double PI = 3.14159265358979 Me.Tag = "Texte1" 'Modifier pour affecter la variable Plan 'à une PictureBox autre que Picture1 Set Plan = Picture1 Plan.BackColor = QBColor(15) Plan.Cls For I = 0 To 9 Text1(I).BackColor = QBColor(7) Next Text1(10).BackColor = vbWhite Text1(11).Visible = True Text1(12).Visible = False 'Acquisition des paramètres Couleur = QBColor(Val(Text1(10).Text) Mod 16) Picture2.ForeColor = Couleur Picture2.FontBold = True Picture2.FontSize = 14 RTxt = Text1(11).Text If RTxt <> "" Then HTxt = Picture2.TextHeight(RTxt) WTxt = Picture2.TextWidth(RTxt) Picture2.Height = HTxt Picture2.Width = WTxt Picture2.Cls Picture2.Print RTxt CX = -40 CY = HTxt / 2 Rotation = 0 For I = 0 To 15 For HY = 1 To HTxt - 1 For WX = 0 To WTxt - 1 If Picture2.Point(WX, HY) = Couleur Then RPoint Rotation, CX, CY, CSng(WX), CSng(HY), RX, RY, Rayon, 1 Plan.PSet (RX + 220, RY + 150), Couleur End If Next WX Next HY Plan.Refresh Rotation = Rotation + (PI / 8) Next I End If Set Plan = Nothing End Sub Public Sub PolygoneRegul() Dim Plan As PictureBox Dim Rotation As Single Dim CentreX As Single, CentreY As Single Dim RayonP As Single, Ratio As Single Dim PI As Double Dim RepAPI As Long Dim Couleur As Long Dim NbCotes As Long Dim I As Integer For I = 0 To 2 Text1(I).BackColor = vbWhite Next For I = 3 To 9 Text1(I).BackColor = QBColor(7) Next Text1(10).BackColor = vbWhite Text1(11).Visible = False Text1(12).Visible = True PI = 3.14159265358979 'Modifier pour affecter la variable Plan 'à une PictureBox autre que Picture1 Set Plan = Picture1 Me.Tag = "Démo4" 'Acquisition des paramètres CentreX = Val(Text1(0).Text) CentreY = Val(Text1(1).Text) RayonP = Val(Text1(2).Text) Couleur = QBColor(Val(Text1(10).Text) Mod 16) NbCotes = Val(Text1(12).Text) Plan.BackColor = QBColor(0) Plan.DrawWidth = 1 Plan.FillStyle = 0 Plan.FillColor = Couleur Plan.Cls Ratio = 1 If NbCotes > 2 Then 'Donner l'angle du point de départ '(La formule suivante permet d'obtenir une base inférieure 'horizontale pour tous les polygones) Rotation = (PI / NbCotes) - PI / 2 RPolygoneRegulier Plan, Rotation, Ratio, CentreX, CentreY, RayonP, NbCotes, Couleur RepAPI = FloodFill(Plan.hDC, CLng(CentreX), CLng(CentreY), Couleur) End If Plan.FillStyle = 1 Set Plan = Nothing End Sub Public Sub RPolygoneRegulier(Plan As PictureBox, Rotation As Single, Ratio As Single, _ CentreX As Single, CentreY As Single, RayonP As Single, _ NbCotes As Long, Couleur As Long) Dim I As Integer Dim X1 As Single, Y1 As Single Dim RX() As Single, RY() As Single Dim PI As Double ReDim RX(NbCotes), RY(NbCotes) PI = 3.14159265358979 X1 = CentreX - RayonP Y1 = CentreY For I = 1 To NbCotes 'Calcul des coordonnées du point RX(I), RY(I) RPoint Rotation, CentreX, CentreY, X1, Y1, RX(I), RY(I), 0, Ratio If I > 1 Then Plan.Line (RX(I - 1), RY(I - 1))-(RX(I), RY(I)), Couleur End If If I = NbCotes Then Plan.Line (RX(I), RY(I))-(RX(1), RY(1)), Couleur End If 'Calcul de l'angle du point suivant Rotation = Rotation + ((PI * 2) / NbCotes) Next I End Sub Public Sub RLettres() Dim Plan As PictureBox Dim RTxt As String, Lettre As String Dim HTxt As Long, WTxt As Long, WLettre As Long Dim I As Integer, J As Integer Dim X1 As Single, Y1 As Single Dim HY As Integer, WX As Integer Dim RX As Single, RY As Single Dim CX As Single, CY As Single Dim CX2 As Single, CY2 As Single Dim Rotation As Single, Rayon As Single, Ratio As Single Dim Rotation2 As Single Dim Couleur As Long Dim PI As Double PI = 3.14159265358979 Me.Tag = "Texte2" 'Modifier pour affecter la variable Plan 'à une PictureBox autre que Picture1 Set Plan = Picture1 Plan.BackColor = QBColor(15) Plan.Cls For I = 0 To 9 Text1(I).BackColor = QBColor(7) Next Text1(10).BackColor = vbWhite Text1(11).Visible = True Text1(12).Visible = False Couleur = QBColor(Val(Text1(10).Text) Mod 16) Picture2.ForeColor = Couleur Picture2.FontSize = 36 Picture2.FontBold = True RTxt = Text1(11).Text HTxt = Picture2.TextHeight(RTxt) WTxt = Picture2.TextWidth(RTxt) If RTxt <> "" Then X1 = 80 Y1 = 150 Rotation = 0 For J = 1 To Len(RTxt) Lettre = Mid$(RTxt, J, 1) WLettre = Picture2.TextWidth(Lettre) - 1 Picture2.Height = HTxt Picture2.Width = WLettre Picture2.Cls Picture2.Print Lettre 'If J > 1 Then Rotation = Rotation + ((PI * (WLettre / 2)) / WTxt) 'End If CX = 0 CY = HTxt If Lettre <> " " Then Rotation2 = Rotation - (PI / 2) For HY = 1 To HTxt - 1 For WX = 0 To WLettre If Picture2.Point(WX, HY) = Couleur Then RPoint Rotation2, CX, CY, CSng(WX), CSng(HY), RX, RY, Rayon, 1 Plan.PSet (RX + X1, RY + Y1), Couleur End If Next WX Next HY End If Plan.Refresh 'If J = 1 Then ' Rotation = Rotation + ((PI * WLettre) / WTxt) 'Else Rotation = Rotation + ((PI * (WLettre / 2)) / WTxt) 'End If RPoint Rotation, 200, 150, 80, 150, RX, RY, Rayon, 1 X1 = RX Y1 = RY Next J End If Set Plan = Nothing End Sub Public Sub DemoPoints() Dim Plan As PictureBox Dim Rotation As Single Dim CentreX As Single, CentreY As Single Dim PTX(2) As Single, PTY(2) As Single Dim PTRX(2) As Single, PTRY(2) As Single Dim PI As Double, Rayon As Single Dim Ratio As Single, Angle As Double Dim Couleur As Long Dim I As Integer, J As Integer For I = 0 To 10 Text1(I).BackColor = vbWhite Next Text1(11).Visible = False Text1(12).Visible = False PI = 3.14159265358979 'Modifier pour affecter la variable Plan 'à une PictureBox autre que Picture1 Set Plan = Picture1 Plan.BackColor = QBColor(15) Plan.DrawWidth = 1 Plan.FillStyle = 1 If Me.Tag <> "Go" Then Plan.Cls Me.Tag = "Go" End If 'Acquisition des paramètres CentreX = Val(Text1(0).Text) CentreY = Val(Text1(1).Text) Rotation = (Val(VirguleP$(Text1(8).Text)) * PI) / 180 Ratio = Val(VirguleP$(Text1(9).Text)) Couleur = QBColor(Val(Text1(10).Text) Mod 16) 'Calcul des coordonnées, 'Montrer les cercles correspondants J = 2 For I = 0 To 2 PTX(I) = Val(Text1(J).Text) J = J + 1 PTY(I) = Val(Text1(J).Text) J = J + 1 RPoint Rotation, CentreX, CentreY, PTX(I), PTY(I), PTRX(I), PTRY(I), Rayon, Ratio Plan.Circle (CentreX, CentreY), Rayon, QBColor(7), , , Ratio Plan.Circle (PTX(I), PTY(I)), 2, QBColor(7), , , Ratio Plan.Circle (PTRX(I), PTRY(I)), 2, Couleur, , , Ratio Next 'Relier les points For I = 0 To 2 J = I + 1 If J = 3 Then J = 0 Plan.Line (PTX(I), PTY(I))-(PTX(J), PTY(J)), QBColor(7) Plan.Line (PTRX(I), PTRY(I))-(PTRX(J), PTRY(J)), Couleur Next Set Plan = Nothing End Sub Public Sub REllipse(Plan As PictureBox, CentreX As Single, CentreY As Single, _ Rayon As Single, Debut As Single, Fin As Single, Ratio As Single, _ Rotation As Single, Couleur As Long) Dim X1 As Single, Y1 As Single Dim X2 As Single, Y2 As Single Dim PX0 As Single, PY0 As Single Dim PX1 As Single, PY1 As Single Dim Tour As Boolean Dim PI As Double Dim AngleD As Double, AngleF As Double PI = 3.14159265358979 If Debut = Fin Then AngleD = 0 AngleF = PI * 2 Tour = True Else AngleD = (PI * 2) - Fin AngleF = (PI * 2) - Debut If AngleF < AngleD Then AngleF = AngleF + (PI * 2) End If PX1 = -1 Do X1 = Cos(AngleD) * Rayon If Ratio > 1 Then X1 = X1 * (1 / Ratio) X1 = X1 + CentreX Y1 = Sin(AngleD) * Rayon If Ratio < 1 Then Y1 = Y1 * Ratio Y1 = Y1 + CentreY RPoint Rotation, CentreX, CentreY, X1, Y1, X2, Y2, 0, 1 If PX1 = -1 Then PX0 = X2 PY0 = Y2 Else Plan.Line (PX1, PY1)-(X2, Y2), Couleur End If PX1 = X2 PY1 = Y2 If AngleD = AngleF Then Exit Do AngleD = AngleD + (PI / 90) If AngleD > AngleF Then AngleD = AngleF Loop If Tour Then Plan.Line (PX1, PY1)-(PX0, PY0), Couleur End If End Sub |