Newsgroup: it.comp.lang.visual-basic
Titolo: [Lungo] Regalino pirotecnico per capodanno

Dunque dunque.. ecco gli ingredienti della torta:
-una form (form1)
-due command button (command1 e command2)
-un timer (timer1)
-una picture Box (picture1)
-un modulo di Classe  *da chiamare* "cerchio"
codice dalla form1:
--------------------->
Option Explicit
Public icerchi As New Collection
Dim gx As Single
Dim gy As Single
Dim ga As Single
Dim gb As Single
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Dim want2exit As Boolean
Dim moredance As Boolean
Private Sub Command2_Click()
Dim a As Long
For a = icerchi.Count To 1 Step -1
    icerchi(a).AniStop
    icerchi.Remove a
Next
End Sub
Private Sub Command1_Click()
gx = Picture1.Width / 2
gy = Picture1.Height / 2
ga = 0
gb = 1
Timer1.Enabled = True
moredance = True
letsdance
End Sub
Private Sub Form_Load()
Me.Width = 8085
Me.Height = 6120
Command1.Height = 375
Command1.Width = 975
Command1.Top = 60
Command1.Left = 6960
Command1.Caption = "Start"
Command2.Width = 975
Command2.Height = 255
Command2.Top = 480
Command2.Left = 6960
Command2.Caption = "Reset"
Picture1.Left = 0
Picture1.Top = 0
Picture1.Width = 6855
Picture1.Height = 5775
Picture1.AutoRedraw = True
Picture1.BorderStyle = 1
Picture1.BackColor = 0
Picture1.ForeColor = RGB(255, 255, 255)
Timer1.Interval = 30
Timer1.Enabled = False
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single,
Y As Single)
Picture1.Circle (0, 0), 300, RGB(255, 255, 255)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim a As Long
want2exit = True
moredance = False
For a = icerchi.Count To 1 Step -1
    icerchi(a).AniStop
'    Set cerchi(a) = Nothing
    icerchi.Remove a
Next
End Sub
Sub letsdance()
Dim c As cerchio
Dim a As Long
Dim gt1 As Long
Dim gt2 As Long
While moredance
    gt1 = timeGetTime
    If icerchi.Count > 0 Then
        Picture1.Cls
        For a = icerchi.Count To 1 Step -1
            Set c = icerchi(a)
            If Not c.dead Then
                c.animatebehaviour
            Else
                Set c = Nothing
                icerchi.Remove (a)
            End If
        Next
        gt2 = timeGetTime
        If gt2 - gt1 < 20 Then
            'Debug.Print gt2 - gt1
            Sleep 20 - (gt2 - gt1)
            Picture1.CurrentX = 45
            Picture1.CurrentY = 150
            Picture1.Print "50 fps"
        Else
            Picture1.CurrentX = 45
            Picture1.CurrentY = 150
            Picture1.Print Round(1000 / (gt2 - gt1), 1) & " fps"
        End If
        'Form1.label1 = icerchi.Count
        Picture1.Refresh
    Else
        Sleep 20
    End If
    DoEvents
    'manyDoEvents 1
Wend
End Sub
Private Sub Timer1_Timer()
Dim c As cerchio
Dim c2 As cerchio
gx = Picture1.Width / 2 + Picture1.Width * Sin(ga) / 5
gy = Picture1.Height / 2 + Picture1.Height * Cos(gb) / 5
ga = ga + 0.053
gb = gb + 0.061
Set c = New cerchio
icerchi.Add c
c.setbehaviour pioggia2
c.init gx, gy, 30
Set c2 = c.clone
gx = Picture1.Width / 2 - Picture1.Width * Sin(ga) / 5
gy = Picture1.Height / 2 - Picture1.Height * Cos(gb) / 5
c2.init gx, gy, 30
icerchi.Add c2
'Form1.label1 = icerchi.Count
End Sub
<------------------ ' fine codice della form1
Codice della classe cerchio:
----------------->
Option Explicit
Enum behaviours
    pioggia
    pioggia2
    tunnel
End Enum
Private px As Long
Private py As Long
Private k As Long
Private behaviour As behaviours
Private alfa As Single
Private beta As Single
Private id As Long
Private color As Long
Public run As Boolean
Private X As Long
Private Y As Long
Private r As Single
Public dead As Boolean
Public Sub init(ByVal ix As Long, ByVal iy As Long, ByVal ir As Single)
    dead = False
    X = ix
    Y = iy
    r = ir
    color = getcolorfromradiusbehaviour(r)
    px = X
    py = Y
    k = Form1.Picture1.Width
End Sub
Public Sub draw()
    Form1.Picture1.Circle (X, Y), r, color
End Sub
Public Sub zoom(f As Single)
r = r * f
color = getcolorfromradiusbehaviour(r)
End Sub
Public Sub moveTo(ByVal ix As Long, ByVal iy As Long)
X = ix
Y = iy
px = X
py = Y
End Sub
Public Sub move(ByVal dx As Long, ByVal dy As Long)
X = X + dx
Y = Y + dy
px = X
py = Y
End Sub
Public Sub center()
X = Form1.Picture1.Width / 2
Y = Form1.Picture1.Height / 2
px = X
py = Y
End Sub
Public Sub animatebehaviour()
Select Case behaviour
    Case tunnel
        animate_tunnel
    Case pioggia
        animate_pioggia
    Case pioggia2
        animate_pioggia2
End Select
End Sub
Public Sub animate_tunnel()
    zoom 1.02
    alfa = alfa + 0.042
    beta = beta + 0.053
    X = px + Form1.Picture1.Width * Sin(alfa) * 30 / r  ' / 1450 '(500 / r)
    Y = py + Form1.Picture1.Height * Cos(beta) * 30 / r  ' / 1450 '(500 / r)
    If r > 5000 Then r = 45
    color = getcolorfromradiusbehaviour(r)
    draw
End Sub
Public Sub animate_pioggia()
    'zoom 1.02
    r = r + 15
    If r > 1800 Then r = 1: X = CLng(Rnd * Form1.Picture1.Width): Y =
CLng(Rnd * Form1.Picture1.Height)
    color = getcolorfromradiusbehaviour(r)
    draw
End Sub
Public Sub animate_pioggia2()
    r = r + 15
    If r > 1800 Then dead = True
    color = getcolorfromradiusbehaviour(r)
    draw
End Sub
Private Sub Class_Initialize()
r = 15
color = getcolorfromradiusbehaviour(r)
run = True
id = Form1.icerchi.Count + 1
End Sub
Private Sub Class_Terminate()
run = False
End Sub
Public Sub AniStop()
run = False
End Sub
Public Function clone() As cerchio
' color not cloned
Dim c As New cerchio
c.init X, Y, r
c.setbehaviour behaviour
Set clone = c
End Function
Public Sub setradius(ByVal ir As Single)
    r = ir
    color = getcolorfromradiusbehaviour(r)
End Sub
Function getcolorfromradius(r As Single)
Dim a As Integer
a = 30 + r \ 10
If a > 255 Then a = 255
getcolorfromradius = RGB(a, a, a)
End Function
Function getcolorfromradius2(r As Single)
Dim a As Integer
a = 70 + r \ 10
If a > 255 Then a = 255
getcolorfromradius2 = 2 ^ 24 - RGB(a, a, a)
End Function
Function getcolorfromradiusbehaviour(r As Single) As Long
Select Case behaviour
    Case tunnel
        getcolorfromradiusbehaviour = getcolorfromradius(r)
    Case pioggia
        getcolorfromradiusbehaviour = getcolorfromradius2(r)
    Case pioggia2
        getcolorfromradiusbehaviour = getcolorfromradius2(r)
End Select
End Function
Sub setbehaviour(a As behaviours)
behaviour = a
End Sub
Function getbehaviour() As behaviours
getbehaviour = behaviour
End Function
<------------------ ' fine codice della classe cerchio
termoPilucco, ah ah.

[*termoPilucco* = 
termop...@hotmail.com
 in
news:bsu2t9$1ckhv$
1...@ID-188026.news.uni-berlin.de
] ha scritto:
...
Ebbravo termo! Grazie.
Quanto mi piacerebbe fare 'ste cose invece che noiosissimi gestionali...
Buon anno.

 
Ricorda vagamente questo:
http://www.reallyslick.com/
Skyrocket
;-)
Stasera a Milano non faranno i fuochi, cosi' mi accontentero' di 
Skyrocket (lui ha anche i botti ;-)
Buon Anno!
	maxx
-- 
NOSPAM: Rimuovere i trattini dallo username!
Cut hyphens from my username!

[...]
MITICO! :)
Auguroni
ciaociao

Dunque dunque.. ecco gli ingredienti della torta:
Carino ;-)
Gia' che ci siamo, perche' non renderlo anche ridimensionabile?
Private Sub Form_Resize()
    If (Me.WindowState = vbMinimized) Then Exit Sub
    If (Me.Height < 5775) Then Me.Height = 5775
    If (Me.Width < 6855) Then Me.Width = 6855
    Call Picture1.move(ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight)
    Command1.Top = 60
    Command1.Left = ScaleWidth - Command1.Width - 100
    Command2.Top = 480
    Command2.Left = Command1.Left
End Sub
-- 
ciao, hal
ma diamo a termoPilucco cio' che e' di termoPilucco ;-)

     Call Picture1.move(ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight)
ehm... :)
    Call Picture1.move(ScaleLeft, ScaleTop, ScaleWidth - (Command1.Width +
200), ScaleHeight)
ciao, a.


200), ScaleHeight)
Sei il solito sprecone.... io lasciavo i pulsanti sull'immagine 
per sfruttare tutto lo spazio ;-)
Anzi, pensandoci bene... si potrebbe persino evitare la picture 
box ;-)
-- 
ciao, hal

"termoPilucco"  ha scritto:
Variante interessante, per chi sta ancora lavorando :)
Nel codice della form1 sostituite la sub cosě:
Private Sub Timer1_Timer()
Dim a As Long
Dim c As cerchio
Dim c2 As cerchio
gx = Picture1.Width / 2 + Picture1.Width * Sin(ga) / 5
gy = Picture1.Height / 2 + Picture1.Height * Cos(gb) / 5
ga = ga + 0.053
gb = gb + 0.061
Set c = New cerchio
icerchi.Add c
c.setbehaviour tunnel
c.init gx, gy, 90
End Sub
Nella classe cerchio modificate la sub animate_tunnel cosě:
Public Sub animate_tunnel()
    zoom 1.02
    alfa = alfa + 0.042
    beta = beta + 0.053
    X = px + Form1.Picture1.Width * Sin(alfa) * 30 / r
    Y = py + Form1.Picture1.Height * Cos(beta) * 30 / r
    If r > 5000 Then dead = True
    color = getcolorfromradiusbehaviour(r)
    draw
End Sub
termoPilucco, oh oh.

 ha scritto

mamma mia.
stasera cosa stappi, un trebbianino avanzato ? :P
pensandoci bene puoi evitare anche i command, mettere tutto nel control box,
e usare gettickcount o come si chiama, no? :)
pensandoci benissimo, poi, puoi solo pensarci e visualizzarti il risultato
mentalmente, col che dimostri una mente davvero matematica e non sprechi
codice inutile :)
ciao, a.

codice inutile :)
In realta' mi conviene sprecare cicli di processore piuttosto che
schizzi sinaptici perche' il mio appetito e' piu' costoso della
bolletta dell'enel ;-)
-- 
ciao, hal

 bolletta dell'enel ;-)
gia', solo che tocca usarli tutti e due. la variante di termopilucco mi sta
gia' spingendo a mettere degli option ecc. :)
ciao, a.