Soyez le premier à donner votre avis sur cette source.
Vue 6 422 fois - Téléchargée 664 fois
Public ConStanT, ConStanTX, ConsTanTY, cOmPte, nOmBre As Integer Public a, b, c, d, e, X0, Y0, x01, y01 As Single Public ax, ay, bx, by, cx, cy, dx, dy As Integer Public AnG As Single Public x1, x2, y1, y2, xa, ya, Mat_V As Single Public RepErE, RepeRe_AuTre As Boolean Dim TabL(5000, 2), MaT(500, 4), XO(200), YO(200), MatriX_VecteuR(500, 4) Dim Matrix_Dx(1, 5000000) Private Sub Command1_Click() BActif = False Rendu Set d3d = Nothing Set d3dDevice = Nothing Set dx = Nothing End End Sub Private Sub Command7_Click() If BActif = False Then BActif = True Rendu Else BActif = False Rendu End If End Sub Private Sub Form_Load() Form2.Show Label1.Caption = "encore des tas de bugzzz" RepErE = True RepeRe_AuTre = False X0 = 0 Y0 = 0 a = 0 cOmPte = -1 nOmBre = 0 Mat_V = -1 ConStanT = 30 ConStanTX = ConStanT ConsTanTY = ConStanT End Sub Private Sub Form_Unload(Cancel As Integer) BActif = False Rendu Set d3d = Nothing Set d3dDevice = Nothing Set dx = Nothing End End Sub Private Sub Command2_Click() 'autres repere nOmBre = nOmBre + 1 'incrémentation RepeRe_AuTre = True End Sub Private Sub Command6_Click() Call TexTure End Sub Sub Rep(X, Y) Picture1.DrawWidth = 6 For a = 0 To nOmBre X = XO(a) Y = YO(a) Picture1.PSet (X, Y), RGB(255, 0, 0) Next X = XO(0) Y = YO(0) Picture1.DrawWidth = 1 Picture1.Line (X, Y)-(X + ConStanTX, Y), RGB(0, 255, 0) 'repere Picture1.Line (X, Y)-(X, Y + ConsTanTY), RGB(0, 0, 255) If cOmPte >= 0 Then Form2.Cls 'efface la matrice 'affichage de la matrice For a = 0 To cOmPte x1 = MaT(a, 1) y1 = MaT(a, 2) x2 = MaT(a, 3) y2 = MaT(a, 4) x1 = Int(x1) 'arrondis x2 = Int(x2) y1 = Int(y1) y2 = Int(y2) MaT(a, 1) = x1 MaT(a, 2) = y1 MaT(a, 3) = x2 MaT(a, 4) = y2 Picture1.Line (x1, y1)-(x2, y2), RGB(0, 255, 0) 'trace les lignes vertes Form2.Print x1, y1, x2, y2 Next End If End Sub Private Sub picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If RepeRe_AuTre = False Then If RepErE = True Then X0 = X Y0 = Y XO(0) = X0 YO(0) = Y0 x01 = X0 y01 = Y0 Call Rep(X0, Y0) RepErE = False Else cOmPte = cOmPte + 1 MaT(cOmPte, 1) = X0 MaT(cOmPte, 2) = Y0 MaT(cOmPte, 3) = x01 MaT(cOmPte, 4) = y01 Mat_V = Mat_V + 1 MatriX_VecteuR(Mat_V, 1) = X0 MatriX_VecteuR(Mat_V, 2) = Y0 MatriX_VecteuR(Mat_V, 3) = x01 MatriX_VecteuR(Mat_V, 4) = y01 X0 = x01 Y0 = y01 XO(0) = X0 YO(0) = Y0 Call dessin_enr End If Else X0 = X Y0 = Y cOmPte = cOmPte + 1 MaT(cOmPte, 1) = XO(nOmBre - 1) MaT(cOmPte, 2) = YO(nOmBre - 1) MaT(cOmPte, 3) = X0 MaT(cOmPte, 4) = Y0 XO(nOmBre) = X 'enregistre et déplace ! YO(nOmBre) = Y RepeRe_AuTre = False End If End Sub Private Sub picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If RepeRe_AuTre = False Then If RepErE = False Then X0 = XO(a) Y0 = YO(a) Picture1.Cls Call Rep(X0, Y0) Dim XAnG As Single If Y < Y0 And X > X0 Then ConStanTX = ConStanT ConsTanTY = -ConStanT x1 = X - X0 y1 = Y0 - Y XAnG = y1 / x1 'opposé contre adjacent AnG = Atn(XAnG) 'fonction tangeante inverse !! x01 = (Cos(AnG)) * ConStanTX + X0 y01 = (Sin(AnG)) * ConsTanTY + Y0 Picture1.Line (X0, Y0)-(x01, y01) End If If Y > Y0 And X > X0 Then ConStanTX = ConStanT ConsTanTY = ConStanT x1 = X0 - X y1 = Y0 - Y XAnG = y1 / x1 AnG = Atn(XAnG) x01 = (Cos(AnG)) * ConStanTX + X0 y01 = (Sin(AnG)) * ConsTanTY + Y0 Picture1.Line (X0, Y0)-(x01, y01) End If If Y < Y0 And X < X0 Then ConStanTX = -ConStanT ConsTanTY = -ConStanT x1 = X - X0 y1 = Y - Y0 XAnG = y1 / x1 AnG = Atn(XAnG) x01 = (Cos(AnG)) * ConStanTX + X0 y01 = (Sin(AnG)) * ConsTanTY + Y0 Picture1.Line (X0, Y0)-(x01, y01) End If If Y > Y0 And X < X0 Then ConStanTX = -ConStanT ConsTanTY = ConStanT x1 = X0 - X y1 = Y - Y0 XAnG = y1 / x1 AnG = Atn(XAnG) x01 = (Cos(AnG)) * ConStanTX + X0 y01 = (Sin(AnG)) * ConsTanTY + Y0 Picture1.Line (X0, Y0)-(x01, y01) End If For a = 1 To nOmBre 'les autres reperes xa = (Cos(AnG)) * ConStanTX + XO(a) ya = (Sin(AnG)) * ConsTanTY + YO(a) Picture1.Line (XO(a), YO(a))-(xa, ya) Picture1.Line (XO(a), YO(a))-(XO(a - 1), YO(a - 1)) Next End If Else Picture1.Cls Call Rep(X0, Y0) Picture1.Line (XO(nOmBre - 1), YO(nOmBre - 1))-(X, Y) End If End Sub Sub dessin_enr() For a = 1 To nOmBre 'dessine xa = (Cos(AnG)) * ConStanTX + XO(a) ya = (Sin(AnG)) * ConsTanTY + YO(a) Picture1.Line (XO(a), YO(a))-(xa, ya) 'enregistre cOmPte = cOmPte + 1 MaT(cOmPte, 1) = XO(a) MaT(cOmPte, 2) = YO(a) MaT(cOmPte, 3) = xa MaT(cOmPte, 4) = ya Mat_V = Mat_V + 1 MatriX_VecteuR(Mat_V, 1) = XO(a) MatriX_VecteuR(Mat_V, 2) = YO(a) MatriX_VecteuR(Mat_V, 3) = xa MatriX_VecteuR(Mat_V, 4) = ya XO(a) = xa YO(a) = ya Next For a = 1 To nOmBre cOmPte = cOmPte + 1 MaT(cOmPte, 1) = XO(a - 1) MaT(cOmPte, 2) = YO(a - 1) MaT(cOmPte, 3) = XO(a) MaT(cOmPte, 4) = YO(a) Next End Sub Sub TexTure() Dim f As Single, xi As Single, yi As Single, e As Single 'ici on vas faire un remaniment des matrices dans matrix_Dx ! e = 0 For a = 0 To cOmPte x1 = MaT(a, 1) y1 = MaT(a, 2) x2 = MaT(a, 3) y2 = MaT(a, 4) If e = 0 Then Matrix_Dx(0, a) = x1 Matrix_Dx(1, a) = y1 Matrix_Dx(0, a + 1) = x2 Matrix_Dx(1, a + 1) = y2 Else Matrix_Dx(0, a + 1) = x2 Matrix_Dx(1, a + 1) = y2 End If e = e + 1 If e = 3 Then e = 0 Next '''''''''''''' Form2.Cls Form2.PSet (0, 0) e = 0 ''''''''''''''''''''''''''''''''''' For a = 0 To cOmPte + 1 If e = 0 Then Form2.Print "--------" End If e = e + 1 If e = 3 Then e = 0 x1 = Matrix_Dx(0, a) y1 = Matrix_Dx(1, a) Picture1.DrawWidth = 3 Picture1.PSet (x1, y1), vbRed Picture1.DrawWidth = 1 Form2.Print x1, y1 Next ''''''''''''''''''''''''''''''''' ' test du directX If BActif = True Then e = 0 f = 0 For a = 0 To cOmPte xi = Matrix_Dx(0, a) yi = Matrix_Dx(1, a) VecTeur f, xi, yi, e 'marche pas !! f = f + 1 If e = 0 Then e = 1 Else e = 0 End If Next e = 0 f = 0 End If End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.