Видео в игре
| |
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 в фоновом режиме (не прерывая работу приложения), например фоновую музыку.
|
|
| |
|