Faire des dessins vectorielle
Soyez le premier à donner votre avis sur cette source.
Vue 5 739 fois - Téléchargée 588 fois
Description
l'idée est de rajouter des repere pour former un dessin de base, puis de le reproduire suivant un axe définis par la souris.
Source / Exemple :
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
Codes Sources
A voir également
- Xang xi yi
- Visual Basic / VB.NET : Dessin vectoriel - CodeS SourceS - Guide
- C / C++ / C++.NET : Dessin vectoriel (listes chainees + sauvegarde .txt) fltk - CodeS SourceS - Guide
- Visual Basic / VB.NET : Dessin vectoriel - cad - CodeS SourceS - Guide
- Librairie pour dessin vectoriel ✓ - Forum - C++ & C++ .NET
- Flash : Vectoshop : photoshop en flash (... rien que ça !) dessin - image - vectoriel - Code - Guide
Commentaire
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.