Keskustelu: Koodit: VB6: Monta spriteä

Option Explicit

'Muuttujat

Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Type SpriteType  'Pelinapin yms. Muuttuja määrittely
    Value As Integer    ' Arvo
    On As Boolean       ' On/Off
    X As Integer        ' X-paikka ruudulla
    Y As Integer        ' Y-paikka
    Z As Integer        ' Z-paikka
    VX As Integer       ' Vanha X
    VY As Integer       ' Vanha Y
    VZ As Integer       ' Vanha Z
    SX As Integer       ' Lisäyslaskuri
    SY As Integer
    Temp As Integer     ' Väliaikainen tieto
    'Kuvankäsittelyyn liittyvät muuttujat
    Old As Integer      ' Mikä spitren vanha kuva käytössä
    Mask As Integer     ' Mikä Spriten Maski käytössä
    ScaleX As Integer   ' Spriten X-koko
    ScaleY As Integer   ' Spriten Y-koko
End Type

Global Sprite(0 To 5) As SpriteType
Global zz&


Function Rand(R As Integer)
    Randomize Timer
    Rand = Int(Rnd(1) * R)
    DoEvents
End Function

Sub PalautaVanha(I As SpriteType, X As Integer)
If I.On Then
        'Palautetaan
        zz = BitBlt(PL!pBuffer1.hDC, I.VX, I.VY, I.ScaleX, I.ScaleY, PL!pVanha(X).hDC, 0, 0, vbSrcCopy)
End If
End Sub

Sub OtaKuvatalteen(I As SpriteType, X%)
If I.On Then
      If I.VX <> -100 Then
        'otetaan kuva talteen (Nappi)
        zz = BitBlt(PL!pVanha(X).hDC, 0, 0, I.ScaleX, I.ScaleY, PL!pBuffer1.hDC, I.X, I.Y, vbSrcCopy)
      Else
        'Haetaan ensimmäinen Kuva puuhtaalta pelipöydältä
        zz = BitBlt(PL!pVanha(X).hDC, 0, 0, I.ScaleX, I.ScaleY, PL!pBuffer2.hDC, I.X, I.Y, vbSrcCopy)
      End If
      PL!pVanha(X).Refresh
End If
End Sub

Sub PiirräSprite(I As SpriteType, X%, Y%)
Dim J%
   If I.On Then
        If I.VX <> -100 Then
        'Piirretään
        zz = BitBlt(PL!pBuffer1.hDC, I.X, I.Y, I.ScaleX, I.ScaleY, PL!pMask(Y).hDC, 0, 0, vbSrcAnd)
        zz = BitBlt(PL!pBuffer1.hDC, I.X, I.Y, I.ScaleX, I.ScaleY, PL!pSprite(X).hDC, 0, 0, vbSrcInvert)
        End If
        I.VX = I.X: I.VY = I.Y
    End If
End Sub

Function OnkoTörmäys(X1%, Y1%, X2%, Y2%, SX%, SY%) As Boolean
    If X1 + SX > X2 Then
        If X1 < X2 + SX Then
            If Y1 + SY > Y2 Then
                If Y1 < Y2 + SY Then
                    OnkoTörmäys = True
                End If
            End If
        End If
        End If
End Function

Option Explicit

Private Sub Form_Load()
Dim I%, J%, T As Boolean
    For I = 0 To 5
    If I < 5 Then
        Sprite(I).X = Rand(pKuva.Width)
        Sprite(I).Y = Rand(pKuva.Height)
    End If
    Do
    Sprite(I).SX = (Rand(2) - 1) * Rand(3)
    Sprite(I).SY = (Rand(2) - 1) * Rand(3)
    Loop Until Sprite(I).SX <> 0 And Sprite(I).SY <> 0
    Sprite(I).Z = 1
    Sprite(I).On = True
    Sprite(I).Value = I
    Sprite(I).Mask = 0
    Sprite(I).Old = I
    Sprite(I).VX = -100
    Sprite(I).ScaleX = pSprite(I).ScaleWidth
    Sprite(I).ScaleY = pSprite(I).ScaleHeight

    Next I
    'Asetetaan olio
    Sprite(5).Mask = 1
    Sprite(5).SX = Rand(2) - 1
    Sprite(5).SY = Rand(2) - 1
    Do
        Sprite(5).X = Rand(pKuva.Width)
        Sprite(5).Y = Rand(pKuva.Height)
        For J = 0 To 4 'Jos törmäys sijoitetaan olio uudestaan
            T = OnkoTörmäys(Sprite(5).X, Sprite(5).Y, Sprite(J).X, Sprite(J).Y, Sprite(5).ScaleX, Sprite(5).ScaleY)
            If T Then Exit For
        Next J
    Loop Until Not T
    Timer1.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

Private Sub Timer1_Timer()
Dim I%, J%
    Timer1.Enabled = False
    For I = 0 To 5  'Palautetaan kaikki vanhat
        PalautaVanha Sprite(I), Sprite(I).Old
    Next I

    For I = 0 To 5
        Sprite(I).X = Sprite(I).X + Sprite(I).SX
        For J = 0 To 5
            If I <> J Then
            If OnkoTörmäys(Sprite(J).X, Sprite(J).Y, Sprite(I).X, Sprite(I).Y, Sprite(J).ScaleX, Sprite(J).ScaleY) Then
            Sprite(I).SX = -Sprite(I).SX
            Sprite(I).X = Sprite(I).X + Sprite(I).SX
            End If
            End If
        Next J
        If Sprite(I).X + Sprite(I).ScaleX > pKuva.Width Then Sprite(I).SX = -1: Sprite(I).X = Sprite(I).X - 1
        If Sprite(I).X < 0 Then Sprite(I).SX = 1: Sprite(I).X = Sprite(I).X + 1
        Sprite(I).Y = Sprite(I).Y + Sprite(I).SY
        'Onko spritet tärmänneet toisiinsa?
        For J = 0 To 5
            If J <> I Then
            If OnkoTörmäys(Sprite(J).X, Sprite(J).Y, Sprite(I).X, Sprite(I).Y, Sprite(J).ScaleX, Sprite(J).ScaleY) Then
            Sprite(I).SY = -Sprite(I).SY
            Sprite(I).Y = Sprite(I).Y + Sprite(I).SY
            End If
            End If
        Next J
        If Sprite(I).Y + Sprite(I).ScaleY > pKuva.Height Then Sprite(I).SY = -1: Sprite(I).Y = Sprite(I).Y - 1
        If Sprite(I).Y < 0 Then Sprite(I).SY = 1: Sprite(I).Y = Sprite(I).Y + 1
    Next I

    For I = 0 To 5  'Annetaan kaikille "puhdas" kuva (Ilman toisia spritejä)
        OtaKuvatalteen Sprite(I), Sprite(I).Old
    Next I
    For I = 0 To 5  'Piirretään kuvat
        PiirräSprite Sprite(I), Sprite(I).Value, Sprite(I).Mask
    Next I
zz = BitBlt(PL!pKuva.hDC, 0, 0, PL!pKuva.ScaleWidth, PL!pKuva.ScaleHeight, PL!pBuffer1.hDC, 0, 0, vbSrcCopy)
    PL!pKuva.Refresh
    'PL!pBuffer1.Refresh 'Ota kommentti merkki pois, niin näet Bufferin
    Timer1.Enabled = True
End Sub