Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/score/score1.frm

Visual Basic Form | 1995-06-17 | 10.5 KB | 330 lines

VERSION 2.00
Begin Form frmScores
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "High Scores"
   ClientHeight    =   3765
   ClientLeft      =   2850
   ClientTop       =   1515
   ClientWidth     =   4230
   ControlBox      =   0   'False
   Height          =   4170
   Icon            =   SCORE1.FRX:0000
   Left            =   2790
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3765
   ScaleWidth      =   4230
   Top             =   1170
   Width           =   4350
   Begin Timer Timer1
      Interval        =   3000
      Left            =   3420
      Top             =   3240
   End
   Begin CommandButton btnNewScore
      Caption         =   "&OK"
      Height          =   375
      Left            =   1500
      TabIndex        =   5
      Top             =   3240
      Width           =   1185
   End
   Begin TextBox txtScore
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   360
      Left            =   2130
      TabIndex        =   3
      TabStop         =   0   'False
      Text            =   "Text2"
      Top             =   2820
      Width           =   1965
   End
   Begin CommandButton btnOK
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   1500
      TabIndex        =   4
      Top             =   3480
      Width           =   1185
   End
   Begin TextBox txtName
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   360
      Left            =   120
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   2820
      Width           =   1905
   End
   Begin ListBox lstScores
      BackColor       =   &H00C0C0C0&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H000000FF&
      Height          =   1230
      Left            =   2160
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   1080
      Width           =   1965
   End
   Begin ListBox lstNames
      BackColor       =   &H00C0C0C0&
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H000000FF&
      Height          =   1230
      Left            =   120
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   1080
      Width           =   1905
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "SCORES"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   195
      Left            =   2160
      TabIndex        =   8
      Top             =   840
      Width           =   1875
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "PLAYERS"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   9.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   195
      Left            =   120
      TabIndex        =   7
      Top             =   840
      Width           =   1875
   End
   Begin Image Image3
      Height          =   720
      Left            =   0
      Picture         =   SCORE1.FRX:0302
      Top             =   5400
      Width           =   4230
   End
   Begin Image Image1
      Height          =   720
      Left            =   0
      Picture         =   SCORE1.FRX:1E7C
      Top             =   3840
      Width           =   4230
   End
   Begin Image Image2
      Height          =   720
      Left            =   0
      Picture         =   SCORE1.FRX:39F6
      Top             =   4620
      Width           =   4230
   End
   Begin Label lblInfo
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Congatulations!  You've just achieved a New High Score!  Enter your name below:"
      ForeColor       =   &H00FF0000&
      Height          =   405
      Left            =   180
      TabIndex        =   6
      Top             =   2400
      Width           =   3765
   End
   Begin Image imgMain
      Height          =   720
      Left            =   0
      Picture         =   SCORE1.FRX:5570
      Top             =   30
      Width           =   4230
   End
Option Explicit
'------------------------------------------------------------
' SCORE1.FRM
' This form is dependent on file SCORE1.BAS.
'------------------------------------------------------------
' Windows API call used to send a message to a window.  In
' our case, we use it to send a message to a text box control
' that it should be read-only.
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
' Constants used to make a text box read-only.
Const WM_USER = &H400
Const EM_SETREADONLY = (WM_USER + 31)
Sub btnNewScore_Click ()
'------------------------------------------------------------
' When this button is pressed, save the new player name and
' score, then hide the text boxes and button used to enter
' the player's name, and resize the form.
'------------------------------------------------------------
    ' Save all high scores back to the .INI file.
    AddScoreAndSave txtName, txtScore
    DisplayScores
    SetForDisplay
End Sub
Sub btnOK_Click ()
'------------------------------------------------------------
' Close the frmScores window when this button is pushed.
'------------------------------------------------------------
    Timer1.Enabled = False
    Timer1.Interval = 0
    DoEvents
    Unload Me
End Sub
Sub DisplayScores ()
'------------------------------------------------------------
' Display the scores and player names from the Hi() array
' into the form's list controls.
'------------------------------------------------------------
Dim i As Integer

    If Num_HiScores > 0 Then
    ' Empty the lists.
    lstNames.Clear
    lstScores.Clear
    ' Display the high scores in the list boxes.
    For i = 1 To Num_HiScores
        lstNames.AddItem Hi(i).Name
        lstScores.AddItem Format$(Hi(i).Score)
    Next
    End If
End Sub
Sub Form_Load ()
'------------------------------------------------------------
' When the form is loaded, center it and display the current
' high scores.
'------------------------------------------------------------
Dim rc As Long
    ' Center the form on the screen.
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.Top = (Screen.Height - Me.Height) \ 2
    Me.Caption = gGameTitle
    ' Display current high scores.
    DisplayScores
    If gDisplayOnly Then
    SetForDisplay
    Else
    btnOK.Visible = False
    btnNewScore.Default = True
    ' Clear text field to let player enter their name.
    txtName = ""
    txtName.MaxLength = 15
    txtScore = Format$(gNewScore)
    rc = SendMessage(txtScore.hWnd, EM_SETREADONLY, 1, 0)
    End If
End Sub
Sub Form_Paint ()
    Make3D Me, lstNames, 1
    Make3D Me, lstScores, 1
    If txtName.Visible Then
    Make3D Me, txtName, 0
    Make3D Me, txtScore, 0
    End If
End Sub
Sub Make3D (pic As Form, ctl As Control, ByVal BorderStyle As Integer)
'--------------------------------------------------
' Wrap a 3D effect around a control on a form.
'--------------------------------------------------
Dim AdjustX As Integer, AdjustY As Integer
Dim RightSide As Single
Dim BW As Integer, BorderWidth As Integer
Dim LeftTopColor As Long, RightBottomColor As Long
Dim i As Integer
' Color Constants
Const DARK_GRAY = &H808080
Const WHITE = &HFFFFFF
Const BLACK = &H0
    If Not ctl.Visible Then Exit Sub
    AdjustX = Screen.TwipsPerPixelX
    AdjustY = Screen.TwipsPerPixelY
    BorderWidth = 1
    Select Case BorderStyle
    Case 0: ' Inset
        LeftTopColor = DARK_GRAY
        RightBottomColor = WHITE
    Case 1: ' Raised
        LeftTopColor = WHITE
        RightBottomColor = DARK_GRAY
    End Select
    ' Set the top shading line.
    For BW = 1 To BorderWidth
    ' Top
    pic.CurrentX = ctl.Left - (AdjustX * BW)
    pic.CurrentY = ctl.Top - (AdjustY * BW)
    pic.Line -(ctl.Left + ctl.Width + (AdjustX * (BW - 1)), ctl.Top - (AdjustY * BW)), LeftTopColor
    ' Right
    pic.Line -(ctl.Left + ctl.Width + (AdjustX * (BW - 1)), ctl.Top + ctl.Height + (AdjustY * (BW - 1))), RightBottomColor
    ' Bottom
    pic.Line -(ctl.Left - (AdjustX * BW), ctl.Top + ctl.Height + (AdjustY * (BW - 1))), RightBottomColor
    ' Left
    pic.Line -(ctl.Left - (AdjustX * BW), ctl.Top - (AdjustY * BW)), LeftTopColor
    Next
End Sub
Sub SetForDisplay ()
    ' Hide "New Hi" controls...
    lblInfo.Visible = False
    txtName.Visible = False
    txtScore.Visible = False
    btnNewScore.Visible = False
    ' Adjust the OK button position and Window Height.
    btnOK.Visible = True
    btnOK.Top = lblInfo.Top
    btnOK.Default = True
    Me.Height = btnNewScore.Top + 45
    Me.Refresh
End Sub
Sub Timer1_Timer ()
Static InSub As Integer
Dim StartTime As Single
Dim i As Integer
    If InSub Then Exit Sub
    InSub = True
    For i = 1 To 4
    imgMain.Picture = Image2.Picture
    StartTime = Timer
    Do While (Timer - StartTime) < .1
        DoEvents
    Loop
    imgMain.Picture = Image3.Picture
    StartTime = Timer
    Do While (Timer - StartTime) < .1
        DoEvents
    Loop
    Next
    imgMain.Picture = Image1.Picture
    InSub = False
End Sub