winampskin.bas

vb 写的播放器 对新的开发者很有用。写的不错。非常实际

Attribute VB_Name = "WinampSkin"

' **********************************************************************
'  描  述：存vb代码写的winnap程序，非常酷
'  Play78.com : 网站导航，源码之家，绝对开源
'  海阔天空收集整理
'  主站地址：http://www.play78.com/
'  源码下载地址：http://www.play78.com/blog
'  图片下在地址：http://www.play78.com/pic
'  QQ：13355575
'  e-mail:[e-mail]
'  编写日期：2005年08月30日
' **********************************************************************

Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Const SRCCOPY = &HCC0020

Public Mousenow As Boolean
Public X1 As Integer
Public X2 As Integer
Public Y1 As Integer
Public Y2 As Integer

'文件拖曳至列表
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Sub DragFinish Lib "shell32.dll" (ByVal HDROP As Long)
Public Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lplPhWnd As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_DROPFILES = &H233
Public lPhWnd As Long


Sub MouseDown(ByVal x As Integer, ByVal y As Integer)
Mousenow = True
X1 = x
Y1 = y
End Sub

Sub MouseMove(ByVal x As Integer, ByVal y As Integer, Frm As Form)
If Mousenow Then
 X2 = x
 Y2 = y
 If Frm.Caption = "Mainfrm" And Mainfrm.DragTogether2 = True Then '拖三个
  Frm.Left = Frm.Left + X2 - X1
  Frm.Top = Frm.Top + Y2 - Y1
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  Listfrm.Top = EQfrm.Top + EQfrm.Height
  EQfrm.Left = Mainfrm.Left
  Listfrm.Left = Mainfrm.Left
 ElseIf Frm.Caption = "Mainfrm" And Mainfrm.DragTogether1 = True Then '拖两个
  Frm.Left = Frm.Left + X2 - X1
  Frm.Top = Frm.Top + Y2 - Y1
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  EQfrm.Left = Mainfrm.Left
 Else '拖一个
  Frm.Left = Frm.Left + X2 - X1
  Frm.Top = Frm.Top + Y2 - Y1
 End If
End If
End Sub

Sub MouseUp()
Mousenow = False

If Abs(Mainfrm.Top + Mainfrm.Height - EQfrm.Top) < 600 And Abs(Mainfrm.Left - EQfrm.Left) < 600 Then
 EQfrm.Top = Mainfrm.Top + Mainfrm.Height
 EQfrm.Left = Mainfrm.Left
 Mainfrm.DragTogether1 = True
End If

If Abs(EQfrm.Top + EQfrm.Height - Listfrm.Top) < 600 And Abs(EQfrm.Left - Listfrm.Left) < 600 Then
 Listfrm.Top = EQfrm.Top + EQfrm.Height
 Listfrm.Left = EQfrm.Left
End If

If Abs(EQfrm.Top + EQfrm.Height - Listfrm.Top) < 600 And Abs(EQfrm.Left - Listfrm.Left) < 600 And Abs(Mainfrm.Top + Mainfrm.Height - EQfrm.Top) < 600 And Abs(Mainfrm.Left - EQfrm.Left) < 600 Then
 Listfrm.Top = EQfrm.Top + EQfrm.Height
 Listfrm.Left = EQfrm.Left
 Mainfrm.DragTogether2 = True
End If

If Abs(Mainfrm.Top + Mainfrm.Height - EQfrm.Top) >= 600 Or Abs(Mainfrm.Left - EQfrm.Left) >= 600 Then Mainfrm.DragTogether1 = False
If Abs(EQfrm.Top + EQfrm.Height - Listfrm.Top) >= 600 Or Abs(EQfrm.Left - Listfrm.Left) >= 600 Then Mainfrm.DragTogether2 = False

If Abs(Mainfrm.Top) - 500 < 0 Then
 Mainfrm.Top = 0
 If Mainfrm.DragTogether2 = True Then
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  EQfrm.Left = Mainfrm.Left
  Listfrm.Top = EQfrm.Top + EQfrm.Height
  Listfrm.Left = EQfrm.Left
 End If
 If Mainfrm.DragTogether1 = True Then
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  EQfrm.Left = Mainfrm.Left
 End If
End If

If Abs(Mainfrm.Left) - 500 < 0 Then
 Mainfrm.Left = 0
 If Mainfrm.DragTogether2 = True Then
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  EQfrm.Left = Mainfrm.Left
  Listfrm.Top = EQfrm.Top + EQfrm.Height
  Listfrm.Left = EQfrm.Left
 End If
 If Mainfrm.DragTogether1 = True Then
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  EQfrm.Left = Mainfrm.Left
 End If
End If

If Abs(7830 - Mainfrm.Left) < 500 Then
 Mainfrm.Left = 7830
 If Mainfrm.DragTogether2 = True Then
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  EQfrm.Left = Mainfrm.Left
  Listfrm.Top = EQfrm.Top + EQfrm.Height
  Listfrm.Left = EQfrm.Left
 End If
 If Mainfrm.DragTogether1 = True Then
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  EQfrm.Left = Mainfrm.Left
 End If
End If
If Abs(11220 - Mainfrm.Left) < 500 Then
 Mainfrm.Left = 11220
 If Mainfrm.DragTogether2 = True Then
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  EQfrm.Left = Mainfrm.Left
  Listfrm.Top = EQfrm.Top + EQfrm.Height
  Listfrm.Left = EQfrm.Left
 End If
 If Mainfrm.DragTogether1 = True Then
  EQfrm.Top = Mainfrm.Top + Mainfrm.Height
  EQfrm.Left = Mainfrm.Left
 End If
End If

End Sub

Sub MainfrmAct()
If Mainfrm.SimpleFlag1 = False Then
 BitBlt Mainfrm.Skin_TitleBar.hDC, 0, 0, 1600, 14, Mainfrm.Skin3.hDC, 27, 0, SRCCOPY
 Mainfrm.Skin_TitleBar.Refresh
Else
 BitBlt Mainfrm.Skin_TitleBar.hDC, 254, 3, 9, 9, Mainfrm.Skin3.hDC, 0, 18, SRCCOPY
 Mainfrm.Skin_TitleBar.Refresh
 BitBlt Mainfrm.Skin_TitleBar.hDC, 0, 0, 300, 14, Mainfrm.Skin3.hDC, 27, 29, SRCCOPY
 Mainfrm.Skin_TitleBar.Refresh
End If
End Sub

Sub ListfrmAct()
If Listfrm.SimpleFlag2 = False Then
 BitBlt Listfrm.Skin_PlayList1(0).hDC, 0, 0, 35, 22, Listfrm.Skin5.hDC, 0, 0, SRCCOPY
 Listfrm.Skin_PlayList1(0).Refresh
 BitBlt Listfrm.Skin_PlayList1(1).hDC, 0, 0, 35, 22, Listfrm.Skin5.hDC, 127, 0, SRCCOPY
 Listfrm.Skin_PlayList1(1).Refresh
 BitBlt Listfrm.Skin_PlayList1(2).hDC, 0, 0, 35, 22, Listfrm.Skin5.hDC, 127, 0, SRCCOPY
 Listfrm.Skin_PlayList1(2).Refresh
 BitBlt Listfrm.Skin_PlayList1(3).hDC, 0, 0, 35, 22, Listfrm.Skin5.hDC, 127, 0, SRCCOPY
 Listfrm.Skin_PlayList1(3).Refresh
 BitBlt Listfrm.Skin_PlayList1(4).hDC, 0, 0, 200, 22, Listfrm.Skin5.hDC, 26, 0, SRCCOPY
 Listfrm.Skin_PlayList1(4).Refresh
 BitBlt Listfrm.Skin_PlayList1(5).hDC, 0, 0, 35, 22, Listfrm.Skin5.hDC, 127, 0, SRCCOPY
 Listfrm.Skin_PlayList1(5).Refresh
 BitBlt Listfrm.Skin_PlayList1(6).hDC, 0, 0, 35, 22, Listfrm.Skin5.hDC, 127, 0, SRCCOPY
 Listfrm.Skin_PlayList1(6).Refresh
 BitBlt Listfrm.Skin_PlayList1(7).hDC, 0, 0, 35, 22, Listfrm.Skin5.hDC, 127, 0, SRCCOPY
 Listfrm.Skin_PlayList1(7).Refresh
 BitBlt Listfrm.Skin_PlayList1(8).hDC, 0, 0, 35, 22, Listfrm.Skin5.hDC, 153, 0, SRCCOPY
 Listfrm.Skin_PlayList1(8).Refresh
End If
End Sub

Sub EQfrmAct()
If EQfrm.SimpleFlag3 = False Then
 BitBlt EQfrm.EQTitle.hDC, 0, 0, 300, 20, EQfrm.Skin7.hDC, 0, 134, SRCCOPY
 EQfrm.EQTitle.Refresh
Else
 BitBlt EQfrm.EQTitle.hDC, 0, 0, 280, 20, EQfrm.Skin6.hDC, 0, 0, SRCCOPY
 EQfrm.EQTitle.Refresh
End If
End Sub
Sub ChangeSkin()
rc = BrowseForFolder(Mainfrm, "设置皮肤目录", Mainfrm.StartDir2)
If rc = "" Then Exit Sub

Mainfrm.StartDir2 = rc
Mainfrm.Text1 = rc
LoadSkin rc

WritePrivateProfileString "SETTING", "SkinDirectory", rc, App.Path & "\" & "Winamp.ini"
End Sub

Sub LoadSkin(ByVal SkinDir As String)
Mainfrm.Text2 = Mainfrm.Text1 & "\main.bmp"
If Dir(Mainfrm.Text2) <> "" Then
 Mainfrm.Skin1.Picture = LoadPicture(Mainfrm.Text2)
 Mainfrm.Skin_main.Picture = Mainfrm.Skin1.Picture
End If

Mainfrm.Text2 = Mainfrm.Text1 & "\cbuttons.bmp"
If Dir(Mainfrm.Text2) <> "" Then
 Mainfrm.Skin2.Picture = LoadPicture(Mainfrm.Text2)
 BitBlt Mainfrm.Skin_cbuttons1.hDC, 0, 0, 300, 20, Mainfrm.Skin2.hDC, 0, 0, SRCCOPY
 Mainfrm.Skin_cbuttons1.Refresh
 BitBlt Mainfrm.Skin_cbuttons2.hDC, 0, 0, 300, 20, Mainfrm.Skin2.hDC, 114, 0, SRCCOPY
 Mainfrm.Skin_cbuttons2.Refresh
End If

Mainfrm.Text2 = Mainfrm.Text1 & "\titlebar.bmp"
If Dir(Mainfrm.Text2) <> "" Then
 Mainfrm.Skin3.Picture = LoadPicture(Mainfrm.Text2)
 If Mainfrm.SimpleFlag1 = False Then
  BitBlt Mainfrm.Skin_TitleBar.hDC, 0, 0, 300, 14, Mainfrm.Skin3.hDC, 27, 0, SRCCOPY
  Mainfrm.Skin_TitleBar.Refresh
 Else
  BitBlt Mainfrm.Skin_TitleBar.hDC, 0, 0, 300, 14, Mainfrm.Skin3.hDC, 27, 29, SRCCOPY
  Mainfrm.Skin_TitleBar.Refresh
  Mainfrm.Height = 215
  Mainfrm.TitleBarButton(3).Visible = True
  Mainfrm.TitleBarButton(4).Visible = True
  Mainfrm.TitleBarButton(5).Visible = True
  Mainfrm.TitleBarButton(6).Visible = True
  Mainfrm.TitleBarButton(7).Visible = True
  Mainfrm.TitleBarButton(8).Visible = True
  Mainfrm.TitleBarButton(1).ToolTipText = "还原窗口模式"
 End If
 BitBlt Mainfrm.OAIDV.hDC, 0, 0, 10, 45, Mainfrm.Skin3.hDC, 305, 0, SRCCOPY
 Mainfrm.OAIDV.Refresh
End If

Mainfrm.Text2 = Mainfrm.Text1 & "\shufrep.bmp"
If Dir(Mainfrm.Text2) <> "" Then
 Mainfrm.Skin4.Picture = LoadPicture(Mainfrm.Text2)
 
 If Mainfrm.ShuffleFlag = True Then
  BitBlt Mainfrm.Skin_shuffle.hDC, 0, 0, 100, 20, Mainfrm.Skin4.hDC, 28, 0, SRCCOPY '关闭
  Mainfrm.Skin_shuffle.Refresh
  Mainfrm.Skin_shuffle.ToolTipText = "顺序播放"
 Else
  BitBlt Mainfrm.Skin_shuffle.hDC, 0, 0, 100, 20, Mainfrm.Skin4.hDC, 28, 30, SRCCOPY
  Mainfrm.Skin_shuffle.Refresh
  Mainfrm.Skin_shuffle.ToolTipText = "随机播放"
 End If
 
 If Mainfrm.RepFlag = True Then
  BitBlt Mainfrm.Skin_rep.hDC, 0, 0, 100, 20, Mainfrm.Skin4.hDC, 0, 0, SRCCOPY '关闭
  Mainfrm.Skin_rep.Refresh
  Mainfrm.Skin_rep.ToolTipText = "非循环播放"
 Else
  BitBlt Mainfrm.Skin_rep.hDC, 0, 0, 100, 20, Mainfrm.Skin4.hDC, 0, 30, SRCCOPY
  Mainfrm.Skin_rep.Refresh
  Mainfrm.Skin_rep.ToolTipText = "循环播放"
 End If