Μαγευτικά γραφικά σε Visual Basic

Στον παρακάτω κώδικα θα δείτε πώς μπορούμε να φτιάξουμε υπέροχα γραφικά χρησιμοποιώντας απλές συναρτήσεις της Visual basic 6. Όπως φαίνεται στην εικόνα υπάρχουν πέντε σφαίρες με διαφορετικά χρώματα η κάθε μία των οποίων το χρώμα αποσβένει σταδιακά . Επίσης όπως διακρίνετε, στις περιοχές που βρίσκονται δύο ή παραπάνω σφαίρες υπάρχει συνδυασμός των χρωμάτων τους. Στο πρόγραμμα έχει ενσωματωθεί και κώδικας για την κίνηση αυτών των σφαιρών

μπορείτε να δείτε μια περισσότερο θεαματική έκδοση του προγράμματος στα tuttorial για προχώρημένους (πατήστε εδώ)

Κώδικας σε VB6

Δομή δεδομένων για πληροφορίες της κάθε σφαίρας όπως ταχύτητα, θέση, χρώμα (τύπος RGB R=red,G=green,B=blue), μέγιστος αριθμός ενεργών σφαιρών, ρυθμός απόσβεσης χρώματος (rise,spread). Ο αριθμός 10 δηλώνει τον μέγιστο αριθμό σφαιρών για το πρόγραμμα

Private Type point_fix
u_x(10) As Double
u_y(10) As Double
X(10) As Double
Y(10) As Double
c_r(10) As Integer
c_g(10) As Integer
c_b(10) As Integer
maxs As Integer
rise As Double
spread As Double
End Type

Δήλωση σφαιρών
Private pt As point_fix

Τρέχων αριθμός σφαίρας (για αλλαγή θέση από τον χρήστη)
Private cur

Κύρια συνάρτηση υπολογισμού των γραφικών

Private Sub shows()

Pic.AutoRedraw = True
With pt
bb = 3 ‘βημα γραφικών (για τα Pixel)

‘Η εικόνα έχει οριστεί σε κατάσταση (100 x 100) οπότε οι θέσεις είναι 100 για τον άξoνα χ και y

For Y = 1 To 100 Step bb
For X = 1 To 100 Step bb

‘αν δεν έχει οριστεί η εξομάλυνση ορίζεται εδώ

If .rise = 0 Then .rise = 1.5
If .spread = 0 Then .spread = 100
r = 0: g = 0: b = 0

‘υπολογισμός του χρώματος για κάθε pixel από την επιρροή κάθε σφαίρας

For s = 0 To .maxs - 1

‘ακτίνα (απόσταση) του τρέχον pixel από το κέντρο της σφαίρας

rd = Sqr((.X(s) - X) ^ 2 + (.Y(s) - Y) ^ 2)

‘ένταση του χρώματος

ed = 1 / (rd ^ .rise / .spread + 1)

‘πολυπλεξη χρωμάτων

r = r + .c_r(s) * ed
g = g + .c_g(s) * ed
b = b + .c_b(s) * ed

Next s
‘διόρθωση χρωμάτων

If r > 255 Then r = 255
If g > 255 Then g = 255
If b > 255 Then b = 255

If r < 0 Then r = 0
If g < 0 Then g = 0
If b < b =" 0

‘εμφάνιση του pixel
Pic.PSet (X, Y), RGB(r, g, b)

Next X
Next Y
End With

Pic.AutoRedraw = False

End Sub

κίνηση σφαιρών

Private Sub Command1_Click()

’20 καρέ
For ee = 1 To 20

With pt
‘υπολογισμός νέων θέσεων όλων των σφαιρών

For a = 0 To .maxs
.X(a) = .X(a) + .u_x(a)
.Y(a) = .Y(a) + .u_y(a)
‘αν είναι εκτός ορίων της εικόνας αντιστροφή ταχυτήτων

If .X(a) < 0 Then .u_x(a) = Abs(.u_x(a))
If .Y(a) <>

If .X(a) > Pic.ScaleWidth Then .u_x(a) = -Abs(.u_x(a))

If .Y(a) > Pic.ScaleHeight Then .u_y(a) = -Abs(.u_y(a))
Next a

‘εμφάνιση του καρέ
shows
End With

Next

End Sub

‘αρχικοποίηση δεδομένων

Private Sub Form_Load()

Pic.Scale (0, 0)-(100, 100)

Pic.DrawWidth = 14
With pt
.maxs = 5

‘τυχαίες θέσεις των σφαιρών

For a = 0 To 4
.X(a) = Rnd * 100
.Y(a) = Rnd * 100
Next a

‘σφαίρα 1 χρώμα μπλε
.c_b(0) = 255

‘σφαίρα 2 χρώμα κόκκινο
.c_r(1) = 255

‘σφαίρα 3 χρώμα κίτρινο
.c_r(2) = 255
.c_g(2) = 255

‘σφαίρα 4 χρώμα πράσινο
.c_g(3) = 255

‘σφαίρα 5 χρώμα άσπρο
.c_g(4) = 255
.c_r(4) = 255
.c_b(4) = 255

‘τυχαίες ταχύτητες

For a = 0 To .maxs
.u_x(a) = 5 - Rnd * 10
.u_y(a) = 5 - Rnd * 10
Next a

End With
End Sub

Διασκεδάστε το

Αρχεία συνδεδεμένα με αυτό το άρθρο
Πηγαίος κώδικας -
εκτελέσιμο αρχειο -