www.pudn.com > SuperDLL2.zip > frmMCI.frm
VERSION 5.00
Object = "{FE0065C0-1B7B-11CF-9D53-00AA003C9CB6}#1.1#0"; "COMCT232.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMCI
BackColor = &H80000003&
BorderStyle = 1 'Fixed Single
Caption = "DirectShow MCI Media Player"
ClientHeight = 3720
ClientLeft = 150
ClientTop = 720
ClientWidth = 4695
Icon = "frmMCI.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3720
ScaleWidth = 4695
StartUpPosition = 3 'Windows Default
Begin MSComDlg.CommonDialog cm1
Left = 1080
Top = 120
_ExtentX = 688
_ExtentY = 688
_Version = 393216
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 250
Left = 600
Top = 120
End
Begin VB.PictureBox Picture1
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 492
Left = 0
ScaleHeight = 495
ScaleWidth = 495
TabIndex = 8
TabStop = 0 'False
Top = 0
Visible = 0 'False
Width = 492
End
Begin VB.Frame Frame1
BorderStyle = 0 'None
Height = 2412
Left = 0
TabIndex = 9
Top = 600
Width = 3852
Begin VB.CommandButton Command1
Caption = "RESET"
BeginProperty Font
Name = "Small Fonts"
Size = 6
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 252
Left = 140
TabIndex = 1
Top = 780
Width = 612
End
Begin VB.TextBox Text1
Alignment = 2 'Center
Height = 288
Left = 120
Locked = -1 'True
TabIndex = 15
TabStop = 0 'False
Text = "100"
Top = 480
Width = 408
End
Begin ComCtl2.UpDown UpDown1
Height = 288
Left = 528
TabIndex = 0
Top = 480
Width = 252
_ExtentX = 423
_ExtentY = 503
_Version = 327681
Value = 100
BuddyControl = "Text1"
BuddyDispid = 196613
OrigLeft = 541
OrigTop = 600
OrigRight = 793
OrigBottom = 852
Increment = 5
Max = 200
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin ComctlLib.Slider Slider1
Height = 612
Left = 120
TabIndex = 7
Top = 1680
Width = 3612
_ExtentX = 6376
_ExtentY = 1085
_Version = 327682
LargeChange = 10
SmallChange = 5
Max = 100
TickStyle = 2
TickFrequency = 10
End
Begin VB.PictureBox Picture6
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 360
Left = 2640
Picture = "frmMCI.frx":08CA
ScaleHeight = 360
ScaleWidth = 600
TabIndex = 6
Top = 1200
Width = 600
End
Begin VB.PictureBox Picture5
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 360
Left = 2160
Picture = "frmMCI.frx":10CC
ScaleHeight = 360
ScaleWidth = 600
TabIndex = 5
Top = 1200
Width = 600
End
Begin VB.PictureBox Picture4
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 360
Left = 1680
Picture = "frmMCI.frx":18CE
ScaleHeight = 360
ScaleWidth = 600
TabIndex = 4
Top = 1200
Width = 600
End
Begin VB.PictureBox Picture3
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 360
Left = 1200
Picture = "frmMCI.frx":2450
ScaleHeight = 360
ScaleWidth = 600
TabIndex = 3
Top = 1200
Width = 600
End
Begin VB.PictureBox Picture2
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 360
Left = 720
Picture = "frmMCI.frx":2C52
ScaleHeight = 360
ScaleWidth = 600
TabIndex = 2
Top = 1200
Width = 600
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "SPEED"
BeginProperty Font
Name = "Small Fonts"
Size = 6.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 156
Left = 240
TabIndex = 14
Top = 270
Width = 480
End
Begin VB.Label Label4
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "frames"
BeginProperty Font
Name = "Courier New"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 360
Left = 960
TabIndex = 13
Top = 720
Width = 1908
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "0"
BeginProperty Font
Name = "Courier New"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 240
Left = 960
TabIndex = 12
Top = 480
Width = 1908
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H00000000&
Caption = "0"
BeginProperty Font
Name = "Courier New"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 240
Left = 960
TabIndex = 11
Top = 240
Width = 1908
End
Begin VB.Label Label3
Alignment = 2 'Center
BackColor = &H00000000&
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 120
Left = 960
TabIndex = 10
Top = 120
Width = 1908
End
End
Begin ComctlLib.ImageList ImageList1
Left = 1680
Top = 120
_ExtentX = 794
_ExtentY = 794
BackColor = -2147483643
ImageWidth = 40
ImageHeight = 24
MaskColor = 12632256
UseMaskColor = 0 'False
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 16
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":3454
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":3C66
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":4478
Key = ""
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":4C8A
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":549C
Key = ""
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":5CAE
Key = ""
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":64C0
Key = ""
EndProperty
BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":6CD2
Key = ""
EndProperty
BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":74E4
Key = ""
EndProperty
BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":8076
Key = ""
EndProperty
BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":8C08
Key = ""
EndProperty
BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":941A
Key = ""
EndProperty
BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":9C2C
Key = ""
EndProperty
BeginProperty ListImage14 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":A43E
Key = ""
EndProperty
BeginProperty ListImage15 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":AC50
Key = ""
EndProperty
BeginProperty ListImage16 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmMCI.frx":B462
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu mfile
Caption = "&File"
Begin VB.Menu mopen
Caption = "&Open"
End
Begin VB.Menu mclose
Caption = "&Close"
End
Begin VB.Menu mexit
Caption = "E&xit"
End
End
Begin VB.Menu mpopup
Caption = "Popup"
Visible = 0 'False
Begin VB.Menu mStart
Caption = "&Auto Start"
Checked = -1 'True
End
Begin VB.Menu mrepeat
Caption = "&Repeat"
Checked = -1 'True
End
Begin VB.Menu mme1
Caption = "-"
End
Begin VB.Menu mhalf
Caption = "Zoom 50%"
End
Begin VB.Menu mone
Caption = "Zoom 100%"
End
Begin VB.Menu m1andhalf
Caption = "Zoom 150%"
Checked = -1 'True
End
Begin VB.Menu mtwo
Caption = "Zoom 200%"
End
Begin VB.Menu mme2
Caption = "-"
End
Begin VB.Menu mfull
Caption = "FULL&SCREEN"
End
End
End
Attribute VB_Name = "frmMCI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mmf As mciFile
Dim zxc As Long
Dim div As Integer
Dim MULT As Single
Dim zWidth As Integer
Dim zHeight As Integer
Dim zStatus As Variant
Dim ZSH As Long
Dim FirstCancel As Boolean
Dim var1 As Boolean
Private Sub OpenFile()
Dim az As Integer
Picture1.Width = 0
Picture1.Height = 0
Frame1.Width = 3852
If MciCommand("open", mmf, , Picture1, var1) Then
Slider1.Enabled = True
Label4.Caption = MciCommand("gettimeformat", mmf)
div = 1
While mmf.mLength / div >= 10000
div = div * 10
Wend
zHeight = mmf.mHeight * MULT
zWidth = mmf.mWidth * MULT
MoveMCI mmf, 0, 0, zWidth, zHeight
Slider1.Max = CLng(mmf.mLength / div)
Slider1.TickFrequency = CLng((mmf.mLength / 10) / div)
Slider1.LargeChange = CLng((mmf.mLength / 10) / div)
Slider1.SmallChange = CLng((mmf.mLength / 20) / div)
If Label4.Caption = "milliseconds" Then
Label1.Caption = msToHMS(mmf.mLength)
Label2.Caption = msToHMS(0)
Else
Label1.Caption = CLng(mmf.mLength / div)
If div <> 1 Then Label1.Caption = Label1.Caption & " x " & div
Label2.Caption = String(Len(CStr(CLng(mmf.mLength / div))), "0")
If div <> 1 Then Label2.Caption = Label2.Caption & " x " & div
End If
If mmf.IsVideo Then
Picture1.Visible = True
Picture1.Width = zWidth * Screen.TwipsPerPixelX
Picture1.Height = zHeight * Screen.TwipsPerPixelY
Frame1.Top = (zHeight * Screen.TwipsPerPixelY) + 1
Me.Height = (zHeight * Screen.TwipsPerPixelY) + Frame1.Height + ZSH
mme1.Visible = True
mhalf.Visible = True
mone.Visible = True
m1andhalf.Visible = True
mtwo.Visible = True
mme2.Visible = True
mfull.Visible = True
Else
Picture1.Visible = False
Picture1.Width = 0
Picture1.Height = 0
Frame1.Top = 0
Me.Height = Frame1.Height + ZSH
mme1.Visible = False
mhalf.Visible = False
mone.Visible = False
m1andhalf.Visible = False
mtwo.Visible = False
mme2.Visible = False
mfull.Visible = False
End If
If Picture1.Width > Frame1.Width Then
Me.Width = Picture1.Width + 60
Else
Me.Width = Frame1.Width + 60
End If
Frame1.Width = Me.Width - 60
Slider1.Width = Frame1.Width - 240
Label1.Left = (Frame1.Width - Label1.Width) / 2
Label2.Left = (Frame1.Width - Label2.Width) / 2
Label3.Left = (Frame1.Width - Label3.Width) / 2
Label4.Left = (Frame1.Width - Label4.Width) / 2
For az = Len(mmf.mfile) To 1 Step -1
If Mid$(mmf.mfile, az, 1) = "\" Then Exit For
Next az
Me.Caption = Mid$(mmf.mfile, az + 1)
Picture4.Left = (Frame1.Width - Picture4.Width) / 2
Picture3.Left = Picture4.Left - Picture3.Width
Picture5.Left = Picture4.Left + Picture4.Width
Picture2.Left = Picture3.Left - Picture2.Width
Picture6.Left = Picture5.Left + Picture5.Width
Text1.Left = (Label1.Left - (Text1.Width + UpDown1.Width)) / 2
UpDown1.Left = Text1.Left + Text1.Width + 1
Label6.Left = ((Label1.Left - Label6.Width) / 2) - 30
Me.Left = (Screen.Width - Me.Width) / 2.25
Me.Top = (Screen.Height - Me.Height) / 2.5
Command1.Left = Text1.Left + 30
Command1.Top = Text1.Top + Text1.Height + 20
Else
End
End If
End Sub
Private Sub Command1_Click()
UpDown1.Value = 100
MciCommand "setspeed", mmf, Val(Text1.Text)
End Sub
Private Sub Form_Activate()
If FirstCancel = True Then Unload Me
End Sub
Private Sub Form_Load()
ZSH = CalcTopBorderHeight(Me)
MULT = 1.5
If isNT2000XP Then
SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\MCI32", "SuperMCI", "mciqtz32.dll"
var1 = True
Else
var1 = False
End If
CloseMCI
cm1.InitDir = AppPath(GetWindowsDir) & "media"
cm1.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly Or cdlOFNReadOnly
cm1.Filter = "All Media Files|*.wav;*.mid;*.rmi;*.mp3;*.avi;*.mpg;*.mpeg;*.ac3;*.dat;*.asf;*.wmv;*.mpv2;*.mpv;*.mpe;*.mp2v;*.m1v;*.dts;*.ogg;*.ogm;*.mp4;*.m4a;*.m4v;*.mp4v;*.wma;*.m2v;*.mp2;*.mpa|All Files|*.*"
cm1.ShowOpen
If cm1.FileName = "" Then
FirstCancel = True
Else
FirstCancel = False
mmf.mfile = cm1.FileName
OpenFile
If mStart.Checked Then Picture3_MouseUp 1, 0, 1, 1
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
CloseMCI
frmMenu.Show
End Sub
Private Sub Frame1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Me.PopupMenu mpopup
End Sub
Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Me.PopupMenu mpopup
End Sub
Private Sub Label2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Me.PopupMenu mpopup
End Sub
Private Sub Label3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Me.PopupMenu mpopup
End Sub
Private Sub Label4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Me.PopupMenu mpopup
End Sub
Private Sub Label6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Me.PopupMenu mpopup
End Sub
Private Sub mclose_Click()
Timer1.Enabled = False
MciCommand "close", mmf
Slider1.Value = 0
Label1.Caption = 0
Label2.Caption = 0
Picture1.Visible = False
Slider1.Enabled = False
Frame1.Top = 0
Frame1.Width = 3852
Me.Height = Frame1.Height + 750
Me.Width = Frame1.Width + 60
Label1.Left = (Frame1.Width - Label1.Width) / 2
Label2.Left = (Frame1.Width - Label2.Width) / 2
Label3.Left = (Frame1.Width - Label3.Width) / 2
Label4.Left = (Frame1.Width - Label4.Width) / 2
Picture4.Left = (Frame1.Width - Picture4.Width) / 2
Picture3.Left = (Picture4.Left - Picture3.Width) - 1
Picture5.Left = (Picture4.Left + Picture4.Width) + 1
Picture2.Left = (Picture3.Left - Picture2.Width) - 1
Picture6.Left = (Picture5.Left + Picture5.Width) + 1
Slider1.Width = Frame1.Width - 240
Me.Caption = "DirectShow MCI Media Player"
Label4.Caption = ""
Text1.Left = (Label1.Left - (Text1.Width + UpDown1.Width)) / 2
UpDown1.Left = Text1.Left + Text1.Width + 1
Label6.Left = ((Label1.Left - Label6.Width) / 2) - 30
Me.Left = (Screen.Width - Me.Width) / 2.25
Me.Top = (Screen.Height - Me.Height) / 2.5
Command1.Left = Text1.Left + 30
Command1.Top = Text1.Top + Text1.Height + 20
End Sub
Private Sub mexit_Click()
Unload Me
End Sub
Private Sub mfull_Click()
If mfull.Checked Then
mfull.Checked = False
Exit Sub
Else
mfull.Checked = True
If MciCommand("getstatus", mmf) = "playing" Then MciCommand "fullscreen", mmf
Exit Sub
End If
End Sub
Private Sub mopen_Click()
cm1.InitDir = ""
cm1.FileName = ""
cm1.ShowOpen
If cm1.FileName <> "" Then
mclose_Click
mmf.mfile = cm1.FileName
OpenFile
If mStart.Checked Then
Picture3_MouseUp 1, 1, 1, 1
If mmf.IsVideo And mfull.Checked Then
Sleep 100
MciCommand "fullscreen", mmf
End If
End If
End If
End Sub
Private Sub mrepeat_Click()
If mrepeat.Checked = True Then
mrepeat.Checked = False
Exit Sub
Else
mrepeat.Checked = True
Exit Sub
End If
End Sub
Private Sub mStart_Click()
If mStart.Checked = True Then
mStart.Checked = False
Exit Sub
Else
mStart.Checked = True
Exit Sub
End If
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Picture2.Picture = ImageList1.ListImages(16).Picture
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If X >= 0 And Y >= 0 And X <= Picture2.Width And Y <= Picture2.Height Then
Timer1.Enabled = False
MciCommand "stop", mmf
Slider1.Value = 0
If Label4.Caption = "milliseconds" Then
Label2.Caption = msToHMS(0)
Else
Label2.Caption = String(Len(CStr(CLng(mmf.mLength / div))), "0")
If div <> 1 Then Label2.Caption = Label2.Caption & " x " & div
End If
End If
Picture2.Picture = ImageList1.ListImages(15).Picture
End If
End Sub
Private Sub Picture3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Picture3.Picture = ImageList1.ListImages(12).Picture
End Sub
Private Sub Picture3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If X >= 0 And Y >= 0 And X <= Picture3.Width And Y <= Picture3.Height Then
If Val(Text1.Text) <> 100 Then MciCommand "setspeed", mmf, Val(Text1.Text)
MciCommand "play", mmf
If mmf.IsVideo And mfull.Checked And Shift <> 1 Then MciCommand "fullscreen", mmf
Timer1.Enabled = True
End If
Picture3.Picture = ImageList1.ListImages(11).Picture
End If
End Sub
Private Sub Picture4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Picture4.Picture = ImageList1.ListImages(10).Picture
End Sub
Private Sub Picture4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If X >= 0 And Y >= 0 And X <= Picture4.Width And Y <= Picture4.Height Then
MciCommand "pause", mmf
If mmf.IsVideo And mfull.Checked Then
If MciCommand("getstatus", mmf) = "playing" Then MciCommand "fullscreen", mmf
End If
Timer1.Enabled = True
End If
Picture4.Picture = ImageList1.ListImages(9).Picture
End If
End Sub
Private Sub Picture5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Picture5.Picture = ImageList1.ListImages(4).Picture
End Sub
Private Sub Picture5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If X >= 0 And Y >= 0 And X <= Picture5.Width And Y <= Picture5.Height Then
Timer1.Enabled = False
zxc = MciCommand("stepback", mmf, div)
Slider1.Value = CLng(zxc / div)
If Label4.Caption = "milliseconds" Then
Label2.Caption = msToHMS(zxc)
Else
Label2.Caption = String(Len(CStr(CLng(mmf.mLength / div))) - Len(CStr(CLng(zxc / div))), "0") & CLng(zxc / div)
If div <> 1 Then Label2.Caption = Label2.Caption & " x " & div
End If
End If
Picture5.Picture = ImageList1.ListImages(3).Picture
End If
End Sub
Private Sub Picture6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Picture6.Picture = ImageList1.ListImages(6).Picture
End Sub
Private Sub Picture6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If X >= 0 And Y >= 0 And X <= Picture6.Width And Y <= Picture6.Height Then
Timer1.Enabled = False
zxc = MciCommand("step", mmf, div)
Slider1.Value = CLng(zxc / div)
If Label4.Caption = "milliseconds" Then
Label2.Caption = msToHMS(zxc)
Else
Label2.Caption = String(Len(CStr(CLng(mmf.mLength / div))) - Len(CStr(CLng(zxc / div))), "0") & CLng(zxc / div)
If div <> 1 Then Label2.Caption = Label2.Caption & " x " & div
End If
End If
Picture6.Picture = ImageList1.ListImages(5).Picture
End If
End Sub
Private Sub Slider1_KeyUp(KeyCode As Integer, Shift As Integer)
SSS
End Sub
Private Sub Slider1_Scroll()
SSS
End Sub
Private Sub Text1_GotFocus()
UpDown1.SetFocus
End Sub
Private Sub Timer1_Timer()
zxc = MciCommand("getpos", mmf)
zStatus = MciCommand("getstatus", mmf)
Slider1.Value = CLng(zxc / div)
If Label4.Caption = "milliseconds" Then
Label2.Caption = msToHMS(zxc)
Else
Label2.Caption = String(Len(CStr(CLng(mmf.mLength / div))) - Len(CStr(CLng(zxc / div))), "0") & CLng(zxc / div)
If div <> 1 Then Label2.Caption = Label2.Caption & " x " & div
End If
If zxc > 0 And zStatus = "stopped" Then
MciCommand "resume", mmf
End If
If zxc >= mmf.mLength And zStatus <> "paused" Then
Timer1.Enabled = False
MciCommand "close", mmf
Slider1.Value = 0
If Label4.Caption = "milliseconds" Then
Label2.Caption = msToHMS(0)
Else
Label2.Caption = String(Len(CStr(CLng(mmf.mLength / div))), "0")
If div <> 1 Then Label2.Caption = Label2.Caption & " x " & div
End If
If MciCommand("open", mmf, , Picture1, var1) Then
MoveMCI mmf, 0, 0, zWidth, zHeight
Else
mclose_Click
Exit Sub
End If
If mrepeat.Checked Then
Picture3_MouseUp 1, 1, 1, 1
If mmf.IsVideo And mfull.Checked Then
Sleep 100
MciCommand "fullscreen", mmf
End If
End If
End If
End Sub
Private Sub SSS()
Timer1.Enabled = False
If Label4.Caption = "milliseconds" Then
Label2.Caption = msToHMS(Slider1.Value * div)
Else
Label2.Caption = String(Len(CStr(CLng(mmf.mLength / div))) - Len(CStr(Slider1.Value)), "0") & Slider1.Value
If div <> 1 Then Label2.Caption = Label2.Caption & " x " & div
End If
MciCommand "seek", mmf, Slider1.Value * div
Timer1.Enabled = True
End Sub
Private Sub mhalf_Click()
MULT = 0.5
ChangeSize
mhalf.Checked = True
mone.Checked = False
m1andhalf.Checked = False
mtwo.Checked = False
End Sub
Private Sub mone_Click()
MULT = 1
ChangeSize
mhalf.Checked = False
mone.Checked = True
m1andhalf.Checked = False
mtwo.Checked = False
End Sub
Private Sub m1andhalf_Click()
MULT = 1.5
ChangeSize
mhalf.Checked = False
mone.Checked = False
m1andhalf.Checked = True
mtwo.Checked = False
End Sub
Private Sub mtwo_Click()
MULT = 2
ChangeSize
mhalf.Checked = False
mone.Checked = False
m1andhalf.Checked = False
mtwo.Checked = True
End Sub
Private Sub ChangeSize()
Frame1.Top = 0
Frame1.Width = 3852
Me.Height = Frame1.Height + 750
Me.Width = Frame1.Width + 60
Label1.Left = (Frame1.Width - Label1.Width) / 2
Label2.Left = (Frame1.Width - Label2.Width) / 2
Label3.Left = (Frame1.Width - Label3.Width) / 2
Label4.Left = (Frame1.Width - Label4.Width) / 2
Picture4.Left = (Frame1.Width - Picture4.Width) / 2
Picture3.Left = (Picture4.Left - Picture3.Width) - 1
Picture5.Left = (Picture4.Left + Picture4.Width) + 1
Picture2.Left = (Picture3.Left - Picture2.Width) - 1
Picture6.Left = (Picture5.Left + Picture5.Width) + 1
Slider1.Width = Frame1.Width - 240
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
zHeight = mmf.mHeight * MULT
zWidth = mmf.mWidth * MULT
MoveMCI mmf, 0, 0, zWidth, zHeight
Picture1.Width = zWidth * Screen.TwipsPerPixelX
Picture1.Height = zHeight * Screen.TwipsPerPixelY
Frame1.Top = (zHeight * Screen.TwipsPerPixelY) + 1
Me.Height = (zHeight * Screen.TwipsPerPixelY) + Frame1.Height + ZSH
If Picture1.Width > Frame1.Width Then
Me.Width = Picture1.Width + 60
Else
Me.Width = Frame1.Width + 60
End If
Frame1.Width = Me.Width - 60
Slider1.Width = Frame1.Width - 240
Label1.Left = (Frame1.Width - Label1.Width) / 2
Label2.Left = (Frame1.Width - Label2.Width) / 2
Label3.Left = (Frame1.Width - Label3.Width) / 2
Label4.Left = (Frame1.Width - Label4.Width) / 2
Picture4.Left = (Frame1.Width - Picture4.Width) / 2
Picture3.Left = Picture4.Left - Picture3.Width
Picture5.Left = Picture4.Left + Picture4.Width
Picture2.Left = Picture3.Left - Picture2.Width
Picture6.Left = Picture5.Left + Picture5.Width
Text1.Left = (Label1.Left - (Text1.Width + UpDown1.Width)) / 2
UpDown1.Left = Text1.Left + Text1.Width + 1
Label6.Left = ((Label1.Left - Label6.Width) / 2) - 30
Me.Left = (Screen.Width - Me.Width) / 2.25
Me.Top = (Screen.Height - Me.Height) / 2.5
Command1.Left = Text1.Left + 30
Command1.Top = Text1.Top + Text1.Height + 20
End Sub
Private Sub UpDown1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then MciCommand "setspeed", mmf, Val(Text1.Text)
End Sub
Private Function CalcTopBorderHeight(zForm As Form) As Long
Dim SM As Integer
SM = zForm.ScaleMode
zForm.ScaleMode = vbTwips
zForm.Height = 750
If zForm.ScaleHeight > 0 Then
Do
zForm.Height = zForm.Height - 1
Loop Until zForm.ScaleHeight < 1
Else
Do
zForm.Height = zForm.Height + 1
Loop Until zForm.ScaleHeight > 0
zForm.Height = zForm.Height - 1
End If
CalcTopBorderHeight = Me.Height
zForm.ScaleMode = SM
End Function
Private Function msToHMS(ByVal Milliseconds As Long) As String
Dim vHrs As Double, vMin As Double, vSec As Double, vMS As Double
Dim sHrs As String, sMin As String, sSec As String, sMS As String
vHrs = (((Milliseconds / 1000) / 60) / 60)
vMin = (vHrs - Int(vHrs)) * 60
vSec = (vMin - Int(vMin)) * 60
vMS = (vSec - Int(vSec))
sHrs = CStr(Int(vHrs))
If Len(sHrs) = 1 Then sHrs = "0" & sHrs
sMin = CStr(Int(vMin))
If Len(sMin) = 1 Then sMin = "0" & sMin
sSec = CStr(Int(vSec))
If Len(sSec) = 1 Then sSec = "0" & sSec
sMS = Mid(CStr(vMS), 3, 3)
sMS = sMS & String(3 - Len(sMS), "0")
msToHMS = sHrs & ":" & sMin & ":" & sSec & "," & sMS
End Function