mainform.frm

一个可以自动播放的软件

      Width           =   855
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Dim RightTime As Boolean
Dim PlaySong As String
Dim PlayReplay As Integer
Dim filenum As Integer
Dim skin As Boolean

Function ToWeek(week_int As Integer) As String
    Select Case week_int
        Case 1: ToWeek = "一"
        Case 2: ToWeek = "二"
        Case 3: ToWeek = "三"
        Case 4: ToWeek = "四"
        Case 5: ToWeek = "五"
        Case 6: ToWeek = "六"
        Case 7: ToWeek = "日"
    End Select
End Function

Function CTaskPlan(Plan As Integer) As String
    Select Case Plan
        Case 0: CTaskPlan = "每天"
        Case 1: CTaskPlan = "每工作日"
        Case 2: CTaskPlan = "每周日"
    End Select
    
End Function

Private Sub CheckAutoClose_Click()
    CloseTime = CDate(TextAutoClosetime.Text)
End Sub

Private Sub Cmd还原_Click()
skin = Not skin
If skin Then
    With Me
        .BackColor = &H8000000F
        .Picture = LoadPicture("")
    End With
Else
    With Me
        .BackColor = &HC00000
        .Picture = LoadPicture("")
    End With
End If

End Sub

Private Sub Cmd连续_Click()
    ListTime.Enabled = False
    
End Sub

Private Sub Cmd皮肤_Click()
    
    Dlgadd.Filter = "所有的图片文件|*.bmp;*.dib;*.jpg;*.gif;*.wmf;*.emf;*.ico;*.cur|位图(*.bmp;*.dib)|*.bmp;*.dib|JPEG(*.jpg)| *.jpg|GIF 图像(*.gif)|*.gif|元文件(*.wmf;*.emf)|*.wmf;*.emf|Icons(*.ico;*.cur)|*.ico;*.cur"
    Dlgadd.InitDir = App.Path & "\skin"
    Dlgadd.ShowOpen
    If Dlgadd.FileName = "" Then Exit Sub
    MainForm.Picture = LoadPicture(Dlgadd.FileName)
    Dlgadd.FileName = ""
End Sub

Private Sub Cmd任务栏_Click()
    If Me.Cmd任务栏.Caption = "显示任务栏" Then
        Me.Cmd任务栏.Caption = "隐藏任务栏"
        Me.Height = 4275
        
    Else
        Me.Cmd任务栏.Caption = "显示任务栏"
        Me.Height = 2100
        List1.ListIndex = -1
        ListTime.ListIndex = -1
        Cmd删除.Enabled = False
    End If
End Sub

Private Sub Cmd删除_Click()
On Error Resume Next

    Dim CurrListIndex As Integer
    
    CurrListIndex = List1.ListIndex
    ListTime.RemoveItem CurrListIndex
    List1.RemoveItem CurrListIndex
    For i = CurrListIndex To TaskNumber
        TaskArr(i) = TaskArr(i + 1)
    Next i
    
    Me.Cmd删除.Enabled = False
    
    TaskNumber = TaskNumber - 1
    List1.ListIndex = 0
End Sub

Private Sub Cmd添加_Click()

    Dlgadd.Filter = "媒体文件|*.cda;*.mid;rmi;*midi;*.asf;*.wm;*.wma;*.mp2;*.mp3;*.avi;*.wmv;*.wav|CD音频曲目(*.cda)|*.cda|MIDI文件(*.mid;*.rmi;*.midi)|*.mid;*.rmi;*.midi|windows Media 文件(*.asf;*.wm;*.wma)|*.asf;*.wm;*.wma|mp3 mp2(*.mp3;*.mp2)|*.mp3;*.mp2|wav(*.WAV)| *.wav "
    Me.Dlgadd.ShowOpen
    If Dlgadd.FileName = "" Then Exit Sub
    List1.AddItem (Dlgadd.FileName)
    Add_SongName = Dlgadd.FileName
    Dlgadd.FileName = ""
    Add_SongTask.TaskName = Add_SongName
    TaskOption = False
    FormTime.Show vbModal, Me
    ListTime.AddItem Task_Str
    
    TaskNumber = TaskNumber + 1
    
End Sub

Private Sub Cmd退出_Click()
    Unload Me
End Sub

'Private Sub Command1_Click()
'    'Dim Ret As Integer'
'
'    'Ret = ExitWindows(EW_REBOOTSYSTEM, 0)
'
'    Shell "rundll.exe user.exe,exitwindows", vbHide         '关机
'
'End Sub

Private Sub Form_Load()
On Error GoTo errhander

If App.PrevInstance Then
    '''自身程序避免重复打开
    
    Unload Me
End If

    Dim sss1 As Integer, sss2 As Integer, sss3 As Integer
    
    'With Me
    '    .Height = 2100 ' 6135
    '    .Width = 5925
    'End With
    
    RightTime = False
    TaskOption = False
    
    Me.Caption = "自动播放系统" & " " & "V" & App.Major & "." & App.Minor & "." & App.Revision
    
    filenum = FreeFile
    Open App.Path & "\setting.txt" For Input As filenum
    Do While Not EOF(filenum)
        Line Input #filenum, Task_Str
        TaskArr(TaskNumber) = Task_Str
        Str_SongTask (Task_Str)
        List1.AddItem (SongTask.TaskName)
        ListTime.AddItem (CTaskPlan(SongTask.TaskPlan) & SongTask.TaskTime & " 循环播放" & SongTask.TaskReplay & "次")
        
        TaskNumber = TaskNumber + 1
        
    Loop
    Close filenum
    
    Cmd删除.Enabled = False
    
    Exit Sub

errhander:
    'MsgBox "文件没找到!", vbCritical
    Close filenum
    Open App.Path & "\setting.txt" For Output As filenum
    Close filenum
End Sub

Private Sub Form_Unload(Cancel As Integer)
    filenum = FreeFile
    Open App.Path & "\setting.txt" For Output As filenum
    For i = 1 To List1.ListCount
        Print #filenum, TaskArr(i - 1)
    Next i
    
    Close filenum

End Sub

Private Sub List1_Click()
    Me.Cmd删除.Enabled = True
    ListTime.ListIndex = List1.ListIndex
End Sub

Private Sub List1_DblClick()
    SongName = List1.Text
    MPlayer.playCount = 1
    MPlayer.FileName = SongName
    MPlayer.play
End Sub

Private Sub ListTime_Click()
    List1.ListIndex = ListTime.ListIndex
End Sub

Private Sub ListTime_DblClick()
    TaskOption = True
    'OP_SongName = List1.Text
    OP_Num = ListTime.ListIndex
    FormTime.Show vbModal, Me
    ListTime.List(OP_Num) = Task_Str
End Sub

Private Sub MPlayer_EndOfStream(ByVal Result As Long)
On Error Resume Next
    PlayReplay = PlayReplay - 1
    If PlayReplay = 0 Then
        RightTime = False
        MPlayer.FileName = ""
    Else
        MPlayer.play
    End If
''''''''''''''''''''''''
'    MPlayer.FileName = ""
    
End Sub

Private Sub Timer1_Timer()
On Error Resume Next

    Dim Temp_str As String, temp_time As Date
    Dim curr_time, curr_date
    
    curr_time = Time: curr_week = Weekday(Date, vbMonday): curr_date = Date
    
    LabelTime.Caption = curr_time
    Labeldate.Caption = curr_date & "  星期" & ToWeek(CInt(curr_week))
    
    If CloseTime = curr_time Then
        
        If CheckAutoClose.Value = 1 Then Shell "rundll.exe user.exe,exitwindows", vbHide     '关机
        
    End If
    
    For i = 0 To TaskNumber - 1
        Temp_str = TaskArr(i)
        Str_SongTask (Temp_str)
        temp_time = CDate(SongTask.TaskTime)
        If curr_time = temp_time Then
            Select Case SongTask.TaskPlan
                Case 0: ''每天
                    PlaySong = SongTask.TaskName
                    PlayReplay = SongTask.TaskReplay
                    RightTime = True
                Case 1: ''每工作日
                    If curr_week <> 7 Then
                        PlaySong = SongTask.TaskName
                        PlayReplay = SongTask.TaskReplay
                        RightTime = True
                    End If
                Case 2: ''每周日
                    If curr_week = 7 Then
                        PlaySong = SongTask.TaskName
                        PlayReplay = SongTask.TaskReplay
                        RightTime = True
                    End If
                Case Else
            End Select
        End If
    Next i
    
    If RightTime Then
        MPlayer.playCount = SongTask.TaskReplay
        MPlayer.FileName = PlaySong
        MPlayer.play
        'TextSongName.Text = PlaySong
        'LabelSongName.Caption = PlaySong
    End If
    RightTime = False
    LabelSongName.Caption = MPlayer.FileName
    
End Sub