Attribute VB_Name = "Module1"
Option Explicit

Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Public Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'以上API函數(shù)聲明，必須在同一行中結(jié)束

Public Const RGN_OR = 2      ' 或運(yùn)算,RGN_OR creates the union of combined regions
Public Const RGN_AND = 1     '和運(yùn)算
Public Const RGN_XOR = 3     '異或運(yùn)算
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2


Const ChangeBorder = 350  '邊框調(diào)整的附加值
Const FullBorder = 10000  '最大化時(shí)窗體的大小
 
Public PlPa As Boolean      '播放暫停控制
Public EndTimePos As Double '片長(zhǎng)自動(dòng)確認(rèn)
Public EndFramePos As Double '片中位圖數(shù)確認(rèn)
Public OldVolumn As Integer '存放聲音信息
Public CurTime As Integer   '快進(jìn)的時(shí)間設(shè)定
Public StartM As Boolean    '確定開始與否

Public mFormRegion As Long  '窗體存儲(chǔ)

Sub Main()
Controlfrm.Show
End Sub
Public Sub Centerform(Centerfrm As Form)  '自動(dòng)調(diào)節(jié)窗體中心
Dim I As Integer
On Error Resume Next
Centerfrm.Top = Screen.Height / 2 - Centerfrm.Height / 2
Centerfrm.Left = Screen.Width / 2 - Centerfrm.Width / 2
'調(diào)整內(nèi)部空間的相對(duì)位置,可置換
For I = 0 To Centerfrm.Controls.Count - 1
    Centerfrm.Controls(I).Top = 0
    Centerfrm.Controls(I).Left = 0
Next
End Sub

Public Sub PlayPbb()  '播放暫停控制
On Error Resume Next
 With Showfrm.Media1
     If PlPa Then
        .Pause     '圖形切換
     Else
        .Play      '播放,圖形切換為暫停
    End If
 End With
End Sub

Public Sub GoBackFor(NBol As Boolean) '快進(jìn)倒退控制
Dim TempPo As Double
On Error Resume Next
With Showfrm.Media1
  If NBol Then        '控制進(jìn)退
     TempPo = .CurrentPosition + CurTime
  Else
     TempPo = .CurrentPosition - CurTime
  End If
  
  If TempPo > EndTimePos Then
     TempPo = EndTimePos
     
  ElseIf TempPo < 0 Then
     TempPo = 0
  End If
  .CurrentPosition = TempPo
End With
End Sub

Public Sub ChangeSize(NNum As Integer) '屏幕置換函數(shù)
On Error Resume Next
With Showfrm.Media1
    Select Case NNum
    Case 0
        .DisplaySize = mpHalfSize   '50%
    Case 1
        .DisplaySize = mpDefaultSize '100%
    Case 2
        .DisplaySize = mpDoubleSize  '200%
    Case 3
        .DisplaySize = mpFullScreen  '全屏顯示
    End Select
    If NNum <> 3 Then
      Showfrm.Height = .Height + ChangeBorder
      Showfrm.Width = .Width
    Else
      .Width = Screen.Width + FullBorder
      .Height = Screen.Height + FullBorder
      Showfrm.Width = .Width
      Showfrm.Height = .Height
    End If
    Centerform Showfrm  '確認(rèn)窗體在中心位置顯示
End With
End Sub

Public Sub toggleFrame(FrmName As Form, OnPicture As PictureBox, OnCon As Boolean)
    Dim mEll As Long
    On Error Resume Next
    mFormRegion = CreateEllipticRgn(0, 0, FrmName.Width / Screen.TwipsPerPixelX, FrmName.Height / Screen.TwipsPerPixelY)
       ' Put width/height in same denomination of scalewidth/scaleheight
    If OnCon Then
       With OnPicture
       mEll = CreateEllipticRgn(.Left / Screen.TwipsPerPixelX, .Top / Screen.TwipsPerPixelY, (.Left + .Width) / Screen.TwipsPerPixelX, (.Top + .Height) / Screen.TwipsPerPixelY)
       End With
       CombineRgn mFormRegion, mEll, mFormRegion, RGN_XOR  '異或處理
    End If
       ' We allow toggle
    SetWindowRgn FrmName.hwnd, mFormRegion, True
End Sub


Public Sub CirclePic(Source As Form)   '圖形做圓處理
Dim hr&
Dim usew&, useh&
Dim I
On Error Resume Next
For I = 0 To Source.Controls.Count - 1      '對(duì)每個(gè)控件做圓形處理
    useh& = Source.Controls(I).Height / Screen.TwipsPerPixelY
    usew& = useh&
    hr& = CreateEllipticRgn(0, 0, usew, useh)
    SetWindowRgn Source.Controls(I).hwnd, hr, True
Next
End Sub