1 (изменено: Poltergeyst, 2019-04-08 00:57:08)

Тема: LangMF 9.0; VB.NET: воспроизведение DVD дисков

Без гарантий. Используете на свой страх и риск. Простой проигрыватель DVD дисков. Перед началом работы вставьте диск содержащий DVD контент в DVD привод. Запустите [DVDPlay.exe] и выберите привод содержащий вставленный диск. Красная кнопка формы предназначена для вызова меню воспроизведения. Выберите пункт "Мотор", чтобы начать воспроизведение DVD диска. Выберите пункт "Полноэкранный режим", чтобы изображение показывалось во весь экран. Нажмите ESC, чтобы вернуться в нормальный режим. Полоса прокрутки позволяет перейти в произвольное место фильма.

Потребуется установленный LangMF 9.0

ОС WinXP

Задействована библиотека MSWEBDVD.DLL поставляющая элемент управления [MSWebDVD.MSWebDVD.1]
В системе должен присутствовать аппаратный или программный декодер DVD.


'//Модуль//
'-----------------------------------------------------------------------------------------
<#Module=DVD>

 Public DVDPlayerObj
 Public VolumeDuration
 Public T1, T2
 Public Const VK_ESCAPE = &H1B
 Public Const BGCOLOR  = &Hc0c0c0
 Public Drive

Type RECT
x0 As Long
y0 As Long
x1 As Long
y1 As Long
End Type

'[Основная процедура скрипта]
'-----------------------------------------------------------------------------------------
Sub Load(cmdstr)
  
    '[Установка параметров формы выбора накопителя]
    '---------------------------------------------------------------------------------
    With ControlForm
        .Caption    = "Выберите DVD привод:"
        .Width = 200*vbPx
        .Height = 200*vbPy
        .BackColor   = BGCOLOR
        .Style.ToolWindow  = True
    '--------------------------------------------------------------------------------- 
    .Add "Command",10,"Top=100","Left=5","Width=185","Height=20", "Caption=""Продолжить"""
    .Add "Command",20,"Top=140","Left=5","Width=185","Height=20", "Caption=""Отмена"""
    .Add "CDrive",30,"Width=180","Top=25","Left=5","ToolTipText=""Выбор диска содержащего DVD контент"""
    '---------------------------------------------------------------------------------
    For Each Control In .Controls
        On Error Resume Next      
        Control.FontName  = "Arial"
        Control.FontSize  = 9
        Control.FontBold  = True
    Next
    '---------------------------------------------------------------------------------
    .Visible=True
        DoEvents
    End With
    '---------------------------------------------------------------------------------
End Sub

'[Создание форм воспроиведения и управления]
'-----------------------------------------------------------------------------------------
Sub InitDVD(Drive)

    '[Установка параметров формы воспроизведения DVD]
    '---------------------------------------------------------------------------------
    With DVDForm

            .AutoRedraw = True
        .Caption = "Проигрыватель DVD"
        .BackColor = BGCOLOR
        .Style.SizeBorder  = True
        .Style.ToolWindow  = True
    
    End With  
    DoEvents  
  
    '[Установка параметров формы управления]
    '---------------------------------------------------------------------------------
    With ControlForm

        On Error Resume Next
        
        .Visible = False
        .AutoRedraw = True
        .Width = 480*vbPx
        .Height = 50*vbPy
        .BackColor = BGCOLOR
        .Style.TitleBar = False
        '-------------------------------------------------------------------------
        .Add "CImage",1,"Width=35","Height=35","Top=5","Left=10","Appearance=0", _
        "ToolTipText=""Меню проигрывателя"""
        '-------------------------------------------------------------------------
        .Add "ProgressBar",1,"Left=55","Top=5","Width=270","Height=20", _
        "ToolTipText=""Прогресс воспроизведения"""
        '-------------------------------------------------------------------------
        .Add "HScroll"  ,1,"Left=55","Top=25","Width=270","Height=15","Min=0","Max=32767"
        '-------------------------------------------------------------------------
        .Add "Label",1, "Left=340","Top=5","Width=100","Height=20", _
            "Alignment=2","Caption= 00:00:00","FontSize=12", _
            "ToolTipText=""Полное время воспроизведения"""
        .Add "Label",2, "Left=340","Top=25","Width=100","Height=20", _
            "Alignment=2","Caption= 00:00:00","FontSize=12", _
            "ToolTipText=""Текущее время воспроизведения"""
        '-------------------------------------------------------------------------
        .Add "CTimer",1,"Left=0","Top=0"  '/Элемент таймера/
    
    '[Настройка главного меню]
    '---------------------------------------------------------------------------------
    .Menu.Add 1, "", "Menu1"
    .Menu.SubMenu("Menu1").PopUp = True
    .Menu.SubMenu("Menu1").Add 1,"Мотор"
    .Menu.SubMenu("Menu1").Add 2,"Пауза"
    .Menu.SubMenu("Menu1").Add 3,"Стоп"
    .Menu.SubMenu("Menu1").Add 4,"Заголовок диска"
    .Menu.SubMenu("Menu1").Add 5,"Выбор эпизода"
    .Menu.SubMenu("Menu1").Add 6,"Создать закладку"
    .Menu.SubMenu("Menu1").Add 7,"Перейти к закладке"
    .Menu.SubMenu("Menu1").Add 8,"Полноэкранный режим"
    .Menu.SubMenu("Menu1").Add 9,"Информация"
    .Menu.SubMenu("Menu1").Add 10,"Выход"


    '[Установка дополнительных параметров]
    '---------------------------------------------------------------------------------
    .Label(1).ForeColor = vbRed
    .Label(2).ForeColor = vbBlue
    .ProgressBar(1).BarBorder = 1
    
    '---------------------------------------------------------------------------------
    .CImage(1).Picture = LoadPicture(Sys.Path & "icon.gif")
    '---------------------------------------------------------------------------------
    .CTimer(1).Enabled = False
    .CTimer(1).Interval = 1000
    '---------------------------------------------------------------------------------
    DoEvents
    End With  
  
    '[Отображение форм]
    '---------------------------------------------------------------------------------
       Sys.Sleep(50)
    Sys.API.SetParent ControlForm.Hwnd, DVDForm.Hwnd  '/Окно управления принадлежит окну воспроизведения/
    DoEvents  
      
    DVDForm.Visible = True
    ControlForm.Visible = True  
    DoEvents  
    
    DVDForm.Left = 10 * vbPx
    DVDForm.Top = 10 * vbPy
    DVDForm.Width = 500 * vbPx
    DVDForm.Height = 500 * vbPy
    DoEvents
  
    ControlForm.Menu.Show 10 * vbPx,10 * vbPy
    DoEvents
    '---------------------------------------------------------------------------------

End Sub

'[Преобразование формата времени 00:00:00 в секунды]
'-----------------------------------------------------------------------------------------
Function ConvertTime(sTime)

    MTS1=CLng(Sys.Mid(sTime, 1, 2))
    MTS2=CLng(Sys.Mid(sTime, 4, 2))
    MTS3=CLng(Sys.Mid(sTime, 7, 2))

    ConvertTime=MTS1 * 3600 + MTS2 * 60 + MTS3

End Function
<#Module>

'//Форма управления//
'-----------------------------------------------------------------------------------------
<#Form=ControlForm>

    '[Обработка таймера]
    '---------------------------------------------------------------------------------   
    Sub CTimer1_Timer()

          On Error Resume Next

        '[Выход из полноэкранного режима]    
        '-------------------------------------------------------------------------
        If DVDPlayerObj.Object.FullScreenMode Then
            Res1 = Sys.DynApi.CallFunction( "USER32.DLL", "GetAsyncKeyState", VK_ESCAPE)
            If Res1 <> 0 Then DVDPlayerObj.Object.FullScreenMode = False
        End If

        '[Проверка состояния DVD контрола]    
        '-------------------------------------------------------------------------
        T1 = DVDPlayerObj.Object.CurrentTitle

        '/Смена фильма/
        If T1<>T2 Then 
            ControlForm.CTimer(1).Enabled = False
                TotalTime = DVDPlayerObj.Object.TotalTitleTime
                VolumeDuration = ConvertTime(TotalTime)
                ControlForm.Label(1).Caption = Sys.Left(TotalTime,8)
                ControlForm.ProgressBar(1).BarProcent = 0
            Sys.Sleep(100)
            ControlForm.CTimer(1).Enabled = True
        End If    

        '/Простановка текущего состояния/
        TimerStr = CStr(DVDPlayerObj.Object.CurrentTime)
        Tmr = ConvertTime(TimerStr)
        DoEvents
            ControlForm.Label(2).Caption = Sys.Left(TimerStr, Len(TimerStr)-3)
        DoEvents
            ControlForm.ProgressBar(1).BarProcent = Fix((Tmr/VolumeDuration)*100)
        DoEvents

        T2 = T1

    End Sub

    '[Переход в произвольное место воспроизведения]
    '-------------------------------------------------------------------------------------
    Sub HScroll1_Change()

    On Error Resume Next
    
        If DVDPlayerObj.Object.PlayState <> 2 Then ControlForm.HScroll(1).Value=0 : Exit Sub

        '[Выяснение временной метки]
        '-----------------------------------------------------------------------------
        sTime=(ControlForm.HScroll(1).Value * VolumeDuration)/32767

        MTS1 = Sys.Format(Int(sTime/3600),"0#")
        MTS2 = Sys.Format(Int((sTime-MTS1*3600)/60),"0#")
        MTS3 = Sys.Format(Int(sTime-MTS1*3600-MTS2*60),"0#")
        
        PlayTime=MTS1 & ":" & MTS2 & ":" & MTS3 & ":00"
        '-----------------------------------------------------------------------------
        ControlForm.ProgressBar(1).SetFocus
        DoEvents
        DVDPlayerObj.object.PlayAtTime PlayTime
        DoEvents
    
    End Sub
  
    '[Отображение основного меню воспроизведения]
    '-------------------------------------------------------------------------------------
    Sub CImage1_Click()
        ControlForm.Menu.SubMenu("Menu1").Show
    End Sub
  
    '[Действия пунктов меню]
    '-------------------------------------------------------------------------------------
    Sub Menu_Click(Id)

        On Error Resume Next
    
        Select Case Id
    
        '/Начало воспроизведения/
        '-----------------------------------------------------------------------------
        Case 1
            ControlForm.HScroll(1).Value=0
            DVDPlayerObj.Object.Play()
            DoEvents
            ControlForm.CTimer(1).Enabled = True
        Exit Sub      
        '/Пауза/
        '-----------------------------------------------------------------------------
        Case 2
            DVDPlayerObj.Object.Pause()
            DoEvents
            ControlForm.CTimer(1).Enabled = False
            Exit Sub      
        '/Стоп/
        '-----------------------------------------------------------------------------
        Case 3
            DVDPlayerObj.Object.Stop()
            DoEvents
            ControlForm.CTimer(1).Enabled = False
            Exit Sub
        '/Заголовок диска/
        '-----------------------------------------------------------------------------
        Case 4
            DVDPlayerObj.object.ShowMenu 2
            DoEvents
            ControlForm.CTimer(1).Enabled = True
            Exit Sub
        '/Выбор эпизода/
        '-----------------------------------------------------------------------------
        Case 5
            DVDPlayerObj.object.ShowMenu 3
            DoEvents
            ControlForm.CTimer(1).Enabled = True
            Exit Sub
        '/Создать закладку/
        '-----------------------------------------------------------------------------
        Case 6
            DVDPlayerObj.Object.SaveBookMark
            DoEvents
            Exit Sub
        '/Воспроизвести закладку/
        '-----------------------------------------------------------------------------
        Case 7
            DVDPlayerObj.Object.RestoreBookMark
            DoEvents
            ControlForm.CTimer(1).Enabled = True
            Exit Sub
        '/Переход в полноэкранный режим/
        '-----------------------------------------------------------------------------
        Case 8
            If DVDPlayerObj.Object.PlayState <> 2 Then Exit Sub
            MsgBox "Чтобы вернуться в нормальный режим нажмите [ESC]", _
                vbExclamation Or vbSystemModal,"Полный экран"
                DVDPlayerObj.object.FullScreenMode = True
            DoEvents
            ControlForm.CTimer(1).Enabled = True
            Exit Sub
        '/Информация/
        '-----------------------------------------------------------------------------
        Case 9
            MsgBox "DVD Unique ID:" & vbCR & vbCR & DVDPlayerObj.Object.DVDUniqueID, vbInformation Or vbSystemModal,"DVD"
        '/Завершение работы/
        '-----------------------------------------------------------------------------
        Case 10
            DVDForm.UnloadForm
        '-----------------------------------------------------------------------------
        End Select
    '-------------------------------------------------------------------------------------
    End Sub
  
    '[Проверка накопителя]
    '-------------------------------------------------------------------------------------
    Sub Command10_Click()

        Drive = ControlForm.CDrive(30).Drive
        If InStr(1, Drive, "\") Then Drive = Replace(Drive, "\", "")

            '/Проверка типа накопителя/
            '---------------------------------------------------------------------
            If Sys.File.GetDiskType(Drive) <> 5 Then _
                MsgBox "Данный привод не является накопителем CD/DVD.", _
                vbExclamation Or vbSystemModal,"Неправильно указан диск" :Exit Sub

            '/Поиск каталога DVD. Проверка на наличие носителя/
            '---------------------------------------------------------------------
            If Sys.File.IsDirFile(Drive & "\VIDEO_TS") Then

                ControlForm.Visible = False
                ControlForm.Remove "Command",10
                ControlForm.Remove "Command",20
                ControlForm.Remove "CDrive",30
                DoEvents
                InitDVD(Drive)
                DoEvents
      
            Else  '---------------------------------------------------------------
    
                iAnsw = MsgBox(  "В указанном приводе отсутствует диск содержащий DVD либо диск не опознан устройством. " & _
                "Открыть лоток?", vbExclamation Or vbSystemModal Or vbYesNo,"Диск не опознан")
                If iAnsw = vbYes Then Sys.DynApi.CallFunction "WINMM.DLL", "mciSendStringA", "set cdaudio door open", 0, 0, 0
    
            End If
            '---------------------------------------------------------------------
        End Sub
  
    '[Отмена работы]
    '-------------------------------------------------------------------------------------
    Sub Command20_Click()
        ControlForm.UnloadForm
    End Sub

      '[Завершение работы]
    '-------------------------------------------------------------------------------------
    Sub Form_Unload()
        EndMF
        DoEvents
    End Sub 
<#Form>


'//Форма управления//
'-----------------------------------------------------------------------------------------
<#Form=DVDForm>

    '[Создание DVD контрола и выбор каталога DVD (критичный момент)]
    '---------------------------------------------------------------------------------
    Sub Form_Load()
    
        On Error Resume Next
  
        '/Создание DVD контрола/
        '-------------------------------------------------------------------------
        Set DVDPlayerObj=DVDForm.CreateControl("MSWebDVD.MSWebDVD.1","DVDPlayer")
        DoEvents
        '-------------------------------------------------------------------------
        If Not IsObject(DVDPlayerObj) Then _
            MsgBox "Требуется объект MSWebDVD.MSWebDVD.1 либо не установлен аппаратный или программный декодер DVD.", _
            vbExclamation Or vbSystemModal, _
            "Ошибка DVD" : DVDForm.UnloadForm : Exit Sub
        '-------------------------------------------------------------------------
        DVDPlayerObj.Visible = True
        DVDPlayerObj.Object.BackColor = 0
        DoEvents
    
        '/Выбор каталога DVD/
        '-------------------------------------------------------------------------
        Err.Clear
        Sys.Sleep(100)
        DVDPlayerObj.Object.DVDDirectory=UCase(Drive) & "\VIDEO_TS"
        DoEvents
        '-------------------------------------------------------------------------
        If Err.Number<>0 Then
            MsgBox Err.Description, vbExclamation Or vbSystemModal,"Ошибка DVD"
            DVDForm.UnloadForm
            Exit Sub
        End If
        '-------------------------------------------------------------------------
    
    End Sub
  
    '[Корректировка размеров и позиций элементов управления при изменении размеров формы]
    '---------------------------------------------------------------------------------
    Sub Form_Resize()
  
        On Error Resume Next
  
        '-------------------------------------------------------------------------
        If DVDForm.Visible=True And DVDForm.WindowState = 0 Then

                Dim RECTANGLE As Rect
            res = Sys.DynApi.CallFunction(  "USER32.DLL", "GetClientRect", DVDForm.Hwnd, RECTANGLE)
            DVDPlayerObj.Move 5, 5, RECTANGLE.x1 - 10, RECTANGLE.y1 - 100
            DoEvents

            res = Sys.DynApi.CallFunction(  "USER32.DLL", "ClientToScreen", DVDForm.Hwnd, RECTANGLE)
            ControlForm.Move RECTANGLE.x0 + 10 * vbPx, RECTANGLE.y0 + (DVDPlayerObj.Height + 10) * vbPy
            DoEvents
            ControlForm.SetFocus()
        End If
        '--------------------------------------------------------------------------
    End Sub  

    '[Завершение работы]
    '----------------------------------------------------------------------------------
    Sub Form_Unload()

        On Error Resume Next

        Set DVDPlayerObj = Nothing
        DoEvents
        Sys.Sleep(300)

        ControlForm.UnloadForm

    End Sub 
    '-----------------------------------------------------------------------------------
<#Form>

2 (изменено: Poltergeyst, 2019-04-08 00:57:22)

Re: LangMF 9.0; VB.NET: воспроизведение DVD дисков

Без гарантий. Используете на свой страх и риск. Простой проигрыватель DVD дисков выполненный в среде VB.NET. Перед началом работы вставьте диск содержащий DVD контент в DVD привод. Запустите [DVDPlay.exe]. О назначении элементов управления окна можно судить по всплывающим подсказкам.

NET Framework v2.0.50727
OC WinME/XP

Задействована библиотека MSWEBDVD.DLL поставляющая элемент управления [MSWebDVD.MSWebDVD.1]. В системе должен присутствовать аппаратный или программный декодер DVD.

Чтобы получить исполняемый модуль откомпиллируйте файл DVDPlay.vb из прикрепленного архива примерно следующей командой:

C:\WINDOWS\Microsoft.NET\Framework\v2.0.50727\vbc.exe C:\...\DVDPlay.vb /out:C:\...\DVDPlay.exe /win32icon:C:\...\icon.ico /target:winexe

Последний раз прикрепленный архив обновлен 10.04.2010.

Post's attachments

netdvdplay21n.zip 21.95 kb, 213 downloads since 2009-06-21 

You don't have the permssions to download the attachments of this post.

3 (изменено: Poltergeyst, 2019-04-08 00:57:36)

Re: LangMF 9.0; VB.NET: воспроизведение DVD дисков

Без гарантий. Используете на свой страх и риск.

[на примере WinMe 4.90.3000]
Чтобы устранить неполадки которые могут возникнуть при воспроизведении DVD диска ("притормаживание" изображения, заедание звука) можно попробовать:

* Удалить дублирующие устройства CD/DVD приводов из разделов реестра:

 HKEY_LOCAL_MACHINE\Enum\SCSI\

 HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\CDROM\

Просмотрите содержимое подразделов и удалите ненужные ключи, которые сответствуют физически отсутствующим в системе устройствам. Это отключит обращение системы к несуществующим устройствам при работе DVD-привода.

* Включить DVD-приводу прямой доступ к памяти. "Мой компьютер" - "Свойства" - вкладка "Устройства" - пункт "Устройство чтения компакт дисков". На вкладке "Настройка" текущего устройства включите флажок DMA, после чего перезагрузите компьютер.

* Как правило, для работы DVD-привода не требуется каких-то специфических системных драйверов, как это свойственно многим устройствам - DVD-привод обычно  работает на обыкновенном стандартном драйвере компакт-диска. На самом деле, работа DVD-привода управляется его собственной прошивкой (Firmware), которая находится в перезаписываемой памяти этого устройства. Иногда может оказаться полезным обновить Firmware DVD-привода на более современную версию, т.е перепрошить привод. Разнообразные версии прошивок для DVD-приводов семейства Optiarc можно посмотреть например здесь: http://liggydee.cdfreaks.com/page/en/ - представлены прошивки для приводов Parallel-ATA так и для их Serial-ATA аналогов. Бесплатную утилиту Binflash, которая прошивает DVD-привод можно посмотреть здесь: http://binflash.cdfreaks.com/ - представлен как консольный, так и GUI-вариант утилиты.