Zdrojové kódy 


Dbgwproc.dll

Program

Ikona v system tray

Program

Informace o systému

Program

Typ procesoru

Program

Průhledný taskbar

Program

Sloupce v ListBoxu

Program

Timezone

Program

EnsureVisible

Program

DragListBox

Program

CD monitor

Program

Drag controls

Program

Windows 2000 services

Kód

Jméno počítače a domény

Kód

Seznam domén pomocí ADSI

Kód

Průhledný formulář

Kód

GetCurrencyFormat

API

ClipCursor

API

GetClipCursor

API


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