VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsCredits"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' DirectDraw Surfaces
Private msCredits As DirectDrawSurface7
Private msCursor As DirectDrawSurface7

' Mouse
Private bPressed As Boolean

Private Type udtCreditLine
    Text As String
    Color As Long
    Bold As Boolean
End Type

Private tCredits() As udtCreditLine
Public Sub Draw()
    Dim rSrc As RECT
    Dim Font As IFont
    Dim lYPos As Long
    Dim lK As Long
    Dim lX As Long
    Dim lY As Long
    
    ' Draw menu
    gameMenu.Draw True
    
    ' Draw Credits
    lX = (mrScreen.Right - 320) / 2
    lY = (mrScreen.Bottom - 200) / 2
    rSrc = FillRect(0, 0, 320, 200)
    msBack.BltFast lX, lY, msCredits, rSrc, DDBLTFAST_WAIT
    
    ' Draw credits
    Set Font = frmMain.Font
    lYPos = lY + 45
    
    For lK = 0 To 7
        If tCredits(lK).Text = "" Then
            lYPos = lYPos + 10
        Else
            msBack.SetForeColor tCredits(lK).Color
            Font.Bold = tCredits(lK).Bold
            msBack.SetFont Font
            msBack.DrawText lX + 15, lYPos, tCredits(lK).Text, False
        
            lYPos = lYPos + 20
        End If
    Next lK
    
    ' Draw Cursor
    rSrc = FillRect(0, 0, 16, 16)
    If lMouseX + 16 > mrScreen.Right Then rSrc.Right = mrScreen.Right - lMouseX
    If lMouseY + 16 > mrScreen.Bottom Then rSrc.Bottom = mrScreen.Bottom - lMouseY
    
    msBack.BltFast lMouseX, lMouseY, msCursor, rSrc, DDBLTFAST_SRCCOLORKEY
End Sub

Public Sub Initialize()
    ' Reset Mouse button
    bPressed = False
    
    ' Set credits
    ReDim tCredits(7)
    
    tCredits(0).Text = "Graphics, Sound and programming"
    tCredits(0).Color = RGB(153, 170, 202)
    tCredits(0).Bold = True

    tCredits(1).Text = "    Mark van Renswoude (Powersoft Programming)"
    tCredits(1).Color = RGB(255, 255, 255)
    tCredits(1).Bold = False
    
    tCredits(2).Text = ""
    tCredits(2).Color = 0
    tCredits(2).Bold = False
    
    tCredits(3).Text = "Original game concept"
    tCredits(3).Color = RGB(153, 170, 202)
    tCredits(3).Bold = True
    
    tCredits(4).Text = "    t_dawolf"
    tCredits(4).Color = RGB(255, 255, 255)
    tCredits(4).Bold = False
    
    tCredits(5).Text = ""
    tCredits(5).Color = 0
    tCredits(5).Bold = False
    
    tCredits(6).Text = "In-game Graphics and Sound"
    tCredits(6).Color = RGB(153, 170, 202)
    tCredits(6).Bold = True

    tCredits(7).Text = "    Fox McCloud"
    tCredits(7).Color = RGB(255, 255, 255)
    tCredits(7).Bold = False
End Sub


Public Sub LoadBuffers()
    ' We haven't got any, but the sub should
    ' stay here, else you'll get errors when
    ' oStage.LoadBuffers is called...
End Sub

Public Sub LoadSurfaces()
    If Not msCursor Is Nothing Then Exit Sub
    
    ' Load Highscore
    Set msCredits = modDX.LoadSurface(App.Path & "\graphics\credits.bmp", 320, 200, None)
    
    ' Load Cursor
    Set msCursor = modDX.LoadSurface(App.Path & "\graphics\menucursor.bmp", 16, 16, Magenta)
End Sub



Private Sub MouseClicked()
    ' Go back to menu
    Set oStage = gameMenu
End Sub

Public Sub Move()
    ' Get Mouse information
    Call modDX.GetMouseInfo(mdCursorSens, 0, 0, mrScreen.Right, mrScreen.Bottom)
    
    ' Check buttons
    If bMouseBtn(0) Then
        If bPressed = False Then
            ' Set to pressed
            bPressed = True
        End If
    Else
        ' Check if it was pressed before
        If bPressed Then
            bPressed = False
            Call MouseClicked
        End If
    End If
    
    ' Move DX animation
    gameMenu.Move True
End Sub

Private Sub Class_Terminate()
    ' Destroy surfaces and buffers
    Set msCredits = Nothing
    Set msCursor = Nothing
End Sub


