home *** CD-ROM | disk | FTP | other *** search
' 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 
