plugins.frm

小宠物－电子鸡源程序

VERSION 5.00
Begin VB.Form Form3 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   2805
   ClientLeft      =   2340
   ClientTop       =   1935
   ClientWidth     =   4605
   ClipControls    =   0   'False
   Icon            =   "Plugins.frx":0000
   LinkTopic       =   "Form5"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1936.061
   ScaleMode       =   0  'User
   ScaleWidth      =   4324.333
   ShowInTaskbar   =   0   'False
   Begin VB.ListBox List3 
      Enabled         =   0   'False
      Height          =   1320
      ItemData        =   "Plugins.frx":000C
      Left            =   5220
      List            =   "Plugins.frx":000E
      Sorted          =   -1  'True
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   90
      Visible         =   0   'False
      Width           =   540
   End
   Begin VB.ListBox List2 
      Enabled         =   0   'False
      Height          =   1320
      ItemData        =   "Plugins.frx":0010
      Left            =   4680
      List            =   "Plugins.frx":0012
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   90
      Visible         =   0   'False
      Width           =   540
   End
   Begin VB.TextBox Text1 
      Alignment       =   2  'Center
      BackColor       =   &H8000000F&
      BorderStyle     =   0  'None
      Height          =   885
      Left            =   90
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   1455
      Width           =   4410
   End
   Begin VB.CommandButton Command1 
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   330
      Left            =   1950
      TabIndex        =   2
      Top             =   2415
      Width           =   1230
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Height          =   330
      Left            =   3285
      TabIndex        =   3
      Top             =   2415
      Width           =   1230
   End
   Begin VB.ListBox List1 
      Height          =   1320
      ItemData        =   "Plugins.frx":0014
      Left            =   75
      List            =   "Plugins.frx":0016
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   75
      Width           =   4440
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Module:   Plugins.frm
'                For plugins and colors setting
'Author:    Pheeraphat Sawangphian
'E-Mail:     [e-mail]
'URL:       http://www.geocities.com/Hollywood/Lot/6166

Option Explicit

Dim OldDirectoryName As String
Dim NameStr As String
Dim MaxLen As Integer
Dim ButtonALeft As Integer
Dim ButtonATop As Integer
Dim ButtonBLeft As Integer
Dim ButtonBTop As Integer
Dim ButtonCLeft As Integer
Dim ButtonCTop As Integer
Dim ResetButtonLeft As Integer
Dim ResetButtonTop As Integer
Dim DefaultColor As String

Private Sub Command1_Click()
    Form3.MousePointer = vbHourglass
    
    If Form1.PluginsForm Then
        Form1.DoMainScreen False
        DoSetPlugins
        Form1.DoMainScreen True
        Form1.DoSetCharacterName
        Form1.mCharacterName.Caption = Form1.CharacterName
        
        If DefaultColor <> "" Then
            DoGetDescription False, DefaultColor
            DoSetColor DefaultColor
        End If
        
        If Form1.InsulatingSheet <> 0 Then
            If Form1.InsulatingSheet = 1 Then
                Form1.DoMainScreen False
            End If

            If Form1.Plugins <> "" And Dir(App.Path + "\plugins\" + Form1.Plugins + "\other\inssheet.gif", vbNormal) <> "" Then
                Form5.Picture1.Picture = LoadPicture(App.Path + "\plugins\" + Form1.Plugins + "\other\inssheet.gif")
            ElseIf Dir(App.Path + "\other\inssheet.gif") <> "" Then
                Form5.Picture1.Picture = LoadPicture(App.Path + "\other\inssheet.gif")
            End If

            Form1.DoLoadPointer Form1.Plugins, Form5.Picture1, "\other\", "inssheet.cur"
        End If
    Else
        DoSetColor List2.Text
    End If
    
    If Form1.InsulatingSheet = 1 Then
        Form1.mCharacterName.Caption = Form1.TamagotchiName
        SystemTray.hIcon = Form1.Icon
        SystemTray.szTip = Form1.TamagotchiName & vbNullChar
        Call Shell_NotifyIcon(NIM_MODIFY, SystemTray)
    End If

    Form3.MousePointer = vbDefault
    Form1.Caption = Form1.TamagotchiName
    Unload Form3
End Sub

Private Sub Command2_Click()
    Unload Form3
End Sub

Private Sub Form_Load()
    Dim DirectoryName As String
    Dim i As Integer
    
    MousePointer = vbHourglass
    Command1.Caption = Form1.OKButtonText
    Command2.Caption = Form1.CancelButtonText
    Form1.Enabled = False
    Form1.mPopupStatus.Enabled = Form1.Enabled
    Form1.mPopupOnTop.Enabled = Form1.Enabled
    Form1.mCheats.Enabled = Form1.Enabled
    Form1.mPopupChangeColor.Enabled = Form1.Enabled
    Form1.mPopupPlugins.Enabled = Form1.Enabled
    Form1.mPopupInstructions.Enabled = Form1.Enabled
    Form1.mPopupAbout.Enabled = Form1.Enabled
    
    If Form1.mPopupInsulatingSheet.Checked Then
        Form5.Enabled = False
    Else
        Form1.mPopupInsulatingSheet.Enabled = False
    End If

    Left = (Screen.Width - Width) / 2
    Top = (Screen.Height - Height) / 2
    AlwaysOnTop Me, Form1.mPopupOnTop.Checked
    List1.Clear
    List2.Clear
    List3.Clear
    MaxLen = 0
    
    If Form1.PluginsForm Then
        Caption = Form1.mPopupPlugins.Caption
        OldDirectoryName = Form1.Plugins
        List2.AddItem "<Default>"
        DirectoryName = Dir(App.Path + "\plugins\", vbDirectory) 'retrieve the first entry

        Do While DirectoryName <> ""
            If DirectoryName <> "." And DirectoryName <> ".." Then 'ignore the current directory and the encompassing directory
                List2.AddItem DirectoryName
            End If
        
            DirectoryName = Dir 'get next entry
        Loop
        
        If List2.ListCount > 0 Then
            Command1.Enabled = True
            
            'get maximum length of plugin name
            i = 0
            Do
                List2.ListIndex = i
                DoGetName
                
                If Len(NameStr) > MaxLen Then
                    MaxLen = Len(NameStr)
                End If

                i = i + 1
            Loop While i < List2.ListCount
            
            'add plugin names to List1 and List3
            i = 0
            Do
                List2.ListIndex = i
                DoGetName
                List1.AddItem NameStr
                List3.AddItem NameStr + Space(MaxLen - Len(NameStr)) + Format(i, "000")
                i = i + 1
            Loop While i < List2.ListCount
            
            'hilight current plugin
            i = List2.ListCount - 1
            Do
                List3.ListIndex = i
                List1.ListIndex = i
                List2.ListIndex = Val(Mid(List3.Text, MaxLen + 1))
                i = i - 1
            Loop While i >= 0 And LCase(List2.Text) <> LCase(Form1.Plugins)
        End If
    Else
        Caption = Form1.mPopupChangeColor.Caption
        OldDirectoryName = Form1.CurrentColor
        DirectoryName = Dir(App.Path + "\colors\", vbDirectory) 'retrieve the first entry

        Do While DirectoryName <> ""
            If DirectoryName <> "." And DirectoryName <> ".." Then 'ignore the current directory and the encompassing directory
                List2.AddItem DirectoryName
            End If

            DirectoryName = Dir 'get next entry
        Loop

        If List2.ListCount > 0 Then
            Command1.Enabled = True
            
            'get maximum length of color name
            i = 0
            Do
                List2.ListIndex = i
                DoGetName
                
                If Len(NameStr) > MaxLen Then
                    MaxLen = Len(NameStr)
                End If