1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Graphique
  5. Faire des dessins vectorielle

Faire des dessins vectorielle

Soyez le premier à donner votre avis sur cette source.

Vue 6 422 fois - Téléchargée 664 fois

Télécharger le projet
Commenter

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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (zulrigh)