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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
| Option Explicit
Dim NumImgEnCour As Integer
Private Sub Form_Load()
Me.ScaleMode = vbPixels: Me.AutoRedraw = True
Command1.Move 10, 5, 70, 21: Command1.Caption = "Go"
Picture1.ScaleMode = vbPixels: Picture1.AutoRedraw = True
Picture1.Move 10, Command1.Top + Command1.Height + 5, 200, 200: Picture1.Appearance = 0
Picture2.ScaleMode = vbPixels: Picture2.AutoRedraw = True
Picture2.AutoSize = True: Picture2.Appearance = 0
Picture2.Move Picture1.Left + Picture1.Width + 5, Picture1.Top
Command2.Move Picture1.Left + Picture1.Width + 5, 5, 70, 21: Command2.Caption = "Récupe"
Picture3.ScaleMode = vbPixels: Picture3.AutoRedraw = True
Picture3.Appearance = 0
Picture3.Move Picture1.Left, Picture1.Top + Picture1.Height + 5, 405, 150
File1.Visible = False: File1.Path = App.Path 'branchement sur le dossier du présent programme
End Sub
Private Sub Command1_Click()
DessineR
EnregistreR
End Sub
Sub DessineR()
Dim CX As Integer, CY As Integer
Dim F As Single, F1 As Single, F2 As Single
Dim I As Integer, RestE As Integer ' Déclare les variables
CX = Picture1.ScaleWidth / 2 ' Obtient le centre horizontal
CY = Picture1.ScaleHeight / 2 ' Obtient le centre vertical
Picture1.DrawWidth = 8 ' Définit la propriété DrawWidth.
Randomize: RestE = Int(11 * Rnd + 5)
For I = 50 To 0 Step -2
F = I / 50 ' Effectue les calculs
F1 = 1 - F: F2 = 1 + F ' intermédiaires.
' Définit la couleur de premier plan.
Picture1.ForeColor = QBColor(I Mod RestE)
Picture1.Line (CX * F1, CY * F1)-(CX * F2, CY * F2), , BF
Next I
DoEvents ' Laisse s'effectuer d'autres traitements.
If CY > CX Then ' Définit la propriété DrawWidth.
Picture1.DrawWidth = ScaleWidth / 25
Else
Picture1.DrawWidth = ScaleHeight / 25
End If
Randomize: RestE = Int(11 * Rnd + 5)
For I = 0 To 50 Step 2 ' Définit la boucle.
F = I / 50 ' Effectue les calculs
F1 = 1 - F: F2 = 1 + F ' intermédiaires.
' Dessine l'angle supérieur gauche.
Picture1.Line (CX * F1, CY)-(CX, CY * F1)
' Dessine l'angle supérieur droit.
Picture1.Line -(CX * F2, CY)
' Dessine l'angle inférieur droit.
Picture1.Line -(CX, CY * F2)
' Dessine l'angle inférieur gauche.
Picture1.Line -(CX * F1, CY)
' Change de couleur pour chaque.
Picture1.ForeColor = QBColor(I Mod RestE)
Next I
DoEvents ' Laisse s'effectuer d'autres traitements.
End Sub
Sub EnregistreR()
Dim T As Integer
'recherche le N° d'image déjà utilisé
File1.Refresh
NumImgEnCour = 0
For T = 0 To File1.ListCount - 1
If InStr(File1.List(T), "Image") Then NumImgEnCour = NumImgEnCour + 1
Next T
'sauvegarde de l'image dans le dossier ou se trouve le présent programme
SavePicture Picture1.Image, App.Path & "\Image" & CStr(NumImgEnCour) & ".BMP"
End Sub
Private Sub Command2_Click()
'recuperation simple
Picture2.Picture = LoadPicture(App.Path & "\Image" & NumImgEnCour & ".bmp")
'récupération avec déformation
Picture3.PaintPicture LoadPicture(App.Path & "\Image" & NumImgEnCour & ".bmp"), 0, 0, Picture3.ScaleWidth, Picture3.ScaleHeight
'ou
'récupération avec déformation en copiant l'image de Picture2
'Picture3.PaintPicture Picture2.Image, 0, 0, Picture3.ScaleWidth, Picture3.ScaleHeight
End Sub |
