Programming Tool Box/SIMS_2.iso/vb_code1/my_mem/mymemry.bas

BASIC Source File | 1992-01-27 | 13KB | 327 lines

'  User Profile Routines (from WINAPI.TXT)
Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer

Sub InitField ()
'Tell user to wait
    MyMemory.MousePointer = HOURGLASS

'Reset status variables
    CurrentSquare = 0
    CurrentSquare1 = 0
    CurrentMoves = 0
    CurrentSolved = 0

'Enter Scene pointers, 2 each on the field
' also Reset squares to closed
    Scene% = 0
    For X% = 0 To (NumberXSquares - 1)
        For Y% = 0 To (NumberYSquares - 1)
            'Reset square to closed
            SquareStatusArray(X%, Y%) = SquareClosed
            'Set scene value
            SquareSceneArray(X%, Y%) = Scene%
            'If half way thru array, repeat scenes
            If Scene% < ((NumberXSquares * NumberYSquares) / 2 - 1) Then
                Scene% = Scene% + 1
            Else
                Scene% = 0
            End If
        Next Y%
    Next X%

'Now Shuffle each address scene 3 times
    Randomize
    For I% = 1 To 3
        For X% = 0 To (NumberXSquares - 1)
            For Y% = 0 To (NumberYSquares - 1)
                RndX% = Int(NumberXSquares * Rnd)
                RndY% = Int(NumberYSquares * Rnd)
                TempScene% = SquareSceneArray(RndX%, RndY%)
                SquareSceneArray(RndX%, RndY%) = SquareSceneArray(X%, Y%)
                SquareSceneArray(X%, Y%) = TempScene%
            Next Y%
        Next X%
    Next I%

'Build Field of squares, X and Y are now pixel offsets
    'Don't paint screen twice, MyMemory Form will be painted
    'if not active by its Form_Paint routine
    If Screen.ActiveForm.Tag = "MyMemory" Then
        For X% = 0 To ((NumberXSquares - 1) * SquareSize) Step SquareSize
            For Y% = 0 To ((NumberYSquares - 1) * SquareSize) Step SquareSize
                BuildSquare X%, Y%
            Next Y%
        Next X%
    End If

'Initialize labels and Tell User we're ready
    FieldStatus = FieldReady
    MyMemory.LabelFieldStatus.Caption = ""
    MyMemory.LabelSquareStatus.Caption = ""
    MoveWord = " move."
    Xb% = (NumberXSquares - 8) / 2
    Yb% = (NumberYSquares - 6) / 2
    If ScoreArray(Xb%, Yb%) = NoScore Then
        BS$ = "None"
    Else
        BS$ = Str$(ScoreArray(Xb%, Yb%))
    End If
    MyMemory.FieldDesc.Caption = "Field is " + LTrim$(Str$(NumberXSquares)) + "x" + LTrim$(Str$(NumberYSquares)) + "    Score to Beat: " + BS$
    MyMemory.MousePointer = DEFAULT

End Sub

Sub BuildSquare (X As Integer, Y As Integer)
'X and Y are pixel offsets
'A button has left and top lighter and right and bottom darker than middle
'outside shading is two pixels wide

    MyMemory.Line (X, Y)-(X + SquareSize - 1, Y), WHITE
    MyMemory.Line (X, Y)-(X, Y + SquareSize - 1), WHITE
    MyMemory.Line (X + SquareSize - 1, Y + SquareSize - 1)-(X + SquareSize - 1, Y), GRAY_MEDIUM
    MyMemory.Line (X + SquareSize - 1, Y + SquareSize - 1)-(X, Y + SquareSize - 1), GRAY_MEDIUM
    MyMemory.Line (X + 1, Y + 1)-(X + SquareSize - 2, Y + 1), WHITE
    MyMemory.Line (X + 1, Y + 1)-(X + 1, Y + SquareSize - 2), WHITE
    MyMemory.Line (X + SquareSize - 2, Y + SquareSize - 2)-(X + SquareSize - 2, Y + 1), GRAY_MEDIUM
    MyMemory.Line (X + SquareSize - 2, Y + SquareSize - 2)-(X + 1, Y + SquareSize - 2), GRAY_MEDIUM
'now clear middle in case an item was displayed
    MyMemory.Line (X + 2, Y + 2)-(X + SquareSize - 3, Y + SquareSize - 3), GRAY_LIGHT, BF
End Sub

Sub ResizeMyMemoryForm ()
'Resize Form according to selected X, Y and squaresize
    XField% = NumberXSquares * SquareSize
    YField% = NumberYSquares * SquareSize
    MyMemory.Width = XField% * TwipsPerPixel + FormBorder

'We need to double label height for small X arrays
    If NumberXSquares < 12 Then
        MyMemory.LabelFieldStatus.Height = FormLabel * 2
        MyMemory.LabelSquareStatus.Height = FormLabel * 2
    ElseIf NumberXSquares > 10 Then
        MyMemory.LabelFieldStatus.Height = FormLabel
        MyMemory.LabelSquareStatus.Height = FormLabel
    End If

    If NumberXSquares = 8 And SquareSize = 32 Then
        MyMemory.FieldDesc.Height = FormLabel - 5
        MyMemory.FieldDesc.FontSize = 9.75
    Else
        MyMemory.FieldDesc.Height = FormLabel
        MyMemory.FieldDesc.FontSize = 12
    End If

'After determining label height we can set form height
    MyMemory.Height = (YField% + MyMemory.LabelFieldStatus.Height + MyMemory.FieldDesc.Height) * TwipsPerPixel + FormHeader

'Now set labels in correct position
    Label2L% = XField% / 2

    MyMemory.FieldDesc.Top = YField%
    MyMemory.FieldDesc.Left = 0
    MyMemory.FieldDesc.Width = XField%

    MyMemory.LabelFieldStatus.Top = YField% + MyMemory.FieldDesc.Height
    MyMemory.LabelFieldStatus.Left = Label2L%
    MyMemory.LabelFieldStatus.Width = Label2L%

    MyMemory.LabelSquareStatus.Top = YField% + MyMemory.FieldDesc.Height
    MyMemory.LabelSquareStatus.Left = 0
    MyMemory.LabelSquareStatus.Width = Label2L%

End Sub

Sub GetMyProfile ()

    Temp1% = GetPrivateProfileInt(SelectHeader, "NumberXSquares", -1, IniFile)
    Temp2% = GetPrivateProfileInt(SelectHeader, "NumberYSquares", -1, IniFile)
    Temp3% = GetPrivateProfileInt(SelectHeader, "SquareSize", -1, IniFile)
    Temp4% = GetPrivateProfileInt(SelectHeader, "Timer", -1, IniFile)
    Temp5% = GetPrivateProfileInt(SelectHeader, "SaveBestScore", -1, IniFile)

    GetScores

    Msg$ = "A Profile has been found in: " + IniFile + NL + NL
    Msg$ = Msg$ + "The following settings are asked for:" + NL
    Msg$ = Msg$ + "  NumberXSquares = " + Str$(Temp1%) + NL
    Msg$ = Msg$ + "  NumberYSquares = " + Str$(Temp2%) + NL
    Msg$ = Msg$ + "  SquareSize = " + Str$(Temp3%) + NL
    Msg$ = Msg$ + "  Timer = " + Str$(Temp4%) + NL
    Msg$ = Msg$ + "  SaveBestScore = " + Str$(Temp5%)
    MsgBox Msg$, MB_OK, "MyMemory Game Setup"

    PF$ = "Profile Error"
    TempE% = FALSE

    Select Case Temp1%
        Case 8, 10, 12, 14, 16, 18
            NumberXSquares = Temp1%
        Case Else
            TempE% = TRUE
    End Select

    Select Case Temp2%
        Case 6, 8, 10
            NumberYSquares = Temp2%
        Case Else
            TempE% = TRUE
    End Select

    Select Case Temp3%
        Case 32, 40, 48
            SquareSize = Temp3%
        Case Else
            TempE% = TRUE
    End Select

    Select Case Temp4%
        Case 1 To 5
            SetTimer = Temp4%
        Case Else
            TempE% = TRUE
    End Select

    Select Case Temp5%
        Case CHECKED, UNCHECKED
            SaveScore = Temp5%
        Case Else
            TempE% = TRUE
    End Select

    If TempE% = TRUE Then
        'Indicate change so we can correct setup on exit
        SaveFileChange = TRUE
        'Default Values already in variables
        MsgBox "Illegal value in profile has been reset to default", MB_OK, PF$
    End If

'Check for valid combinations

    Msg1$ = "Invalid Field Size resetting to defaults"

    If NumberXSquares < 12 Then
        FieldY% = (FormLabel * 3) + (FormHeader / TwipsPerPixel)
    Else
        FieldY% = (FormLabel * 2) + (FormHeader / TwipsPerPixel)
    End If

    If (SquareSize * NumberXSquares >= ScreenPixelSizeX) Or (SquareSize * NumberYSquares + FieldY% >= ScreenPixelSizeY) Then
        SquareSize = DefaultSquareSize
        NumberXSquares = DefaultXSquares
        NumberYSquares = DefaultYSquares
        MsgBox Msg1$, MB_OK, PF$
    End If

End Sub

Sub SaveMyProfile ()

    If SaveFile = SelectSaveFileNo Or SaveFileChange = FALSE Then Exit Sub

    Temp1% = WritePrivateProfileString(SelectHeader, "NumberXSquares", Str$(NumberXSquares), IniFile)
    Temp2% = WritePrivateProfileString(SelectHeader, "NumberYSquares", Str$(NumberYSquares), IniFile)
    Temp3% = WritePrivateProfileString(SelectHeader, "SquareSize", Str$(SquareSize), IniFile)
    Temp4% = WritePrivateProfileString(SelectHeader, "Timer", Str$(SetTimer), IniFile)
    Temp5% = WritePrivateProfileString(SelectHeader, "SaveBestScore", Str$(SaveScore), IniFile)

    If Temp1% = 0 Or Temp2% = 0 Or Temp3% = 0 Or Temp4% = 0 Or Temp5% = 0 Then
        Msg$ = "Error Writing Profile - Check -> " + IniFile + NL
        MsgBox Msg$, MB_OK, "Profile Error"
    End If

End Sub

Sub GetScores ()
'Get any scores from ini file
    For X% = 8 To 18 Step 2
        For Y% = 6 To 10 Step 2
            Xa% = (X% - 8) / 2
            Ya% = (Y% - 6) / 2
            KeyWord$ = "Score" + LTrim$(Str$(X%)) + "x" + LTrim$(Str$(Y%))
            ScoreArray(Xa%, Ya%) = GetPrivateProfileInt(SelectHeader, KeyWord$, NoScore, IniFile)
            If ScoreArray(Xa%, Ya%) = 0 Then ScoreArray(Xa%, Ya%) = NoScore
            KeyValue$ = Space$(255)
            KeyWord$ = KeyWord$ + "Name"
            MyGet% = GetPrivateProfileString(SelectHeader, KeyWord$, "N/A", KeyValue$, Len(KeyValue$), IniFile)
            ScoreArrayName(Xa%, Ya%) = Mid$(KeyValue$, 1, MyGet%)
        Next Y%
    Next X%
End Sub

Sub SaveMyScore ()

'Get array address for item
    Xa% = (NumberXSquares - 8) / 2
    Ya% = (NumberYSquares - 6) / 2

'If old score, compare to new score
    If CurrentMoves >= ScoreArray(Xa%, Ya%) Then Exit Sub
    ScoreArray(Xa%, Ya%) = CurrentMoves

'See if scores being saved
    If SaveScore <> CHECKED Then Exit Sub

'Now get name of person winning game
    Msg$ = "You've Beaten the last Best Score!" + NL + NL + "Using " + Str$(CurrentMoves) + MoveWord
    Msg$ = Msg$ + NL + NL + "Please enter your name: "
    ScoreArrayName(Xa%, Ya%) = InputBox$(Msg$, "Your're a Winner!", "Name")

'If new score beats old score or no old score then save new score
    KeyWord$ = "Score" + LTrim$(Str$(NumberXSquares%)) + "x" + LTrim$(Str$(NumberYSquares%))
    Temp% = WritePrivateProfileString(SelectHeader, KeyWord$, Str$(ScoreArray(Xa%, Ya%)), IniFile)
    KeyWord$ = KeyWord$ + "Name"
    Temp1% = WritePrivateProfileString(SelectHeader, KeyWord$, ScoreArrayName(Xa%, Ya%), IniFile)
    If Temp% = 0 Or Temp1% = 0 Then
        MsgBox "Error Writing Scores", MB_OK, "Profile Error"
    End If

End Sub

Sub MyProfile ()
    KeyWord$ = "NumberXSquares"
    If GetPrivateProfileInt(SelectHeader, KeyWord$, -1, SelectMy) <> -1 Then
        SaveFile = SelectSaveFileMy
        IniFile = SelectMy
        GetMyProfile
    ElseIf GetPrivateProfileInt(SelectHeader, KeyWord$, -1, SelectWEP) <> -1 Then
        SaveFile = SelectSaveFileWEP
        IniFile = SelectWEP
        GetMyProfile
    ElseIf GetPrivateProfileInt(SelectHeader, KeyWord$, -1, SelectWIN) <> -1 Then
        SaveFile = SelectSaveFileWIN
        IniFile = SelectWIN
        GetMyProfile
    Else
        SaveFile = SelectSaveFileNo
    End If
    SaveFileStart = SaveFile

End Sub

Sub ClearAllScores ()
    MousePointer = HOURGLASS
    For I% = 0 To 5
        For J% = 0 To 2
            If ScoreArray(I%, J%) <> NoScore Then
                ScoreArray(I%, J%) = NoScore
                If SaveFile <> SelectSaveFileNo Then
                    ScoreArrayName(I%, J%) = ""
                    KeyWord$ = "Score" + LTrim$(Str$(I% * 2 + 8)) + "x" + LTrim$(Str$(J% * 2 + 6))
                    Temp% = WritePrivateProfileString(SelectHeader, KeyWord$, "", IniFile)
                    KeyWord$ = KeyWord$ + "Name"
                    Temp1% = WritePrivateProfileString(SelectHeader, KeyWord$, "", IniFile)
                    If Temp% = 0 Or Temp1% = 0 Then
                        MsgBox "Error Writing Scores", MB_OK, "Profile Error"
                        Exit Sub
                    End If
                End If
            End If
        Next J%
    Next I%
    MyMemory.FieldDesc.Caption = "Field is " + LTrim$(Str$(NumberXSquares)) + "x" + LTrim$(Str$(NumberYSquares)) + "    Score to Beat: None"
    MousePointer = DEFAULT
End Sub