inssheet.frm

小宠物－电子鸡源程序

VERSION 5.00
Begin VB.Form Form5 
   AutoRedraw      =   -1  'True
   BackColor       =   &H80000005&
   BorderStyle     =   0  'None
   ClientHeight    =   510
   ClientLeft      =   2295
   ClientTop       =   1605
   ClientWidth     =   1170
   ClipControls    =   0   'False
   Icon            =   "InsSheet.frx":0000
   LinkTopic       =   "Form5"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   352.011
   ScaleMode       =   0  'User
   ScaleWidth      =   1098.694
   ShowInTaskbar   =   0   'False
   Begin VB.Timer Timer1 
      Left            =   1230
      Top             =   15
   End
   Begin VB.Image Picture1 
      Height          =   510
      Left            =   0
      MousePointer    =   99  'Custom
      Top             =   0
      Width           =   1170
   End
End
Attribute VB_Name = "Form5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Module:   InsSheet.frm
'                Insulating Sheet
'Author:    Pheeraphat Sawangphian
'E-Mail:     [e-mail]
'URL:       http://www.geocities.com/Hollywood/Lot/6166

Option Explicit
Dim StartMove As Boolean
Dim DifferenceX As Single
Dim DifferenceY As Single
Dim SecCount As Integer

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        PopupMenu Form1.mPopup 'show normal popup menu
    ElseIf KeyCode = vbKeyF1 Then
        Form1.mPopupInstructions_Click
    ElseIf KeyCode = vbKeyEscape Then
        Form1.mPopupStatus_Click
    ElseIf KeyCode >= vbKeyA And KeyCode <= vbKeyZ Then
        Form1.CheatCode = Form1.CheatCode + Chr(KeyCode)

        If Len(Form1.CheatCode) = Len("TOOH") Then
            If Form1.CheatCode = "TOOH" Then
                Form1.mCheats.Visible = Not Form1.mCheats.Visible
                Form1.mPopupSep0.Visible = Form1.mCheats.Visible
                
                If Form1.InsulatingSheet = 1 Then
                    Form1.mCheats.Enabled = False
                Else
                    Form1.mCheats.Enabled = True
                End If
            End If

            Form1.CheatCode = ""
        End If
    ElseIf KeyCode = vbKeyBack Then
        If Len(Form1.CheatCode) > 0 Then
            Form1.CheatCode = Left(Form1.CheatCode, Len(Form1.CheatCode) - 1)
        End If
    Else
        Form1.CheatCode = ""
        
        If Not Form1.BackView.Visible Then
            If KeyCode = vbKeyLeft And Not Form1.ButtonAPressed Then
                Form1.DoLoadPicture Form1.Plugins, Form1.ButtonA, "\colors\" + Form1.CurrentColor + "\", "button1.gif"
                Form1.ButtonAPressed = True
                Form1.DoButtonA True
            ElseIf KeyCode = vbKeyDown And Not Form1.ButtonBPressed Then
                Form1.DoLoadPicture Form1.Plugins, Form1.ButtonB, "\colors\" + Form1.CurrentColor + "\", "button1.gif"
                Form1.ButtonBPressed = True
                
                If Form1.InsulatingSheet <> 1 Then
                    PlayWave App.Path + "\sounds\beep.wav", Form1.mPopupSound.Checked, Form1.mPopupWave.Checked
                End If
                
                Form1.DoButtonB
            ElseIf KeyCode = vbKeyRight And Not Form1.ButtonCPressed Then
                Form1.DoLoadPicture Form1.Plugins, Form1.ButtonC, "\colors\" + Form1.CurrentColor + "\", "button1.gif"
                Form1.ButtonCPressed = True
                Form1.DoButtonC True
            End If
        End If
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If Not Form1.BackView.Visible Then
        If KeyCode = vbKeyLeft Then
            Form1.DoLoadPicture Form1.Plugins, Form1.ButtonA, "\colors\" + Form1.CurrentColor + "\", "button0.gif"
            Form1.ButtonAPressed = False
            Form1.DoButtonA False
        ElseIf KeyCode = vbKeyDown Then
            Form1.DoLoadPicture Form1.Plugins, Form1.ButtonB, "\colors\" + Form1.CurrentColor + "\", "button0.gif"
            Form1.ButtonBPressed = False
        ElseIf KeyCode = vbKeyRight Then
            Form1.DoLoadPicture Form1.Plugins, Form1.ButtonC, "\colors\" + Form1.CurrentColor + "\", "button0.gif"
            Form1.ButtonCPressed = False
            Form1.DoButtonC False
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim rgn1 As Long    'main region
    Dim rgn2 As Long    'region to combine with rgn1
    Dim rc As Long        'return code or looping index
    
    If Form1.Plugins <> "" And Dir(App.Path + "\plugins\" + Form1.Plugins + "\other\inssheet.gif", vbNormal) <> "" Then
        Picture1.Picture = LoadPicture(App.Path + "\plugins\" + Form1.Plugins + "\other\inssheet.gif")
    ElseIf Dir(App.Path + "\other\inssheet.gif") <> "" Then
        Picture1.Picture = LoadPicture(App.Path + "\other\inssheet.gif")
    End If
    
    Form1.DoLoadPointer Form1.Plugins, Picture1, "\other\", "inssheet.cur"
    rgn1 = CreateEllipticRgn(46, 1, 79, 35)
    rgn2 = CreateRectRgn(5, 9, 60, 26)
    rc = CombineRgn(rgn1, rgn1, rgn2, RGN_OR)
    rgn2 = CreateEllipticRgn(0, 9, 17, 27)
    rc = CombineRgn(rgn1, rgn1, rgn2, RGN_OR)
    rc = SetWindowRgn(Me.hWnd, rgn1, True)

    If Form1.InsulatingSheet = 1 Then
        Left = Form1.Left + Form1.Width - 60 - Form1.InsulatingSheetWidthPushed
        Form1.mCheats.Enabled = False
    ElseIf Form1.InsulatingSheet = 2 Then
        Left = Form1.Left + Form1.Width - 60 - Form1.InsulatingSheetWidthPushed
        Form1.mCheats.Enabled = True
    End If
    
    Top = Form1.Top + 1600
    StartMove = False
    Form1.SendInsulatingSheetToBack = True
    SecCount = 0
    Timer1.Interval = 100
    Form1.CurrentInsulatingSheet = Form1.InsulatingSheet
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoMouseDown Button, X, Y
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoMouseMove Button, X, Y
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoMouseUp Button
End Sub

Private Sub DoMouseDown(Button As Integer, X As Single, Y As Single)
    If Button = 1 Then
        If Not StartMove Then
            DifferenceX = X
            DifferenceY = Y
            StartMove = True
        End If
    ElseIf Button = 2 Then
        PopupMenu Form1.mPopup 'show normal popup menu
    End If
End Sub

Private Sub DoMouseMove(Button As Integer, X As Single, Y As Single)
    If Button = 1 Then
        If StartMove Then
            If ((Left > Form1.Left + Form1.Width - 60 And Not Form1.SendInsulatingSheetToBack) Or Form1.SendInsulatingSheetToBack) And (Top >= Form1.Top + 1600 - 150 And Top <= Form1.Top + 1600 + 150) And (Left >= Form1.Left + Form1.Width - 60 - 700 And Left <= Form1.Left + Form1.Width - 60 + 150) Then
                If Not Form1.SendInsulatingSheetToBack Then
                    AlwaysOnTop Form5, False
                    AlwaysOnTop Form1, True
                    Form1.SendInsulatingSheetToBack = True
                End If
                
                Top = Form1.Top + 1600
                
                If Left + (X - DifferenceX) > Form1.Left + Form1.Width - 60 - 700 Then
                    Move Left + (X - DifferenceX), Top
                Else
                    Move Form1.Left + Form1.Width - 60 - 700, Top
                End If
                
                If Form1.SendInsulatingSheetToBack And Left < Form1.Left + Form1.Width - 60 Then
                    Form1.InsulatingSheetWidthPushed = Form1.Left + Form1.Width - 60 - Left
                Else
                    Form1.InsulatingSheetWidthPushed = 0
                End If
            Else
                If Form1.SendInsulatingSheetToBack Then
                    AlwaysOnTop Form1, False
                    AlwaysOnTop Form5, True
                    Form1.SendInsulatingSheetToBack = False
                End If
                
                Move Left + (X - DifferenceX), Top + (Y - DifferenceY)
            End If
            
            DoEvents 'make sure it cleans up
        End If
    End If
End Sub

Private Sub DoMouseUp(Button As Integer)
    If Button = 1 Then
        If StartMove Then
            StartMove = False
        End If
    End If
End Sub

Private Sub Timer1_Timer()
    If Form1.SendInsulatingSheetToBack And Top = Form1.Top + 1600 And (Left >= Form1.Left + Form1.Width - 60 - 700 And Left <= Form1.Left + Form1.Width - 60 - 500) Then
        If Form1.InsulatingSheet = 2 Then
            SecCount = 0
        End If
        
        Form1.InsulatingSheet = 1
    Else
        If Form1.InsulatingSheet = 1 Then
            SecCount = 0
        End If
        
        Form1.InsulatingSheet = 2
    End If
    
    If (Form1.CurrentInsulatingSheet = 1 And Form1.InsulatingSheet = 2 And SecCount >= 5) Or (Form1.CurrentInsulatingSheet = 2 And Form1.InsulatingSheet = 1 And SecCount >= 15) Then
         If Form1.CurrentInsulatingSheet = 2 And Form1.InsulatingSheet = 1 Then
            If Form1.TimerScreen Then
                Form1.TimerScreen = False
                Form1.DoShowTimerScreen Form1.TimerScreen
            End If
            
            Form1.DoSetCharacter 0
            Form1.InsulatingSheet = 2
            Form1.CurrentInsulatingSheet = 1
            Form1.DoMainScreen False
            Form1.Timer1.Interval = 0
            SecCount = 0
            Form1.DoHideIcon
            Form1.AttendIcon.Visible = False
            Form1.mCharacterName.Caption = Form1.TamagotchiName
            SystemTray.hIcon = Form1.Icon
            SystemTray.szTip = Form1.TamagotchiName & vbNullChar
            Call Shell_NotifyIcon(NIM_MODIFY, SystemTray)
            Form1.mPopupInsulatingSheet.Enabled = False
            Form1.mCheats.Enabled = False
         ElseIf Form1.CurrentInsulatingSheet = 1 And Form1.InsulatingSheet = 2 Then
            Form1.InsulatingSheet = 1
            Form1.CurrentInsulatingSheet = 2
            Form1.DoMainScreen True
            Form1.Timer1.Interval = Form1.TimerInterval
            SecCount = 0
            Form1.ResetButton_MouseUp 1, 0, 0, 0
            Form1.mPopupInsulatingSheet.Enabled = True
            Form1.mCheats.Enabled = True
        End If
    Else
        SecCount = SecCount + 1
    End If
End Sub