main.frm

小宠物－电子鸡源程序

Dim CurrentTempChar As Integer
Dim SystemTrayTip As String
Public ButtonAPressed As Boolean
Public ButtonBPressed As Boolean
Public ButtonCPressed As Boolean
Dim TurnSound As Boolean
Dim IconIndex As Integer
Dim LastIconIndex As Integer
Dim IconTimeLeft As Integer
Dim FrontColorName As String
Dim BackColorName As String
Dim ButtonColorName As String
Public CheatCode As String
Public TimerScreen As Boolean
Dim TimerToChangePicture As Integer
Public TimerInterval As Integer
Dim IntervalCount As Integer
Dim MoveToRight As Boolean
Dim MoveCount As Integer
Dim MoveIndex As Integer
Dim TimerAttendCount As Integer
Dim AttendTimeLeft As Integer
Dim AccessIconMenu As Integer
Dim FeedMenuIndex As Integer
Dim LightMenuIndex As Integer
Dim LightOff As Boolean
Dim MeterMenu As Integer
Dim TimerDungCount As Integer
Dim Age As Integer
Dim Happiness As Integer
Dim Hunger As Integer
Dim Sickness As Integer
Dim Dung As Integer
Dim TempCount As Integer
Dim TempMaxCount As Integer
Dim TempIndex As Integer
Dim TempChoice As Integer
Dim EatAction As Boolean
Dim CleanAction As Boolean
Dim UnhappyAction As Boolean
Dim HappyAction As Boolean
Dim NegativeAction As Boolean
Dim SleepAction As Boolean
Dim AttentionSleep As Boolean
Dim AttentionHungry As Boolean
Dim AttentionHappy As Boolean
Dim AttentionDiscipline As Boolean
Dim DyingAction As Integer

Const TAMICON_MAXTIMELEFT = 10
Const ATTENDICON_MAXTIMELEFT = 120
Const ICONMENU_TIMELEFT = 10

Private Sub Form_Load()
    'variables for creating Irregular form
    Dim rgn1 As Long    'main region
    Dim rgn2 As Long    'region to combine with rgn1
    Dim rc As Long        'return code or looping index

    JustStart = True
    MousePointer = vbHourglass
    BackColor = &H0
    
    'set system tray
    SystemTray.cbSize = Len(SystemTray)                                         'size of system tray notification
    SystemTray.hWnd = Me.hWnd                                                     'form handle
    SystemTray.uId = vbNull
    SystemTray.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE  'show icon and tip in system tray and return messages
    SystemTray.ucallbackMessage = WM_MOUSEMOVE                'return messages in mousemove event when user do something with that icon
    SystemTray.hIcon = Icon                                                              'specify an icon to show in system tray
    SystemTray.szTip = "Loading, please wait..." & vbNullChar          'specify tip text
    Call Shell_NotifyIcon(NIM_ADD, SystemTray)                               'add an icon into system tray

    'irregular form
    rgn1 = CreateEllipticRgn(5, 30, 142, 220)
    rgn2 = CreateEllipticRgn(63, 24, 84, 40)
    rc = CombineRgn(rgn1, rgn1, rgn2, RGN_OR)
    rgn2 = CreateRectRgn(3, 120, 145, 220)
    rc = CombineRgn(rgn1, rgn1, rgn2, RGN_DIFF)
    rgn2 = CreateEllipticRgn(5, 60, 142, 194)
    rc = CombineRgn(rgn1, rgn1, rgn2, RGN_OR)
    rgn2 = CreateEllipticRgn(70, 30, 78, 37)
    rc = CombineRgn(rgn1, rgn1, rgn2, RGN_DIFF)
    rc = SetWindowRgn(Me.hWnd, rgn1, True)

    FrontView.Left = 0
    FrontView.Top = 15
    BackView.Left = 0
    BackView.Top = 30
    ButtonA.Left = 600
    ButtonA.Top = 2055
    ButtonB.Left = 930
    ButtonB.Top = 2130
    ButtonC.Left = 1260
    ButtonC.Top = 2055
    ResetButton.Left = 270
    ResetButton.Top = 976
    
    If Command() <> "" Then
        TamagotchiName = Command()
    Else
        TamagotchiName = "Tamagotchi"
    End If

    Randomize Second(Time)
    Height = 2970
    Width = 2175
    CheatCode = ""
    TimerInterval = 10
    OldSecond = Second(Time)
    TimerDungCount = 0
    EatAction = False
    CleanAction = False
    UnhappyAction = False
    HappyAction = False
    NegativeAction = False
    SleepAction = False
    AttentionSleep = False
    SickIndex = 0
    Dropping = False
    PlayAction = 0
    Changing = 0
    TamagotchiHour = 10
    DyingTimeLeft = (TamagotchiHour * 24) * 2

    'icon menu
    AccessIconMenu = 0
    MeterMenu = -1

    'set buttons status
    ButtonAPressed = False
    ButtonBPressed = False
    ButtonCPressed = False

    'tamagotchi Icon on screen
    IconIndex = 7
    LastIconIndex = 7
    IconTimeLeft = 0

    'flag for turning sound on/off
    TurnSound = False

    'button text
    OKButtonText = "&OK"
    CancelButtonText = "&Cancel"

    DoGetINI
    TamChar.Visible = False
    DoGetPlugins "" 'set to default before loading a new plugin
    DoLoadCharacter

    If Plugins <> "" Then
        DoGetPlugins Plugins
        DoLoadCharacter
    End If

    'timer screen
    TimerScreen = False
    
    Caption = TamagotchiName
    DoMainScreen True
    FrontView.ToolTipText = TamagotchiName
    BackView.ToolTipText = TamagotchiName
    MousePointer = vbDefault
    JustStart = False
    DoSetCharacterName
    mCharacterName.Caption = CharacterName

    If mPopupStatus.Checked Then
        Visible = False
    Else
        SendKeys "{TAB}"
    End If

    WindowState = vbNormal
    
    If SleepAction Then
        Dark.Picture = TempDark(0).Picture
        DarkWidth = Dark.Width
        mCheatAttention.Enabled = False
        mCheatAction0.Enabled = False
        mCheatAction1.Enabled = False
        mCheatAction3.Enabled = False
        mCheatAction2.Checked = True
    Else
        Dark.Picture = TempDark(2).Picture
        DarkWidth = Dark.Width
    End If

    If InsulatingSheet = 1 Then
        SendInsulatingSheetToBack = True
        DoMainScreen False
        mPopupInsulatingSheet_Click
        mCharacterName.Caption = TamagotchiName
        SystemTray.hIcon = Icon
        SystemTray.szTip = TamagotchiName & vbNullChar
        Call Shell_NotifyIcon(NIM_MODIFY, SystemTray)
        mPopupInsulatingSheet.Checked = True
        mPopupInsulatingSheet.Enabled = False
    Else
        SendInsulatingSheetToBack = False
        Timer1.Interval = TimerInterval   'set a Timer control's Interval
        
        If InsulatingSheet = 2 Then
            mPopupInsulatingSheet_Click
        End If
    End If
    
    If mPopupStatus.Checked Then
        mPopupInsulatingSheet.Enabled = False
    End If
End Sub

Public Sub DoEndCurrentAction()
    If Dropping Then
        TempIndex = 1
        DungImage(2).Visible = False
        Dung = Dung + 1

        If Not LightOff And Not BackView.Visible And Not TimerScreen Then
            DungImage(Dung - 1).Visible = True
        End If
        
        Dropping = False
        DoMainScreen True
        MoveCount = 1
        IntervalCount = 0
    ElseIf HappyAction Then
        If CleanAction Then
            CleanAction = False
            TempImage.Visible = False
            AccessIconMenu = 0
            HappyAction = False
            DoMainScreen True
        Else
            DoIconMenu 2
            If PlayAction > 0 Then
                PlayAction = 0
                DoIconMenu 2
            End If
        End If
    ElseIf UnhappyAction Then
        DoIconMenu 2
        If PlayAction > 0 Then
            PlayAction = 0
            DoIconMenu 2
        End If
    ElseIf EatAction Then
        DoIconMenu 2
        DoIconMenu 2
    ElseIf MeterMenu >= 0 Or FeedMenu.Visible Or LightMenu.Visible Or NegativeAction Or UnhappyAction Or PlayAction > 0 Then
        DoIconMenu 2
        PlayAction = 0
    End If
End Sub

Private Sub DoCharacterAction()
    Dim VisibleFlag As Boolean

    VisibleFlag = TamChar.Visible

    Select Case CharacterNo
        Case 0 'egg
            If (MinuteCount >= MinuteToChangeCharacter And SecondCount >= 2) Then 'change to Babitchi
                MousePointer = vbHourglass
                DoSetCharacter 1
                MousePointer = vbDefault
            ElseIf (MinuteCount >= MinuteToChangeCharacter) Then 'hatch
                If CurrentTempChar <> 2 Then 'not hatch icon
                    CurrentTempChar = 2
                    TamChar.Picture = TempChar(CurrentTempChar).Picture
                    TamChar.Left = EggHatchLeft
                    TamChar.Top = EggHatchTop
                End If
            ElseIf (MinuteCount = 0 And SecondCount >= 58) Then 'shake
                DoAutoshow

                If IntervalCount = TimerToChangePicture Then
                    IntervalCount = 0
                    TamChar.Visible = False

                    If (TamChar.Left = EggShakeRight) Then
                        TamChar.Left = EggShakeLeft
                    Else
                        PlayWave App.Path + "\sounds\hatch.wav", mPopupSound.Checked, mPopupWave.Checked
                        TamChar.Left = EggShakeRight
                    End If
                End If

                CurrentTempChar = 0
            ElseIf IntervalCount = TimerToChangePicture Then 'plusing egg
                IntervalCount = 0
                CurrentTempChar = CurrentTempChar + 1

                If CurrentTempChar >= 2 Then
                    CurrentTempChar = 0
                End If
            End If
        Case 12 'Angel
            If IntervalCount >= TimerToChangePicture Then
                IntervalCount = 0
                TamChar.Visible = False
                TamChar.Left = StarsLeft
                TamChar.Top = StarsTop

                If TempIndex = 0 Then
                    TempIndex = 1
                Else
                    TempIndex = 0
                End If

                TamChar.Picture = Stars(TempIndex).Picture
                SystemTray.hIcon = AngelIcon(TempIndex).Picture
                Dung = 0
                AttentionDiscipline = False
                AttentionHungry = False
                AttentionHappy = False
            End If
        Case Else
            If IntervalCount >= TimerToChangePicture Then
                IntervalCount = 0
                MoveCount = MoveCount + 1

                If (DyingAction > 0) Or (DyingAction = 0 And (SleepAction And MoveCount = 2) Or (Not SleepAction And (Dropping And (TempCount = 0 Or TempCount = 2 Or TempCount = 4 Or TempCount = 6)) Or (Dropping And (TempCount = 1 Or TempCount = 3 Or TempCount = 5 Or TempCount >= 7)) Or (Not Dropping And (Sickness = 0 And MoveCount = 2) Or (Sickness > 0 And MoveCount = 3)))) Then
                    MoveCount = 0
                    TamChar.Visible = False

                    If DyingAction > 0 Then
                        DyingAction = DyingAction + 1
                        If DyingAction < 46 Then 'heart beat
                            If DyingAction < 32 Then
                                TimerToChangePicture = 120
                            Else
                                TimerToChangePicture = 250
                            End If

                            If TempIndex = 0 Then
                                TempIndex = 1
                                PlayWave App.Path + "\sounds\beep.wav", mPopupSound.Checked, mPopupWave.Checked
                                
                                If Not LightOff And Not BackView.Visible And Not TimerScreen Then
                                    Skull.Visible = True
                                End If
                            Else
                                TempIndex = 0
                                Skull.Visible = False
                            End If
                        ElseIf DyingAction >= 46 And DyingAction <= 60 Then 'lay an egg
                            Skull.Visible = False
                            TimerToChangePicture = 120
                            DyingAction = DyingAction + 1
                            TamChar.Left = LayLeft
                            TamChar.Top = LayTop
                            TamChar.Picture = TempDropping(1).Picture
                            TempImage.Left = LaidEggLeft
                            TempImage.Top = LaidEggTop

                            If Not LightOff And Not BackView.Visible And Not TimerScreen Then
                                DoLoadPicture Plugins, TempImage, "\Chars\00\", "0.gif"
                                TempImage.Visible = True
                            End If

                            If TempIndex = 0 Then
                                If Not LightOff And Not BackView.Visible And Not TimerScreen Then
                                    VisibleFlag = True
                                End If
                                TempIndex = 1
                            Else
                                VisibleFlag = False
                                TempIndex = 0
                            End If
                        Else 'go home
                            If Not LightOff And Not BackView.Visible And Not TimerScreen Then
                                VisibleFlag = True
                            End If

                            TempImage.Visible = False
                            DyingAction = 0
                            MousePointer = vbHourglass
                            DoSetCharacter 12
                            MousePointer = vbDefault
                        End If
                    Else
                        If SleepAction Then
                            TamChar.Left = SleepLeft
                            TamChar.Top = SleepTop

                            If CharacterNo <= 4 Then
                                If TempCount = 0 Then
                                    TempCount = 1
                                Else
                                    TempCount = 0
                                End If

                                TamChar.Picture = TempSleep(TempCount).Picture
                                SleepSign.Picture = TempSleepSign(TempCount).Picture
                                SystemTray.hIcon = SleepIcon(TempCount).Picture
                                Dark.Picture = TempDark(TempCount).Picture
                                DarkWidth = Dark.Width
                            Else
                                If TempCount <= 1 Then
                                    TempIndex = 0
                                Else
                                    TempIndex = 1
                                End If

                                If TempCount = 2 Then
                                    TamChar.Picture = TempSleep(1).Picture
                                Else
                                    TamChar.Picture = TempSleep(0).Picture
                                End If

                                SleepSign.Picture = TempSleepSign(TempIndex).Picture
                                SystemTray.hIcon = SleepIcon(TempIndex).Picture
                                Dark.Picture = TempDark(TempIndex).Picture
                                DarkWidth = Dark.Width
                                TempCount = TempCount + 1

                                If TempCount = 4 Then
                                    TempCount = 0
                                End If
                            End If
                        ElseIf Dropping Then
                            SystemTrayTip = mCheatAction1.Caption

                            If TempCount = 0 Or TempCount = 2 Or TempCount = 4 Or TempCount = 6 Then
                                TempIndex = 0