VERSION 5.00 Begin VB.Form Form1 BorderStyle = 4 'Fixed ToolWindow Caption = "FlashNet - Toki" ClientHeight = 3360 ClientLeft = 2715 ClientTop = 1695 ClientWidth = 3000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False PaletteMode = 1 'UseZOrder ScaleHeight = 224 ScaleMode = 3 'Pixel ScaleWidth = 200 ShowInTaskbar = 0 'False Begin VB.Timer timWake Enabled = 0 'False Interval = 20000 Left = 420 Top = 5760 End Begin VB.PictureBox picPlate Height = 555 Index = 3 Left = 540 ScaleHeight = 495 ScaleWidth = 5595 TabIndex = 20 Top = 6420 Width = 5655 End Begin VB.PictureBox Picture1 Height = 3195 Left = 1440 ScaleHeight = 3135 ScaleWidth = 2415 TabIndex = 0 Top = 3960 Visible = 0 'False Width = 2475 Begin VB.Label lblFeel Caption = "0" Height = 255 Index = 0 Left = 240 TabIndex = 9 Top = 300 Width = 1395 End Begin VB.Label lblFeel Caption = "0" Height = 255 Index = 1 Left = 240 TabIndex = 8 Top = 600 Width = 1395 End Begin VB.Label lblFeel Caption = "0" Height = 255 Index = 2 Left = 240 TabIndex = 7 Top = 900 Width = 1395 End Begin VB.Label lblFeel Caption = "0" Height = 255 Index = 3 Left = 240 TabIndex = 6 Top = 1200 Width = 1395 End Begin VB.Label lblFeel Caption = "0" Height = 255 Index = 4 Left = 240 TabIndex = 5 Top = 1500 Width = 1395 End Begin VB.Label lblFeel Caption = "0" Height = 255 Index = 5 Left = 240 TabIndex = 4 Top = 1800 Width = 1395 End Begin VB.Label lblFeel Caption = "0" Height = 255 Index = 6 Left = 240 TabIndex = 3 Top = 2040 Width = 1395 End Begin VB.Label lblFeel Caption = "0" Height = 255 Index = 7 Left = 240 TabIndex = 2 Top = 2340 Width = 1395 End Begin VB.Label lblFeel Caption = "0" Height = 255 Index = 8 Left = 240 TabIndex = 1 Top = 2640 Width = 1395 End End Begin VB.Timer timPup Enabled = 0 'False Interval = 1000 Left = -60 Top = 5760 End Begin VB.PictureBox picPlate Appearance = 0 'Flat ForeColor = &H80000008& Height = 2775 Index = 1 Left = 120 ScaleHeight = 183 ScaleMode = 3 'Pixel ScaleWidth = 183 TabIndex = 34 Top = 120 Width = 2775 Begin VB.Image imgFrame Height = 2055 Left = 360 Top = 120 Width = 1935 End End Begin VB.PictureBox picPlate Appearance = 0 'Flat ForeColor = &H80000008& Height = 2775 Index = 2 Left = 120 ScaleHeight = 183 ScaleMode = 3 'Pixel ScaleWidth = 183 TabIndex = 19 Top = 120 Width = 2775 Begin VB.PictureBox picIndex AutoRedraw = -1 'True AutoSize = -1 'True BackColor = &H00004080& BorderStyle = 0 'None Height = 225 Index = 2 Left = 120 ScaleHeight = 15 ScaleMode = 3 'Pixel ScaleWidth = 166 TabIndex = 25 Top = 2160 Width = 2490 Begin VB.PictureBox picMark Appearance = 0 'Flat AutoRedraw = -1 'True BackColor = &H00000000& BorderStyle = 0 'None ForeColor = &H80000008& Height = 315 Index = 2 Left = 1440 ScaleHeight = 21 ScaleMode = 3 'Pixel ScaleWidth = 9 TabIndex = 26 Top = 0 Width = 135 End End Begin VB.PictureBox picIndex AutoRedraw = -1 'True AutoSize = -1 'True BackColor = &H0000C0C0& BorderStyle = 0 'None Height = 225 Index = 1 Left = 120 ScaleHeight = 15 ScaleMode = 3 'Pixel ScaleWidth = 166 TabIndex = 23 Top = 1560 Width = 2490 Begin VB.PictureBox picMark Appearance = 0 'Flat AutoRedraw = -1 'True BackColor = &H00000000& BorderStyle = 0 'None ForeColor = &H80000008& Height = 315 Index = 1 Left = 1440 ScaleHeight = 21 ScaleMode = 3 'Pixel ScaleWidth = 9 TabIndex = 24 Top = 0 Width = 135 End End Begin VB.PictureBox picIndex AutoRedraw = -1 'True AutoSize = -1 'True BackColor = &H000040C0& BorderStyle = 0 'None Height = 225 Index = 0 Left = 120 ScaleHeight = 15 ScaleMode = 3 'Pixel ScaleWidth = 166 TabIndex = 21 Top = 960 Width = 2490 Begin VB.PictureBox picMark Appearance = 0 'Flat AutoRedraw = -1 'True BackColor = &H00000000& BorderStyle = 0 'None ForeColor = &H80000008& Height = 315 Index = 0 Left = 1440 ScaleHeight = 21 ScaleMode = 3 'Pixel ScaleWidth = 9 TabIndex = 22 Top = 0 Width = 135 End End Begin VB.Label lblAge Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00E0E0E0& BorderStyle = 1 'Fixed Single Caption = "0.0" ForeColor = &H80000008& Height = 255 Index = 1 Left = 1680 TabIndex = 33 Top = 240 Width = 795 End Begin VB.Label lblAge Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00E0E0E0& BorderStyle = 1 'Fixed Single Caption = "0.0" ForeColor = &H80000008& Height = 255 Index = 0 Left = 360 TabIndex = 32 Top = 240 Width = 795 End Begin VB.Label lblType Alignment = 2 'Center BackColor = &H00C0E0FF& BackStyle = 0 'Transparent Caption = "Weight" BeginProperty Font Name = "Times New Roman" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 4 Left = 1680 TabIndex = 31 Top = 0 Width = 795 End Begin VB.Label lblType Alignment = 2 'Center BackColor = &H00C0E0FF& BackStyle = 0 'Transparent Caption = "Age" BeginProperty Font Name = "Times New Roman" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 3 Left = 360 TabIndex = 30 Top = 0 Width = 855 End Begin VB.Label lblType Alignment = 2 'Center BackColor = &H00C0E0FF& BackStyle = 0 'Transparent Caption = "Hunger" Height = 195 Index = 0 Left = 120 TabIndex = 29 Top = 720 Width = 2535 End Begin VB.Label lblType Alignment = 2 'Center BackColor = &H00C0E0FF& BackStyle = 0 'Transparent Caption = "Happiness" Height = 195 Index = 1 Left = 120 TabIndex = 28 Top = 1320 Width = 2535 End Begin VB.Label lblType Alignment = 2 'Center BackColor = &H00C0E0FF& BackStyle = 0 'Transparent Caption = "Discipline" Height = 255 Index = 2 Left = 120 TabIndex = 27 Top = 1920 Width = 2535 End End Begin VB.PictureBox picPlate Appearance = 0 'Flat ForeColor = &H80000008& Height = 2775 Index = 0 Left = 120 ScaleHeight = 183 ScaleMode = 3 'Pixel ScaleWidth = 183 TabIndex = 10 Top = 120 Width = 2775 Begin VB.PictureBox picBut Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None ForeColor = &H80000008& Height = 480 Index = 3 Left = 2040 Picture = "Form1.frx":0000 ScaleHeight = 480 ScaleWidth = 480 TabIndex = 18 Top = 240 Visible = 0 'False Width = 480 End Begin VB.PictureBox picBut Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None ForeColor = &H80000008& Height = 480 Index = 2 Left = 1440 Picture = "Form1.frx":0442 ScaleHeight = 480 ScaleWidth = 480 TabIndex = 17 Top = 720 Visible = 0 'False Width = 480 End Begin VB.PictureBox picBut Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None ForeColor = &H80000008& Height = 480 Index = 1 Left = 840 Picture = "Form1.frx":0884 ScaleHeight = 480 ScaleWidth = 480 TabIndex = 16 Top = 720 Visible = 0 'False Width = 480 End Begin VB.PictureBox picBut Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None ForeColor = &H80000008& Height = 480 Index = 7 Left = 2040 Picture = "Form1.frx":0CC6 ScaleHeight = 480 ScaleWidth = 480 TabIndex = 15 Top = 2040 Width = 480 End Begin VB.PictureBox picBut Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None ForeColor = &H80000008& Height = 480 Index = 6 Left = 1440 Picture = "Form1.frx":1108 ScaleHeight = 480 ScaleWidth = 480 TabIndex = 14 Top = 1440 Visible = 0 'False Width = 480 End Begin VB.PictureBox picBut Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None ForeColor = &H80000008& Height = 480 Index = 5 Left = 720 Picture = "Form1.frx":154A ScaleHeight = 480 ScaleWidth = 480 TabIndex = 13 Top = 1440 Visible = 0 'False Width = 480 End Begin VB.PictureBox picBut Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None ForeColor = &H80000008& Height = 480 Index = 4 Left = 240 Picture = "Form1.frx":198C ScaleHeight = 480 ScaleWidth = 480 TabIndex = 12 Top = 2040 Visible = 0 'False Width = 480 End Begin VB.PictureBox picBut Appearance = 0 'Flat AutoSize = -1 'True BackColor = &H00C0C0C0& BorderStyle = 0 'None ForeColor = &H80000008& Height = 480 Index = 0 Left = 240 Picture = "Form1.frx":1DCE ScaleHeight = 480 ScaleWidth = 480 TabIndex = 11 Top = 240 Visible = 0 'False Width = 480 End End Begin VB.Label lblStatus Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H00E0E0E0& BackStyle = 0 'Transparent BorderStyle = 1 'Fixed Single Caption = "Label1" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 375 Left = 120 TabIndex = 35 Top = 2880 Width = 2775 End Begin VB.Image imgPup Height = 2580 Index = 0 Left = 7680 Picture = "Form1.frx":2210 Top = 240 Visible = 0 'False Width = 1500 End Begin VB.Image imgPup Height = 2205 Index = 6 Left = 6720 Picture = "Form1.frx":5A47 Top = 3720 Visible = 0 'False Width = 1500 End Begin VB.Image imgPup Height = 2430 Index = 5 Left = 7200 Picture = "Form1.frx":A3A1 Top = 2280 Visible = 0 'False Width = 1500 End Begin VB.Image imgPup Height = 1500 Index = 4 Left = 4320 Picture = "Form1.frx":D9C5 Top = 480 Visible = 0 'False Width = 2535 End Begin VB.Image imgPup Height = 2130 Index = 3 Left = 4680 Picture = "Form1.frx":109C6 Top = 2280 Visible = 0 'False Width = 1500 End Begin VB.Image imgPup Height = 2160 Index = 2 Left = 6720 Picture = "Form1.frx":13E03 Top = 2280 Visible = 0 'False Width = 1500 End Begin VB.Image imgPup Height = 1500 Index = 1 Left = 4560 Picture = "Form1.frx":16FA2 Top = 4200 Visible = 0 'False Width = 2445 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Const P_Disc = 1 Const P_Sick = 2 Const P_Feed = 3 Const P_Eat = 4 Const P_Play = 5 Const P_Heal = 6 Const P_Snoop = 7 Const P_Dirty = 8 Const P_Alone = 5 Const P_Exam = 6 Const P_Clean = 7 Const P_Sad = 8 Const P_Sleep = 9 Const I_Angry = 0 Const I_Dead = 1 Const I_Eat = 2 Const I_Happy = 3 Const I_Low = 4 Const I_Sly = 5 Const I_Tada = 6 Const iReduce = 0.025 Const iAdd = 0.09 Const A_Feed = 0 Const A_Light = 1 Const A_Play = 2 Const A_Medical = 3 Const A_Bath = 4 Const A_Index = 5 Const A_Disc = 6 Const A_Hint = 7 Dim iWeight As Single Dim iAge As Single Dim iTemp As Integer 'Dim iFeel(5) As Integer Dim iLastX As Integer Dim sAction(2) As String Dim sPup(3) As String Dim sIndex(2) As String 'Dim iIndex(2) As Single Sub subCheck() If Len(Dir(App.Path & "\puppy.ini")) > 0 Then Open App.Path & "\puppy.ini" For Input As #1 Input #1, iAge Input #1, iWeight Close #1 lblAge(0) = Format(iAge, "0.0") lblAge(1) = Format(iWeight, "0.0") Else MsgBox "A puppy is born!" End If End Sub Sub subUpdate() Dim iTemp As Integer Dim bflag As Boolean Dim iSet As Long For iTemp = 0 To 8 lblFeel(iTemp) = 0 If iTemp < 8 Then picBut(iTemp).Visible = False End If Next iTemp While Not bflag subAnalyse For iTemp = 0 To 8 If Val(lblFeel(iTemp)) = 255 Then bflag = True End If Next iTemp Wend For iTemp = 0 To 8 lblFeel(iTemp).BackColor = RGB(0, 0, Val(lblFeel(iTemp))) If Val(lblFeel(iTemp)) > 220 Then iSet = iSet + 2 ^ iTemp End If Next iTemp Select Case iSet Case 1 subHungry Case 8, 10 subSad Case 64, 80 subNaughty Case 9 subSick Case 65, 193 subSleep Case 73, 192, 201 subFine Case 72, 64, 74 subDirty Case Else subAlone End Select End Sub Sub subHungry() picBut(A_Feed).Visible = True subStatus (P_Feed) End Sub Sub subSad() picBut(A_Play).Visible = True subStatus (P_Sad) End Sub Sub subStatus(iStat As Integer) Dim sLine As String Dim iTemp As Integer Dim sText As String Dim iImage As Integer Select Case iStat Case P_Disc sText = "I'm gonna muck around" iImage = I_Sly Case P_Sick sText = "I'm sick" iImage = I_Eat Case P_Feed sText = "I'm hungry" iImage = I_Eat Case P_Eat sText = "Munch, munch. Yumm!" iImage = I_Happy Case P_Play sText = "Let's play a game" iImage = I_Happy Case P_Heal sText = "Heal!" iImage = I_Angry Case P_Snoop sText = "Sniff, sniff, hmmm..." iImage = I_Sly Case P_Dirty sText = "I'm dirty" iImage = I_Happy Case P_Alone sText = "Hmmmm, I'm alone" iImage = I_Sly Case P_Exam sText = "I'm healthy now" iImage = I_Tada Case P_Clean sText = "I'm clean now" iImage = I_Tada Case P_Sad sText = "I'm sad" iImage = I_Sly Case P_Sleep sText = "I'm sleepy" iImage = I_Low End Select For iTemp = 0 To Len(sText) '* 100 'DoEvents 'Debug.Print Right(sText, iTemp) lblStatus.Caption = Right(sText, Int(iTemp)) subDelay (0.1) Next iTemp subSetImage (iImage) 'lblStatus.Caption = sText End Sub Sub subSetImage(iImage As Integer) imgFrame.Picture = imgPup(iImage).Picture imgFrame.Left = (picPlate(1).Width - imgFrame.Width) / 2 imgFrame.Top = (picPlate(1).Height - imgFrame.Height) / 2 End Sub Sub subDelay(iTime As Single) Dim iTimer As Single iTimer = Timer + iTime While Timer < iTimer Wend DoEvents End Sub Sub subNaughty() picBut(A_Disc).Visible = True subStatus (P_Disc) End Sub Sub subSick() picBut(A_Feed).Visible = True picBut(A_Play).Visible = True picBut(A_Medical).Visible = True subStatus (P_Sick) End Sub Sub subSleep() picBut(A_Feed).Visible = True picBut(A_Disc).Visible = True subStatus (P_Sleep) End Sub Sub subFine() picBut(A_Feed).Visible = True picBut(A_Bath).Visible = True picBut(A_Disc).Visible = True picBut(A_Play).Visible = True picBut(A_Light).Visible = True subStatus (P_Snoop) End Sub Sub subDirty() picBut(A_Play).Visible = True picBut(A_Disc).Visible = True picBut(A_Bath).Visible = True subStatus (P_Dirty) End Sub Sub subAlone() picBut(A_Feed).Visible = False picBut(A_Bath).Visible = False picBut(A_Disc).Visible = False picBut(A_Play).Visible = False picBut(A_Light).Visible = False subStatus (P_Alone) End Sub Private Sub Form_Load() subCheck Randomize sAction(0) = "Feed" sAction(1) = "Wash" sAction(2) = "Discipline" sPup(0) = "Eating" ' A sPup(1) = "Messing" ' P sPup(2) = "Playing" ' P / A sPup(3) = "Sleeping" ' P sIndex(0) = "Discipline" sIndex(1) = "Hunger" sIndex(2) = "Happyness" picMark(0).Left = Rnd * picIndex(0).Width picMark(1).Left = Rnd * picIndex(1).Width picMark(2).Left = Rnd * picIndex(2).Width subUpdate End Sub Sub subReduce(Index As Integer) If iIndex(Index) > iReduce Then picMark(Index).Left = picMark(Index).Left - picIndex(Index).Width * iReduce End If End Sub Sub subAdd(Index As Integer) If iIndex(Index) < (1 - iAdd) Then picMark(Index).Left = picMark(Index).Left + picIndex(Index).Width * iAdd End If End Sub Sub subSelect(Index As Integer) Select Case Index Case A_Feed subStatus (P_Eat) If iIndex(0) < 0.8 Then subAdd (0) iWeight = iWeight + Rnd / 10 lblAge(1) = Format(iWeight, "0.0") End If Case A_Light Case A_Play subStatus (P_Play) If iIndex(1) < 0.8 Then subAdd (1) End If Case A_Medical subStatus (P_Exam) If iIndex(0) < 0.8 Then subAdd (0) End If If iIndex(1) < 0.8 Then subAdd (1) End If Case A_Bath subStatus (P_Clean) If iIndex(1) < 0.8 Then subAdd (1) End If If iIndex(2) < 0.8 Then subAdd (2) End If Case A_Index Case A_Disc subStatus (P_Heal) If iIndex(2) < 0.8 Then subAdd (2) End If Case A_Hint End Select picBut(Index).Visible = False subUpdate End Sub Private Sub Form_Unload(Cancel As Integer) Open App.Path & "\puppy.ini" For Output As #1 Print #1, iAge Print #1, iWeight Close #1 End Sub Private Sub imgFrame_Click() picPlate(0).ZOrder End Sub Private Sub lblStatus_Click() picPlate(2).ZOrder End Sub Private Sub picBut_Click(Index As Integer) picPlate(1).ZOrder timWake.Enabled = False subSelect (Index) timPup.Enabled = True timWake.Enabled = True End Sub Sub subEnergy() Dim iR As Integer iR = Int(Rnd * 5) Select Case iR Case 0 subReduce (0) Case 1 subReduce (1) Case 2 subReduce (2) End Select End Sub Private Sub picBut_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) picBut(Index).BorderStyle = 1 End Sub Private Sub picBut_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) picBut(Index).BorderStyle = 0 End Sub Private Sub picMark_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) ' iLastX = X End Sub Private Sub picMark_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) ' If Button = 1 Then ' picMark(Index).Left = picMark(Index).Left + X - iLastX ' End If End Sub Private Sub picPlate_Click(Index As Integer) picPlate(1).ZOrder End Sub Private Sub timPup_Timer() timPup.Enabled = False 'lblStatus.BorderStyle = 1 subEnergy 'lblStatus.BorderStyle = 0 timPup.Enabled = True End Sub Function iIndex(Index As Integer) As Single iIndex = picMark(Index).Left / picIndex(Index).Width End Function Sub subAnalyse() Randomize Dim iR As Integer iR = Int(Rnd * 3) Select Case iR Case 0 If Rnd > iIndex(0) Then lblFeel(0) = Val(lblFeel(0)) + 1 Else If Rnd > iIndex(1) Then lblFeel(1) = Val(lblFeel(1)) + 1 Else If Rnd > iIndex(2) Then lblFeel(2) = Val(lblFeel(2)) + 1 End If End If End If Case 1 If Rnd > iIndex(1) Then lblFeel(3) = Val(lblFeel(3)) + 1 Else If Rnd > iIndex(2) Then lblFeel(4) = Val(lblFeel(4)) + 1 Else If Rnd > iIndex(2) Then lblFeel(5) = Val(lblFeel(5)) + 1 End If End If End If Case 2 If Rnd > iIndex(2) Then lblFeel(6) = Val(lblFeel(6)) + 1 If Rnd > iIndex(0) Then lblFeel(7) = Val(lblFeel(7)) + 1 Else If Rnd > iIndex(1) Then lblFeel(8) = Val(lblFeel(8)) + 1 End If End If End If End Select End Sub Private Sub timWake_Timer() subSelect A_Hint iAge = iAge + Rnd lblAge(0) = Format(iAge, "0.0") End Sub