module1.bas

毕业设计

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函数声明，必须在同一行中结束

Public Const RGN_OR = 2      ' 或运算,RGN_OR creates the union of combined regions
Public Const RGN_AND = 1     '和运算
Public Const RGN_XOR = 3     '异或运算
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2


Const ChangeBorder = 350  '边框调整的附加值
Const FullBorder = 10000  '最大化时窗体的大小
 
Public PlPa As Boolean      '播放暂停控制
Public EndTimePos As Double '片长自动确认
Public EndFramePos As Double '片中位图数确认
Public OldVolumn As Integer '存放声音信息
Public CurTime As Integer   '快进的时间设定
Public StartM As Boolean    '确定开始与否

Public mFormRegion As Long  '窗体存储

Sub Main()
Controlfrm.Show
End Sub
Public Sub Centerform(Centerfrm As Form)  '自动调节窗体中心
Dim I As Integer
On Error Resume Next
Centerfrm.Top = Screen.Height / 2 - Centerfrm.Height / 2
Centerfrm.Left = Screen.Width / 2 - Centerfrm.Width / 2
'调整内部空间的相对位置,可置换
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) '快进倒退控制
Dim TempPo As Double
On Error Resume Next
With Showfrm.Media1
  If NBol Then        '控制进退
     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) '屏幕置换函数
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  '确认窗体在中心位置显示
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      '对每个控件做圆形处理
    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