Zdrojové kódy
Dbgwproc.dll
Některé příklady, které tentokrát uvádíme, potřebují pro svůj běh tuto knihovnu od
Microsoftu.
|
5904 bytů
|
Kopírovat
|
Ikona v system tray
Umístit ikonu do oblasti SystemTray ve Windows 9x už dnes asi umí každý. V tomto příkladu se naučíte využít nových možností systému Windows 2000.
|
53711 bytů
|
Kopírovat
|
Informace o systému
Příklad zjišťuje základní informace o systému Windows 2000, např. typ procesoru, velikost paměti atd. Pro zjišťování používá rozhraní
WMI.
|
2620 bytů
|
Kopírovat
|
Typ procesoru
Příklad umí zjistit informace o procesoru pomocí rozhraní WMI (Windows Management Interface). Pokud nemáte Windows 2000, musíte si je stáhnout a nainstalovat ze stránek Microsoftu.
|
3233 bytů
|
Kopírovat
|
Průhledný taskbar
Windows 2000 umožňují nastavovat průhlednost TaskBaru. Jak na to ve Visual Basicu ukazuje tento příklad.
|
46830 bytů
|
Kopírovat
|
Sloupce v ListBoxu
Zobrazuje sloupce v ListBoxu pomocí nastavení tabulátorů.
|
2238 bytů
|
Kopírovat
|
Timezone
Zobrazuje informace o časové zóně, na kterou je počítač nastaven.
|
3693 bytů
|
Kopírovat
|
EnsureVisible
Vlastnost EnsureVisible prvku TreeView určitě znáte. Tento příklad ukazuje podobnou funkci, ale u prvků na MDI child formulářích.
|
4903 bytů
|
Kopírovat
|
DragListBox
Zdrojový kód prvku, ListBoxu, který umožňuje přesouvat jednotlivé položky pomocí myši.
|
10333 bytů
|
Kopírovat
|
CD monitor
Příklad použití třídy CDMonitor, která umí zjistit, zda někdo do CD mechniky vložil nebo vyjmul CD.
|
6880 bytů
|
Kopírovat
|
Drag controls
Ukazuje, jak hýbat s prvky pomocí funkce API SendMessage.
|
1801 bytů
|
Kopírovat
|
Windows 2000 services - Příklad zobrazí seznam definovaných služeb
(service) v systému Windows 2000
pomocí Active Directory. Abyste mohli vyskoušet tento příklad, musíte
přidat odkaz na Active DS Type Library a mít samozřejmě Windows 2000.
Dim oSysInfo As New ActiveDs.WinNTSystemInfo
Dim oComp As ActiveDs.IADsComputer
Dim oSvc As ActiveDs.IADsService
Dim sCompName As String
sCompName = "WinNT://" & oSysInfo.ComputerName & ",computer"
Set oComp = GetObject(sCompName)
oComp.Filter = Array("Service")
For Each oSvc In oComp
Debug.Print oSvc.DisplayName, oSvc.Status
Next
Set oComp = Nothing
Jméno počítače a domény -
Pomocí Active Directory můžete ve Windows 2000 zjistit jméno počítače a domény velmi jednoduše
(pro fungování příkladu musíte přidat odkaz na Active DS Type Library).
Dim oSysInfo As New ActiveDs.WinNTSystemInfo
Debug.Print oSysInfo.ComputerName
Debug.Print oSysInfo.DomainName
Set oSysInfo = Nothing
Seznam domén -
Seznam domén získáte pomocí následujícího jednoduchého kódu (pro fungování příkladu musíte přidat odkaz
na Active DS Type Library).
Dim ns As IADsContainer, dom As IADs
Set ns = GetObject("WinNT:")
For Each dom In ns
Debug.Print dom.Name, dom.ADsPath
Next
Průhledný formulář - Windows 2000 umožňují nastavit oknům stupeň průhlednosti pomocí funkce
API SetLayeredWindowAttributes. Stupeň průhlednosti může nabývat hodnot
z intervalu 0-255 (255 je neprůhledné okno). Okno, kterému chcete nastavit průhlednost,
musí být vytvořeno pomocí API CreateWindowEx s parametrem WS_EX_LAYERED
nebo tento parametr musíte nastavit pomocí API SetWindowLong.
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) _
As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
Public Function TranslucentForm(ByVal hw As Long, ByVal TranslucenceLevel As Byte) _
As Boolean
SetWindowLong hW, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes hW, 0, TranslucenceLevel, LWA_ALPHA
TranslucentForm = (Err.LastDllError = 0)
End Function
'příklad použití
Private Sub Form_Load()
TranslucentForm Me, 128
End Sub
GetCurrencyFormat -
Funkce formátuje měnu podle nastavení systému.
Pokud nastane chyba, vrátí funkce hodnotu 0, jinak počet znaků vložených
do parametru lpCurrencyStr
Declare Function GetCurrencyFormat Lib "kernel32" Alias "GetCurrencyFormatA" _
(ByVal Locale As Long, ByVal dwFlags As Long, ByVal lpValue As String, _
lpFormat As Any, ByVal lpCurrencyStr As String,
ByVal cchCurrency As Long) As Long
Type CURRENCYFMT
NumDigits As Long
LeadingZero As Long
Grouping As Long
lpDecimalSep As String
lpThousandSep As String
NegativeOrder As Long
PositiveOrder As Long
lpCurrencySymbol As String
End Type
Locale
jedna z těchto dvou hodnot:
LOCALE_SYSTEM_DEFAULT = &H400 standardní systémové nastavení
LOCALE_USER_DEFAULT = &H800nastavení aktuálního uživatele
dwFlags
pro zobrazení aktuálního nastavení nastavte na 0
lpValue
hodnota, která bude formátována
lpFormat
pokud chcete použít systémové nastavení, nastavte na 0, chcete-li vlastní formátování, musíte zadat proměnnou typu CURRENCYFMT
NumDigits
počet čísel za desetinnou tečkou
LeadingZero
pokud nastavíte na číslo různé od nuly, bude doplňovat chybějící číslice 0, např. pokud je NumDigits nastaveno na 2 a zadáte číslo 1.2, vytvoří
1.20
Grouping
počet čísel v každé skupině (většinou 3, např. 1 221 223 154)
lpDecimalSep
znak pro desetinnou tečku
lpThousandSep
znak pro oddělení skupin
NegativeOrder
způsob zobrazování záporných hodnot
0
($1.1)
1
-$1.1
2
$-1.1
3
$1.1-
4
(1.1$)
5
-1.1$
6
1.1-$
7
1.1$-
8
-1.1 $
9
-$ 1.1
10
1.1 $-
11
$ 1.1-
12
$ -1.1
13
1.1- $
14
($ 1.1)
15
(1.1 $)
PositiveOrder
způsob zobrazování kladných hodnot
0
$1.1
1
1.1$
2
$ 1.1
3
1.1 $
CurrencySymbol
symbol měny
lpCurrencyStr
do této proměnné je vrácen formátovaný řetězec
cchCurrency
délka proměnné lpCurrencyStr
Dim udtCurrency As CURRENCYFMT
Dim str As String, ret As Long
'systémové nastavení
str = Space(256)
ret = GetCurrencyFormat _
(LOCALE_USER_DEFAULT, 0, "98765432.21", ByVal CLng(0), _
str, Len(str))
Debug.Print Left(str, ret)
'vlastní nastavení
With udtCurrency
.NumDigits = 4
.LeadingZero = 1
.Grouping = 3
.lpDecimalSep = "."
.lpThousandSep = ","
.NegativeOrder = 8
.PositiveOrder = 3
.lpCurrencySymbol = "DEM"
End With
str = Space(256)
ret = GetCurrencyFormat _
(LOCALE_USER_DEFAULT, 0, "98765432.21", udtCurrency, _
str, Len(str))
Debug.Print Left(str, ret)
'funkce Visual Basicu
Debug.Print FormatCurrency("98765432.21")
ClipCursor - Funkce uzamkne kurzor myši v obdélníkové oblasti na obrazovce. Pokud uživatel "přejede"
okraje oblasti nebo nastaví pozici kurzoru mimo oblast, kurzor se vrátí ihned zpět. Kurzor
je v oblasti uvězněn i když je program ukončen.
Pokud funkce skončí v pořádku, vrátí jakoukoliv nenulovou hodnotu, v případě výskytu chyby vrátí 0.
Declare Function ClipCursor Lib "user32.dll" (lpRect As RECT) As Long
Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
- lpRect
-
proměnná typu RECT, kde left a top znamená souřadnice x a y levého horního rohu
a right a bottom souřadnice x a y dolního pravého rohu oblasti (souřadnice se zadávají v
pixelech)
'Zamkne myš v oblasti formuláře pomocí VB
Private Sub ZamkniMysFrm(frm As Form)
Dim r As RECT
With frm
r.left = .left / Screen.TwipsPerPixelX
r.right = (.left + .Width) / Screen.TwipsPerPixelX
r.top = .top / Screen.TwipsPerPixelY
r.bottom = (.top + .Height) / Screen.TwipsPerPixelY
End With
ClipCursor r
End Sub
'Odemkne myš pomocí VB
Private Sub OdemkniMys()
Dim r As RECT
With Screen
r.left = 0
r.right = .Width / .TwipsPerPixelX
r.top = 0
r.bottom = .Height / .TwipsPerPixelY
End With
ClipCursor r
End Sub
'Rychlejší varianta výše uvedených funkcí pomocí API
Private Sub ZamkniMysFrm(frm As Form)
Dim r As RECT
GetWindowRect frm.hwnd, r
ClipCursor r
End Sub
Private Sub OdemkniMys()
Dim r As RECT, hw As Long
hw = GetDesktopWindow()
GetWindowRect hw, r
ClipCursor r
End Sub
GetClipCursor -
Funkce vrací souřadnice obdélníku, ve kterém se může pohybovat myš.
Pokud nastane chyba, vrací funkce hodnotu 0, v opačném případě jakoukoliv nenulovou hodnotu.
Declare Function GetClipCursor Lib "user32.dll" (lprc As RECT) As Long
Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
- lprc
-
proměnná typu RECT, do které jsou vráceny souřadnice oblasti
(left a top znamená souřadnice x a y levého horního rohu a right a bottom souřadnice x a y dolního
pravého rohu oblasti - souřadnice jsou v pixelech)
Dim r As RECT
GetClipCursor r
Debug.Print "Levý horní roh (x,y) " & r.left & "," & r.top
Debug.Print "Pravý dolní roh (x,y) " & r.right & "," & r.bottom
|