| 
				
				Видео в игре
				 |   |  
| Lorderon | Дата: Суббота, 03 Июля 2010, 15:29 | Сообщение # 1 |  
| 
 старожил 
Сейчас нет на сайте 
 
 | У меня два срочных вопроса: можно ли в визуал бэйсике вставить просмотр аvi файлов? Стандартный лабел надпись и у этой надписи есть свой подцвет - рамачка в которой она. Так вот как эту рамку убрать? А, кстати ещё вопросик, как програмно изменить разрешение экрана? Ну и ещё один: кай запрограммировать построчное чтение? Просьба на все вопросы отвечать соответствующим кодом. Заранее спасибо!
 |  
| 
 | 
 |    |  
| 67boy | Дата: Суббота, 12 Февраля 2011, 22:51 | Сообщение # 2 |  
 
заслуженный участник 
Сейчас нет на сайте 
 
 | Lorderon, На счет аvi не знаю, но флеш точно можно!!!!Вспомню скажу!!!
 
  
 
 Сообщение отредактировал 67boy - Суббота, 12 Февраля 2011, 23:44  |  
| 
 | 
 |    |  
| LunarPixel | Дата: Суббота, 12 Февраля 2011, 23:25 | Сообщение # 3 |  
 
старожил 
Сейчас нет на сайте 
 
 | Проигрывание видео (если не ошибаюсь):    Code WindowsMediaPlayer1.URL = "video.avi"   WindowsMediaPlayer1.Controls.Play    Изменение разрешения экрана:   Вот тут 
 
  
 |  
| 
 | 
 |    |  
| 67boy | Дата: Суббота, 12 Февраля 2011, 23:57 | Сообщение # 4 |  
 
заслуженный участник 
Сейчас нет на сайте 
 
 | LunarPixel, Ошибаешься, надо так:   Пример проигрывания AVI-файла в PictureBox-е    Не забудь создать PictureBox.   Вот сам код:   Code Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long   Private Declare Function mciGetErrorString Lib "winmm" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long   Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long   Const WS_CHILD = &H40000000   Sub PlayAVIPictureBox(FileName As String, ByVal Window As PictureBox)   Dim RetVal As Long   Dim CommandString As String   Dim ShortFileName As String * 260   Dim deviceIsOpen As Boolean   'Retrieve short file name format   RetVal = GetShortPathName(FileName, ShortFileName, Len(ShortFileName))   FileName = Left$(ShortFileName, RetVal)   'Open the device   CommandString = "Open " & FileName & " type AVIVideo alias AVIFile parent " & CStr(Window.hWnd) & " style " & CStr(WS_CHILD)   RetVal = mciSendString(CommandString, vbNullString, 0, 0&)   If RetVal Then GoTo Error   'remember that the device is now open   deviceIsOpen = True   'Resize the movie to PictureBox size   CommandString = "put AVIFile window at 0 0 " & CStr(Window.ScaleWidth / _   Screen.TwipsPerPixelX) & " " & CStr(Window.ScaleHeight / _   Screen.TwipsPerPixelY)   RetVal = mciSendString(CommandString, vbNullString, 0, 0&)   If RetVal <> 0 Then GoTo Error   'Play the file   CommandString = "Play AVIFile wait"   RetVal = mciSendString(CommandString, vbNullString, 0, 0&)   If RetVal <> 0 Then GoTo Error   'Close the device   CommandString = "Close AVIFile"   RetVal = mciSendString(CommandString, vbNullString, 0, 0&)   If RetVal <> 0 Then GoTo Error   Exit Sub   Error:   'An error occurred.   'Get the error description   Dim ErrorString As String   ErrorString = Space$(256)   mciGetErrorString RetVal, ErrorString, Len(ErrorString)   ErrorString = Left$(ErrorString, InStr(ErrorString, vbNullChar) - 1)   'close the device if necessary   If deviceIsOpen Then   CommandString = "Close AVIFile"   mciSendString CommandString, vbNullString, 0, 0&   End If   'raise a custom error, with the proper description   Err.Raise 999, , ErrorString   End Sub 
   Private Sub Command1_Click()   'replace 'c:\myfile.avi' with the name of the AVI file you want to play   PlayAVIPictureBox "C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\Working.avi", Picture1   End Sub     Обрати внимание на строку в самом низу C:\Program Files\Microsoft Visual Studio\VB98\Wizards\PDWizard\Working.avi   Указываете любую папку главное что бы на "С" диске!!!   И САМОЕ ГЛАВНОЕ ДЛЯ ТОГО ЧТО БЫ ВСЕ РАБОТАЛО, просто создай кнопку назови ее как хочешь и запускай проект, и после нажатия на кнопку будет воспроизводиться ролик!!!   Вот и все. Если помог ставьте + плз!!Добавлено (12.02.2011, 23:57) --------------------------------------------- Если все таки у тебя и это не получиться, тогда я скину тебе пример и тебе надо будет только путь к файлу поменять!!!!   Только скажи. Все, спасибо за внимание!!! 
 
  
 
 Сообщение отредактировал 67boy - Суббота, 12 Февраля 2011, 23:56  |  
| 
 | 
 |    |  
| Stage | Дата: Воскресенье, 13 Февраля 2011, 00:51 | Сообщение # 5 |  
| 
 постоянный участник 
Сейчас нет на сайте 
 
 | 67boy, ты не прав. В примере LunarPixel видео проигрывается через COM интерфейс, в твоем - через прямой вызов мультимедиа API. Учи матчасть.
 |  
| 
 | 
 |    |  
| LunarPixel | Дата: Воскресенье, 13 Февраля 2011, 09:32 | Сообщение # 6 |  
 
старожил 
Сейчас нет на сайте 
 
 | 67boy, мой код верен, специально его проверил. Как правильно заметил Stage, ошибаешься тут ты. А этот код с PictureBox-ом по всему интернету валяется вместе с примером.   По другим вопросам если ещё актуально, могу написать код. Включая более простой вариант смены разрешения экрана.
 
  
 |  
| 
 | 
 |    |  
| 67boy | Дата: Воскресенье, 13 Февраля 2011, 11:29 | Сообщение # 7 |  
 
заслуженный участник 
Сейчас нет на сайте 
 
 | LunarPixel, ДА я понял что твой правильный извиняюсь, но мой тоже работает и хорошо!!!! Добавлено (13.02.2011, 11:29) --------------------------------------------- LunarPixel, Если ты шаришь в VB, можешь мне помочь??? 
 
  
 |  
| 
 | 
 |    |  
| Sasha2033 | Дата: Четверг, 10 Марта 2011, 22:05 | Сообщение # 8 |  
 
почетный гость 
Сейчас нет на сайте 
 
 | Lorderon, на фоициальном сайте разработчика надо купить программу.   Ой тфу ты, я думал ты про DarkBasik(движок). Извини
 
 Сообщение отредактировал Sasha2033 - Четверг, 10 Марта 2011, 22:06  |  
| 
 | 
 |    |  
| -Mikle- | Дата: Понедельник, 14 Марта 2011, 10:08 | Сообщение # 9 |  
 
Изобретатель велосипедов 
Сейчас нет на сайте 
 
 | Чтобы не пользоваться медиаплеером (он может быть в системе изменён, перенастроен), лучше воспользоваться DirectShow:   Создаём проект с одной формой, подключаем ссылку на "ActiveMovie control type library", добавляем модуль с таким кодом:   Код:   Code    Option Explicit  
   Private m_objMediaPosition As IMediaPosition    Private m_objVideoWindow As IVideoWindow    Private m_objMediaControl As IMediaControl    Private m_objBasicAudio  As IBasicAudio  
   Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)  
   Public Sub RunAudio(fName As String, ByVal Volume As Single)    Dim meVol As Integer      meVol = 67 - 67 * Exp((1 - Volume) * 5)      If meVol < -9999 Then meVol = -9999      If meVol > 0 Then meVol = 0           Set m_objMediaControl = New FilgraphManager      Set m_objBasicAudio = m_objMediaControl      m_objMediaControl.RenderFile fName      m_objBasicAudio.Volume = meVol      m_objMediaControl.Run    End Sub  
   Public Sub RunVideo(fName As String, ByVal Volume As Single)    Dim d1 As Double, d2 As Double    Dim meVol As Integer      meVol = 67 - 67 * Exp((1 - Volume) * 5)      If meVol < -9999 Then meVol = -9999      If meVol > 0 Then meVol = 0           Set m_objMediaControl = New FilgraphManager      m_objMediaControl.RenderFile fName  
     Set m_objVideoWindow = m_objMediaControl      Set m_objBasicAudio = m_objMediaControl      m_objVideoWindow.WindowStyle = CLng(&H6000000)      m_objVideoWindow.Top = 0      m_objVideoWindow.Left = 0      m_objVideoWindow.Width = Screen.Width / Screen.TwipsPerPixelX      m_objVideoWindow.Height = Screen.Height / Screen.TwipsPerPixelY      m_objVideoWindow.HideCursor -1      Set m_objMediaPosition = m_objMediaControl      m_objBasicAudio.Volume = meVol      m_objMediaControl.Run      d2 = -1      Do        Sleep 50        d1 = m_objMediaPosition.CurrentPosition        If d1 = d2 Then Exit Do Else d2 = d1        If GetAsyncKeyState(vbKeyEscape) < 0 Then Exit Do      Loop      DShowStop    End Sub  
   Public Sub DShowStop()      If Not m_objMediaControl Is Nothing Then        m_objMediaControl.Stop        Set m_objBasicAudio = Nothing        Set m_objMediaPosition = Nothing        Set m_objVideoWindow = Nothing        Set m_objMediaControl = Nothing      End If    End Sub        На форму три кнопки "bAudio", "bVideo", "bStop" и такой код:   Код:   Code    Option Explicit  
   Private Sub bAudio_Click()      RunAudio "1.mp3", 1 'Громкость от 0 до 1    End Sub  
   Private Sub bStop_Click()      DShowStop    End Sub  
   Private Sub bVideo_Click()      DoEvents      RunVideo "1.wmv", 1 'Громкость от 0 до 1    End Sub  
   Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)      DShowStop    End Sub        В папке с проектом должны быть файлы "1.mp3" и "1.wmv".   Позволяет проигрывать видео в полноэкранном режиме, например заставку перед игрой, воспроизведение можно прервать, нажав "Esc", приложение ждёт окончание воспроизведения.   Так же проигрывает Audio в фоновом режиме (не прерывая работу приложения), например фоновую музыку.
 |  
| 
 | 
 |    |     
		
		 
 |