etklokmain.frm

一个 点歌系统

        SongDB = "EtGQFL_Gygq "
      Case "粤语歌曲"
        SongDB = "EtGQFL_Yygq "
      Case "台语歌曲"
        SongDB = "EtGQFL_Tygq "
      Case "英文歌曲"
        SongDB = "EtGQFL_Ewgq "
      Case "音乐舞曲"
        SongDB = "EtGQFL_Yywq "
      Case "国语合唱"
        SongDB = "EtHCGQ_Gyhc "
      Case "粤语合唱"
        SongDB = "EtHCGQ_Yyhc "
      Case "台语合唱"
        SongDB = "EtHCGQ_Tyhc "
      Case "英文合唱"
        SongDB = "EtHCGQ_Ewhc "
      Case "其它合唱"
        SongDB = "EtHCGQ_Qthc "
      Case "流行独唱"
        SongDB = "EtLXGB_Lxdc "
      Case "流行合唱"
        SongDB = "EtLXGB_Lxhc "
      Case "精彩电影"
        SongDB = "EtDYXP_Gcdy "
      Case "相声小品"
        SongDB = "EtDYXP_Xsxp "
      Case "歌星点歌"
        SongDB = "EtSong "
      Case "字母点歌"
        SongDB = "EtSong "
  End Select
  SqlStr = "Select * from " + SongDB + SelectStr
  If Rs.State Then Rs.Close
  Rs.Open SqlStr, Cnn, adOpenStatic, adLockReadOnly
  If Not Rs.EOF Then
    If (Rs.RecordCount Mod 10) > 0 Then
      AllPage.Caption = Str((Rs.RecordCount \ 10) + 1)
    Else
      AllPage.Caption = Str(Rs.RecordCount \ 10)
    End If
  End If
  Do While Not Rs.EOF
      Set x = GQList.ListItems.Add(, , i)
      x.SubItems(1) = Rs.Fields("Song_GM").Value
      x.SubItems(2) = Rs.Fields("Song_GXM").Value
      x.SubItems(3) = Rs.Fields("Song_FilePath").Value
      x.SubItems(4) = Rs.Fields("Song_YCSD").Value
      If (Trim(SelectName.Caption) <> "已点歌曲") Then
          If (Rs.Fields("Song_DQ").Value = "1") Then
              x.ForeColor = &HFF&
              x.ListSubItems.Item(1).ForeColor = &HFF&
              x.ListSubItems.Item(2).ForeColor = &HFF&
          End If
      End If
      If i < 9 Then
        i = i + 1
      Else
        i = 0
      End If
      Rs.MoveNext
  Loop
  Rs.Close
End Sub

Private Sub SongPageUP()
Dim ItemX As ListItem
If GQList.ListItems.Count <> 0 Then
  If PageUpSelect Then
    If GQList.SelectedItem.Index > 10 Then
      Set ItemX = GQList.FindItem("0", , GQList.SelectedItem.Index - 10, lvwPartial)
      ItemX.EnsureVisible
      GQList.SetFocus
      ItemX.Selected = True
    End If
    PageUpSelect = False
  End If
  If GQList.SelectedItem.Index > 10 Then
    Set ItemX = GQList.FindItem("0", , GQList.SelectedItem.Index - 10, lvwPartial)
    ItemX.EnsureVisible
    GQList.SetFocus
    ItemX.Selected = True
    SongPage = SongPage - 1
    PageLab.Caption = Str(SongPage)
  End If
End If
End Sub

Private Sub SongPageDown()
Dim ItemX As ListItem
If GQList.ListItems.Count <> 0 Then
    Dim t As Integer
    t = GQList.SelectedItem.Text
        Do While t < 10
            GQList.SetFocus
            keybd_event 32, 0, 0, 0
            GQList.SetFocus
            keybd_event 40, 0, 0, 0
            t = t + 1
        Loop
    If (SongPage * 10) < GQList.ListItems.Count Then SongPage = SongPage + 1
    PageLab.Caption = Str(SongPage)
    GQList.SetFocus
    keybd_event 34, 0, 0, 0
    PageUpSelect = True
End If
End Sub


Private Sub SelPagImg_Click(Index As Integer)
  Select Case Index
      Case 0
        SongPageDown
      Case 1
        SongPageUP
  End Select
End Sub

Private Sub SelPagImg_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  If SelPagIndex <> Index Then
    If SelPagIndex <> -1 Then
      SelPagImg(SelPagIndex).Picture = LoadPicture()
    End If
    If Index = 0 Then
      SelPagImg(Index).Picture = LoadPicture(App.Path + "\Pic\下一页.bmp")
    Else
      SelPagImg(Index).Picture = LoadPicture(App.Path + "\Pic\上一页.bmp")
    End If
    SelPagIndex = Index
  End If
End Sub

Public Sub StarPicInit()
Dim i As Integer
  i = 0
  Rs.Open "EtStar", Cnn, adOpenStatic, adLockReadOnly
  If Not Rs.EOF Then
    ReDim StarData(Rs.RecordCount)
    StarCount = Rs.RecordCount
  End If
  Do While Not Rs.EOF
    StarData(i).StarName = Rs.Fields("StarName").Value
    StarData(i).StarPath = Rs.Fields("StarPath").Value
    i = i + 1
    Rs.MoveNext
  Loop
  Rs.Close
  StarPageDown_Click
End Sub

Public Sub StarPageUp_Click()
  If StarIndex - 2 >= 0 Then
    StarIndex = StarIndex - 2
    StarPageDown_Click
  End If
End Sub

Public Sub StarPageDown_Click()
Dim i, j As Integer
  If (StarIndex + 1) * 4 <= StarCount Then
    j = 4
  Else
    j = StarCount - StarIndex * 4
  End If
  If StarCount >= StarIndex * 4 Then
    For i = 0 To 4 - 1
      If i + 1 > j Then
        StarImg(i).Picture = LoadPicture()
        StarImg(i).ToolTipText = ""
      Else
        If FindMpg(App.Path + "\" + StarData(StarIndex * 4 + i).StarPath) Then
          StarImg(i).Picture = LoadPicture(App.Path + "\" + StarData(StarIndex * 4 + i).StarPath)
          StarImg(i).ToolTipText = StarData(StarIndex * 4 + i).StarName
        Else
          StarImg(i).Picture = LoadPicture()
        End If
      End If
    Next i
    StarIndex = StarIndex + 1
    StarName = StarImg(0).ToolTipText
  End If
End Sub

Private Sub StarPgImg_Click(Index As Integer)
  Select Case Index
          Case 0
            StarPageUp_Click
          Case 1
            StarPageDown_Click
  End Select
End Sub

Private Sub StarPgImg_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  If StarPagIndex <> Index Then
    If StarPagIndex <> -1 Then
      StarPgImg(StarPagIndex).Picture = LoadPicture()
    End If
    If Index = 0 Then
      StarPgImg(Index).Picture = LoadPicture(App.Path + "\Pic\前一页.bmp")
    Else
      StarPgImg(Index).Picture = LoadPicture(App.Path + "\Pic\后一页.bmp")
    End If
    StarPagIndex = Index
  End If
End Sub

Private Sub StarImg_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  StarName.Caption = StarImg(Index).ToolTipText
End Sub

Private Sub StarImg_Click(Index As Integer)
  ListItemShow StarLbe.Caption, "Where Song_GXM='" + Trim(StarName) + "'"
End Sub

Private Sub SysBackImg_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  If ZmgqIndex <> -1 Then
    ZmdgImg(ZmgqIndex).Picture = LoadPicture()
    ZmgqIndex = -1
  End If
  If YdgqToolIndex <> -1 Then
    YdgqImg(YdgqToolIndex).Picture = LoadPicture()
    YdgqToolIndex = -1
  End If
  If ToolIndex <> -1 Then
    ToolImg(ToolIndex).Picture = LoadPicture()
    ToolIndex = -1
  End If
  If StarPagIndex <> -1 Then
    StarPgImg(StarPagIndex).Picture = LoadPicture()
    StarPagIndex = -1
  End If
  If SelPagIndex <> -1 Then
    SelPagImg(SelPagIndex).Picture = LoadPicture()
    SelPagIndex = -1
  End If
  If DglbIndex <> -1 Then
    DglbImg(DglbIndex).Picture = LoadPicture()
    DglbIndex = -1
  End If
  If DyxpIndex <> -1 Then
    DyxpImgs(DyxpIndex).Picture = LoadPicture()
    DyxpIndex = -1
  End If
  If LxgbIndex <> -1 Then
    LxgbImgs(LxgbIndex).Picture = LoadPicture()
    LxgbIndex = -1
  End If
  If HcgqIndex <> -1 Then
    HcgqImgs(HcgqIndex).Picture = LoadPicture()
    HcgqIndex = -1
  End If
  If FlgqIndex <> -1 Then
    FlgqImg(FlgqIndex).Picture = LoadPicture()
    FlgqIndex = -1
  End If
  If OneClassIndex <> -1 Then
    OneClassImg(OneClassIndex).Picture = LoadPicture()
    OneClassIndex = -1
  End If
End Sub

Private Sub ToolImg_Click(Index As Integer)
 Select Case Index
          Case 0
            If YCSDFlag = "L" Then
              LeftDVD
            Else
              RightDVD
            End If
          Case 1
            If YCSDFlag = "L" Then
              RightDVD
            Else
              LeftDVD
            End If
          Case 2
            StopDVD
            ContinuePlayDVD
          Case 3
            If PauseFlag Then
              PauseFlag = False
              ContinuePlayDVD
            Else
              PauseDVD
              PauseFlag = True
            End If
          Case 4
            StopDVD
          Case 5
            If XhFlag Then
              XhFlag = False
            Else
              XhFlag = True
            End If
          Case 6
            If MsgBox("您真的要退出飞鹤全自动点歌系统吗？", vbYesNo, "退出") = vbYes Then
              Timer2.Enabled = False
              RunEnd
            End If
  End Select
End Sub

Private Sub ToolImg_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  If ToolIndex <> Index Then
    If ToolIndex <> -1 Then
      ToolImg(ToolIndex).Picture = LoadPicture()
    End If
    Select Case Index
          Case 0
            ToolImg(0).Picture = LoadPicture(App.Path + "\Pic\原唱.bmp")
          Case 1
            ToolImg(1).Picture = LoadPicture(App.Path + "\Pic\伴唱.bmp")
          Case 2
            ToolImg(2).Picture = LoadPicture(App.Path + "\Pic\重唱.bmp")
          Case 3
            ToolImg(3).Picture = LoadPicture(App.Path + "\Pic\暂停.bmp")
          Case 4
            ToolImg(4).Picture = LoadPicture(App.Path + "\Pic\停唱.bmp")
          Case 5
            ToolImg(5).Picture = LoadPicture(App.Path + "\Pic\循环.bmp")
          Case 6
            ToolImg(6).Picture = LoadPicture(App.Path + "\Pic\关机.bmp")
    End Select
    ToolIndex = Index
  End If
End Sub

Private Sub YdgqImg_Click(Index As Integer)
  Select Case Index
      Case 0
        If YDGQList.ListItems.Count <> 0 Then
          YDGQList.SetFocus
          KlokYx YDGQList.SelectedItem.Text, YDGQList.SelectedItem.ListSubItems(1).Text, YDGQList.SelectedItem.ListSubItems(2).Text, YDGQList.SelectedItem.ListSubItems(3).Text, YDGQList.SelectedItem.ListSubItems(4).Text
        End If
      Case 1
        If YDGQList.ListItems.Count <> 0 Then
          YDGQList.SetFocus
          KlokDel YDGQList.SelectedItem.Text, YDGQList.SelectedItem.ListSubItems(1).Text, YDGQList.SelectedItem.ListSubItems(2).Text, YDGQList.SelectedItem.ListSubItems(3).Text, YDGQList.SelectedItem.ListSubItems(4).Text
        End If
      Case 2
        If YDGQList.ListItems.Count <> 0 Then
            YDGQList.SetFocus
            keybd_event 32, 0, 0, 0
            YDGQList.SetFocus
            keybd_event 38, 0, 0, 0
            YDGQList.SetFocus
            keybd_event 33, 0, 0, 0
        End If
      Case 3
        If YDGQList.ListItems.Count <> 0 Then
            YDGQList.SetFocus
            keybd_event 32, 0, 0, 0
            YDGQList.SetFocus
            keybd_event 40, 0, 0, 0
            YDGQList.SetFocus
            keybd_event 34, 0, 0, 0
        End If
  End Select
End Sub

Private Sub YdgqImg_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  If YdgqToolIndex <> Index Then
    If YdgqToolIndex <> -1 Then
      YdgqImg(YdgqToolIndex).Picture = LoadPicture()
    End If
    Select Case Index
          Case 0
            YdgqImg(0).Picture = LoadPicture(App.Path + "\Pic\优先.bmp")
          Case 1
            YdgqImg(1).Picture = LoadPicture(App.Path + "\Pic\删歌.bmp")
          Case 2
            YdgqImg(2).Picture = LoadPicture(App.Path + "\Pic\前一页.bmp")
          Case 3
            YdgqImg(3).Picture = LoadPicture(App.Path + "\Pic\后一页.bmp")
    End Select
    YdgqToolIndex = Index
  End If
End Sub

Private Sub ZmdgImg_Click(Index As Integer)
  ListItemShow "字母点歌", "Where Song_GMZS='" + Trim(Chr(65 + Index)) + "'"
End Sub

Private Sub ZmdgImg_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  If ZmgqIndex <> Index Then
    If ZmgqIndex <> -1 Then
      ZmdgImg(ZmgqIndex).Picture = LoadPicture()
    End If
    ZmdgImg(Index).Picture = LoadPicture(App.Path + "\Pic\" + Chr(65 + Index) + ".bmp")
    ZmgqIndex = Index
  End If
End Sub

Private Sub Timer2_Timer()
  If WelMsgLab.Left < -WelMsgLab.Width Then WelMsgLab.Left = 10800
  WelMsgLab.Left = WelMsgLab.Left - 3
  If IsPlayDVD Then
    IsPlayLab.Caption = PlayAudName
    If XhFlag Then
      XHLab.Caption = "循环开始"
    Else
      XHLab.Caption = "没有循环"
    End If
  Else
    IsPlayL