Visual Basic Tips & Trix (1) - Systém

1. Jak zjisťit dobu po kterou je systém spuštěn

Do modulu nadeklarujte tuto API funkci:

Public Declare Function GetTickCount Lib "kernel32" () As Long

Teď můžete například vytvořit Label(lblWinTime), Timer(tmrWinTime) s intervalem 1ms a do jeho procedury Timer vložíte:

lblWinTime.Caption = GetTickCount

2. Jak otevít/zavřít dvířka CD mechaniky

Opět do modulu nadeklarujte API funkci, tentokrát tuhle:

Public 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

A nyní např. do procedury tlačítka otevřít napiště tento kód:

mciSendString "Set CDAudio Door Open Wait", 0, 0, 0

A samozřejmě nezapomeneme ani na tlačítko zavřít:

mciSendString "Set CDAudio Door Closed Wait", 0, 0, 0

3.Zjištění přítomnosti zvukové karty

Do modulu nadeklarujte tuto API funkci:

Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

Poté např. do procedury tlačítka na zjištění přítomnosti zvukové karty napiště tuto podmnínku:

x = waveOutGetNumDevs()
If x > 0 Then
MsgBox "Zvuková karta nalezena", vbInformation
Else
MsgBox "Zvuková karta NENALEZENA", vbExclamation
End If

4.Hypertextový odkaz na internetovou stránku

Do modulu nadeklarujte tyto dvě API funkce:

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Public Function HyperJump(ByVal URL As String) As Long
HyperJump = ShellExecute(0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus)
End Function

Potom vytvořte na formulaři Label, do jeho vlastnosti caption napiště třeba www.soom.cz a do procedury click napiště následující kód:

Call HyperJump("http://www.soom.cz")

5.Prohození tlačítek myši

Do modulu nadeklarujte:

Private Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long

A třeba do procedury nějakého CommandButtou napiště tento kód:

SwapMouseButton 1

Pozn.Prohození trvá i po ukončení programu, pokud tomu chcete zabránit dejte do procedury Unload formuláře následující kód, který je vlastně opačným prohozením tlačítek:

SwapMouseButton 2

6.Práce se schránkou

Vyprázdnění schránky:

Clipboard.Clear

Vložení textu do schránky např. z vlastnosti Text komponenty Text1:

Clipboard.SetText Text1.Text

7.Jak nastavit wallpaper

Do modulu napiště následující kód:

Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Const SPI_SETDESKWALLPAPER = 20
Const SPIF_SENDWININICHANGE = &H2
Const SPIF_UPDATEINIFILE = &H1

Následujcí kód nastaví tapetu na plochu z umístění c:/wallpaper.bmp, tedy pokud tam nějaký je :)

wallpaper = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:/wallpaper.bmp", SPIF_UPDATEINIFILE)

8.Vypnutí, restart a odhlášení(Win 9x)

Do modulu nadeklarujte funkci:

Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal wReserved As Long) As Long

Nyní můžete použít tyto příkazy:

ExitWindowsEx 0, 0          'odhlášení uživatele
ExitWindowsEx 1, 0          'vypnutí systému
ExitWindowsEx 2, 0          'restart systému
ExitWindowsEx 3, 0          'vypnutí počítače


Tak to je pro dnešek vše, to ale neznamená že to byl poslední článek, který se týkal tipů a triků pro systém.