Статус загрузки программы

[Rodos]

С момента нажатия на ярлык до загрузки программы проходит секунды 3-4 на достаточно мощном компе, на более слабых думаю будет еще дольше. Можно ли, что бы во время загрузки, появлялась форма с ProgressBar, и пропадала когда программа загрузиться?

[EvilCoder]

Смотря что твоя программа делает при загрузке...

[Rodos]

Сейчас присмотрелся загрузка идет 1-1,5 секунды. Так что - это терпимо. А из-за чего идет загрузка я не знаю, думаю из-за миди файла, который используется, как звуковой фон.

[Rodos]

Все-таки 2-3 секунды. Кажется нашел причину задержки. Воспроизведение MID файла начинается через те самые 2-3 секунды после нажатия кнопки "Play", соответственно и при загрузке происходит тоже самое.

Вот мой код:

Код: Выделить всё

Private Sub Form_Load()
With MMControl2
    .Notify = False
    .Wait = True
    .Shareable = False
    .FileName = App.Path & "\Sound\MIG.mid"
    .Command = "Open"
    .Command = "Play"
End With
End Sub

[Amed]

Файл большой? Может быть, с начала файла пустота?

Использовать другие методы проигрывания midi?

[Rodos]

Файл маленький и пустоты нет.
Чем можно воспользоваться вместо MMControl?

[Amed]

http://bbs.vbstreets.ru/viewtopic.php?t ... light=midi

[Rodos]

http://bbs.vbstreets.ru/viewtopic.php?t=3374&highlight=midi

Не помогло, опять задержка 2-3 секунды. Не понимаю в чем дело! Если вообще отключить звук, тогда все летает.

[BV]

Если пауза в midi, то меняй позицию, если это время загрузки, то начинай её до окончания текущего midi.

[Rodos]

если это время загрузки, то начинай её до окончания текущего midi

Обьясни подробнее.

У меня так запускается любая программа, где есть midi (а может и не только midi, не пробовал), даже если не помещать в Load_Form. Я так понял ProgressBar здесь не сделать.

[BV]

Я не телепат. Выставляй проект/код.

[Rodos]

Код: Выделить всё

Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim retval As Long  ' возвращаемое значение
Dim returnstring As Long

' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
                     
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1                         ' Unicode nul terminated string
Const REG_DWORD = 4                      ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long





Private Sub Form_Load()
With MMControl2
    .Notify = False
    .Wait = True
    .Shareable = False
    .FileName = App.Path & "\Sound\MIG.mid"
    .Command = "Open"
    .Command = "Play"
End With
End Sub

Private Sub mnuAbout_Click()
frmInfo.Show

With MMControl1
    .Notify = False
    .Wait = True
    .Shareable = False
    .FileName = App.Path & "\Sound\chimes.wav"
    .Command = "Open"
    .Command = "Play"
    .Command = "Prev"
End With
End Sub


Private Sub mnuChis_Click()
frmChis.Show
End Sub


Private Sub mnuExit_Click()
End
End Sub

Private Sub mnuMusoff_Click()
With MMControl2
    .Notify = False
    .Wait = True
    .Shareable = False
    .FileName = App.Path & "\Sound\MIG.mid"
    .Command = "Stop"
    .Command = "Close"
End With
End Sub

Private Sub mnuMuson_Click()
With MMControl2
    .Notify = False
    .Wait = True
    .Shareable = False
    .FileName = App.Path & "\Sound\MIG.mid"
    .Command = "Stop"
    .Command = "Close"
End With

With MMControl2
    .Notify = False
    .Wait = True
    .Shareable = False
    .FileName = App.Path & "\Sound\MIG.mid"
    .Command = "Open"
    .Command = "Play"
End With
End Sub


Private Sub mnuOpr_Click()
frmOpr.Show
End Sub

Private Sub mnuPsih_Click()
frmPsih.Show
End Sub

Private Sub mnuSite_Click()
ActiveLinkX1.OpenActiveLink
End Sub

Private Sub mnuSovm_Click()
frmSovm.Show
End Sub

Private Sub mnuSys_Click()
Call StartSysInfo
End Sub

Private Sub mnuUzn_Click()
frmUzn.Show
End Sub

Public Sub StartSysInfo()
    On Error GoTo SysInfoErr
 
    Dim rc As Long
    Dim SysInfoPath As String
   
    ' Try To Get System Info Program Path\Name From Registry...
    If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
    ' Try To Get System Info Program Path Only From Registry...
    ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
        ' Validate Existance Of Known 32 Bit File Version
        If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
            SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
           
        ' Error - File Can Not Be Found...
        Else
            GoTo SysInfoErr
        End If
    ' Error - Registry Entry Can Not Be Found...
    Else
        GoTo SysInfoErr
    End If
   
    Call Shell(SysInfoPath, vbNormalFocus)
   
    Exit Sub
SysInfoErr:
    MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
    Dim i As Long                                           ' Loop Counter
    Dim rc As Long                                          ' Return Code
    Dim hKey As Long                                        ' Handle To An Open Registry Key
    Dim hDepth As Long                                      '
    Dim KeyValType As Long                                  ' Data Type Of A Registry Key
    Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
    Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
    '------------------------------------------------------------
    ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
    '------------------------------------------------------------
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
   
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
   
    tmpVal = String$(1024, 0)                             ' Allocate Variable Space
    KeyValSize = 1024                                       ' Mark Variable Size
   
    '------------------------------------------------------------
    ' Retrieve Registry Key Value...
    '------------------------------------------------------------
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                         KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
                       
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
   
    If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
        tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
    Else                                                    ' WinNT Does NOT Null Terminate String...
        tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
    End If
    '------------------------------------------------------------
    ' Determine Key Value Type For Conversion...
    '------------------------------------------------------------
    Select Case KeyValType                                  ' Search Data Types...
    Case REG_SZ                                             ' String Registry Key Data Type
        KeyVal = tmpVal                                     ' Copy String Value
    Case REG_DWORD                                          ' Double Word Registry Key Data Type
        For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
            KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
        Next
        KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
    End Select
   
    GetKeyValue = True                                      ' Return Success
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
    Exit Function                                           ' Exit
   
GetKeyError:      ' Cleanup After An Error Has Occured...
    KeyVal = ""                                             ' Set Return Val To Empty String
    GetKeyValue = False                                     ' Return Failure
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
End Function

[BV]

И зачем объявлена mciSendString, если всё через MMControl?

Код: Выделить всё

Option Explicit

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub Form_Load()
    Dim strMIDIFile As String
    strMIDIFile = App.Path & "\Sound\MIG.mid"
    With pgbLoading
        .Min = 0: .Max = 100
        .Value = 25
        Call mciSendString("Open " & strMIDIFile & " alias _music wait", vbNullString, 0&, 0&)
        .Value = 55
        Call mciSendString("Play _music", vbNullString, 0&, 0&)
        .Value = 85
       
        'Your code
       
        .Value = 100
        frmMain.Show
    End With
End Sub

[Rodos]

У меня в программе был еще данный код, просто я комманды исключил, а переменные видимо не заметил.

Код: Выделить всё

Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim retval As Long  ' возвращаемое значение
Dim returnstring As Long

Private Sub Комманда1_Click()
' Открываем или закрываем CD-ROM .
retval = mciSendString("set CDAudio door open", _
returnstring, 127, 0)
End Sub

Private Sub Комманда2_Click()
'Eсли закрыть,то используем
retval = mciSendString("set CDAudio door closed", _
returnstring, 127, 0)
End Sub

Но задержка точно не от этого. Я проверял MMControl на пустой форме - происходит эта же задержка. Может компилировать надо как-нибудь по другому?

[Rodos]

А из твоего кода, ругается на данную строку:

Код: Выделить всё

With pgbLoading

[BV]

Так добавь новую форму, назначь её как главную, поставь на неё ProgressBar с именем pgbLoading и вставь мой код.

[Rodos]

Теперь через те самые 2-3 секунды, просто появляются две формы.

[BV]

Так смени событие Form_Load на Form_Activate

[Rodos]

Вот код формы 1:

Код: Выделить всё

Option Explicit

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub Form_Load()
    Dim strMIDIFile As String
    strMIDIFile = App.Path & "\MIG.mid"
    With pgbLoading
        .Min = 0: .Max = 100
        .Value = 25
        Call mciSendString("Open " & strMIDIFile & " alias _music wait", vbNullString, 0&, 0&)
        .Value = 55
        Call mciSendString("Play _music", vbNullString, 0&, 0&)
        .Value = 85
       
        'Your code
       
        .Value = 100
        Form2.Show
    End With
End Sub

Фот код формы 2:

Код: Выделить всё

Private Sub Form_Load()
With MMControl1
    .Notify = False
    .Wait = True
    .Shareable = False
    .FileName = App.Path & "\MIG.mid"
    .Command = "Open"
    .Command = "Play"
End With
End Sub

И что ты подразумеваешь под:

'Your code

[Rodos]

Поставил:

Код: Выделить всё

Form_Activate

Теперь две формы появляются сразу, и ждут 2-3 секунды. ProgressBar не сработал.

Как сделать, чтобы 2 форма не запускалась, пока не пройдет загрузка в первой?

[BV]

Так, всё ясно - вот проект:

[возможно, ниже есть что-то лучше]

[Rodos]

Спасибо, все заработало. Только не понятно, почему теперь при нажатии кнопки "End" музыка не перестает играть (это только в VB, в скомпилированном проекте все нормально)?

[Rodos]

Все сделал, вставил код:

Код: Выделить всё

Call mciSendString("Stop _music", vbNullString, 0&, 0&)
        .Value = 95

Теперь музыка не играет!

[BV]

А зачем по-твоему в frmMain это?...

Код: Выделить всё

Private Sub Form_Unload(Cancel As Integer)
    Call mciSendString("Close all", vbNullString, 0&, 0&)
End Sub

Я надеюсь, ты понимаешь, что mciSendString полностью заменяет MMControl, и использовать их вместе - глупо.
Рекомендую скачать и использовать: http://bbs.vbstreets.ru/viewtopic.php?p=150949#150949

[Rodos]

Вот как выглядит код моей главной формы:

Код: Выделить всё

Option Explicit
   
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub cmdPlay_Click()
Dim strMIDIFile As String
    strMIDIFile = App.Path & "\MIG.mid"
    If InStr(strMIDIFile, Chr$(32)) <> 0 Then strMIDIFile = Chr$(34) & strMIDIFile & Chr$(34)
Call mciSendString("Open " & strMIDIFile & " alias _music wait", vbNullString, 0&, 0&)
Call mciSendString("Play _music", vbNullString, 0&, 0&)
End Sub

Private Sub cmdStop_Click()
Call mciSendString("Stop _music", vbNullString, 0&, 0&)
Call mciSendString("Close _music", vbNullString, 0&, 0&)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call mciSendString("Close all", vbNullString, 0&, 0&)
End Sub

Как сделать, чтобы музыка воспроизводилась бесконечно (по кругу) пока я не нажму кнопу STOP, а когда нажму PLAY опять бесконечно воспроизводилась?

[BV]

И зачем тут начинать воспроизведение, если оно начинается в frmLoading?

Используй класс, проверяй по таймеру:

Код: Выделить всё

If mEngine.Position >= mEngine.Length Then
    With mEngine
        .mStop
        .FileName = strMIDIFile
        .mPlay
    End With
End if

Или поиск. Тема уже не раз поднималась.

[Rodos]

Помоги мне сначала настроить кнопки:
PLAY - на воспроизведение мелодии сначала (из frmLoading), если была остановлена
STOP - на остановку данной мелодии

Код: Выделить всё

Option Explicit
   
Dim mEngine As New clsMedia
Dim strMIDIFile As String

Private Sub cmdPlay_Click()
With mEngine
        .FileName = strMIDIFile
        .mPlay
    End With
End Sub

Private Sub cmdStop_Click()
With mEngine
        .FileName = strMIDIFile
        .mStop
    End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call mciSendString("Close all", vbNullString, 0&, 0&)
End Sub

А то чего-то разобраться с этим ни как не могу.

[BV]

RTFM

[возможно, ниже есть что-то лучше]

[Rodos]

Спасибо BV, круто помог, наконец разобрался "что к чему".

[Rodos]

Так добавь новую форму, назначь её как главную

Стал применять к своей программе, все о чем мы говорили и наткнулся на проблему. Как назначить форму главной? Я понимаю, что это глупый вопрос, просто я с этим никогда не сталкивался, добовлял к основной форме другие и все.