Nastavení rychlosti nabídky Start

Option Explicit
' konstaty pro restart Windows
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
'API pro restart Windows
Private Declare Function ExitWindowsEx Lib "user32" _
        (ByVal uFlags As Long, _
        ByVal dwReserved As Long) As Long
'API pro přístup k registrům
Private Declare Function RegCreateKey Lib "advapi32.dll" _
        Alias "RegCreateKeyA" (ByVal HKey As Long, _
        ByVal lpSubKey As String, _
        phkResult As Long) As Long

Private Declare Function RegCloseKey Lib_ "advapi32.dll" (ByVal HKey As Long) As Long

Private Declare Function RegQueryValueEx Lib_ "advapi32.dll" Alias "RegQueryValueExA" (ByVal HKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        lpData As Any, lpcbData As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" _
        Alias "RegSetValueExA" (ByVal HKey As Long, _
        ByVal lpValueName As String, _
        ByVal Reserved As Long, _
        ByVal dwType As Long, _
        lpData As Any, _
        ByVal cbData As Long) As Long
'Konstanty registrů
Private Const REG_SZ = 1
Private Const REG_DWORD = 4

Private Sub SaveString(HKey As Long, strPath As String, _
            strValue As String, strdata As String)
    Dim keyhand
    Dim lngRet As Long
    'Otevře nebo vytvoří klíč
    lngRet = RegCreateKey(HKey, strPath, keyhand)
    'Nastaví hodnotu
    lngRet = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal _
            strdata, Len(strdata))
    'Zavře klíč
    lngRet = RegCloseKey(keyhand)
End Sub

Do formuláře přidejte tlačítko cmdTest.

Private Sub cmdTest_Click()
    Dim intSpeed As Integer
    Dim strSpeed As String
    Dim lngRet As Long
   
    On Error GoTo error
    'Uživatelská hodnota
    intSpeed = InputBox("Zadejte číslo mezi 1 a 1000", _
            "Start Menu")
    'Test správnosti čísla
    If intSpeed > 0 And intSpeed <1001 Then
        'Zkonvertování čísla na řetězec
        strSpeed = CStr(intSpeed)
        'Uložení do registru
        Call SaveString(HKEY_CURRENT_USER, _
                "Control Panel\Desktop", "MenuShowDelay", strSpeed)
        'Je třeba restartovat Windows
        MsgBox "Nyní je třeba restartovat počítač", , "Start Menu"
        'Restart
        lngRet = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)
    Else
        'Chybný vstup
        MsgBox "Číslo musí být mezi 1 a 1000"
    End If
    Exit Sub
error:
    MsgBox "Chybně zadaná data"
End Sub

Zpět