Zßkladnφ funkce pro prßci s formulß°i
| Modul obsahuje zßkladnφ API funkce pro prßci s formulß°i, jako je zjist∞nφ nßzvu aktivnφho okna, okno v₧dy naho°e, standardnφ AboutBox atd. | |
| 3253 byt∙ | Kopφrovat |
P°echody barev na pozadφ formulß°e
| Funkce vytvß°ejφcφ na pozadφ formulß°e p°echod z jednΘ barvy na druhou. VÜe samoz°ejm∞ v r∙zn²ch obm∞nßch. | |
| 5991 byt∙ | Kopφrovat |
Dialog OpenFile a SaveFile bez COMDLG32.OCX
| Funkce, kterΘ pouze za pomocφ API funkcφ zobrazujφ standardnφ systΘmov² dialog OpenFile a SaveFile (nepou₧φvajφ Common Dialog Control). Na podobnΘm principu lze zobrazit i dialog pro v²b∞r barev, tiskßrny a font∙, ale na to jist∞ p°ijdete sami. | |
| 3688 byt∙ | Kopφrovat |
| Ukazuje jak vypsat vÜechny b∞₧φcφ procesy (na pozadφ i na pop°edφ) ve Windows 95/98 a Windows NT. | |
| 3394 byt∙ | Kopφrovat |
Jak spustit program a Φekat na jeho ukonΦenφ
| Obsahuje jedinou funkci, jejφ₧ parametr je nßzev programu, kter² chcete spustit. Dokud spuÜt∞n² program b∞₧φ, VßÜ program neprovßdφ ₧ßdnΘ jinΘ kroky. | |
| 1628 byt∙ | Kopφrovat |
| Funkce pro p°idßvßnφ, mazßnφ a Φtenφ informacφ do a z registru systΘmu Windows. | |
| 7699 byt∙ | Kopφrovat |
Prßce s myÜφ pomocφ API funkcφ
| Modul obsahuje funkce pro prßci s kurzorem myÜi. Nap°. schovßnφ kurzoru a jeho obnovenφ do p∙vodnφho mφsta, "vyst°ed∞nφ" kurzoru na jakΘmkoliv prvku, kter² mß handle (hWnd) atd. | |
| 6747 byt∙ | Kopφrovat |
Jak pohnout s formulß°em, kter² nemß Titlebar
Chcete-li si vytvo°it vlastnφ Titlebar formulß°e, p°ijdete tφm o mo₧nost s nφm pohybovat. Zkuste na mφsto standardnφho Titlebaru vlo₧it t°eba PictureBox a potΘ vlo₧te do formulß°e tento k≤d.
Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ lParam As Any) As Long Private Const HTCAPTION = 2 Private Const WM_NCLBUTTONDOWN = &HA1 Private Const WM_SYSCOMMAND = &H112 Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0& 'Nebo: 'SendMessage hwnd, WM_SYSCOMMAND, &HF012&, 0& End Sub
Jak schovat a op∞t zobrazit TaskBar
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Sub HideTaskBar()
Dim hwnd1 As Long
hwnd1 = FindWindow("Shell_traywnd", "")
SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End Sub
Public Sub ShowTaskBar()
Dim hwnd1 As Long
hwnd1 = FindWindow("Shell_traywnd", "")
SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub
Private Declare Function FlashWindow Lib "user32" _ (ByVal hwnd As Long, ByVal bInvert As Long) As Long hWnd - hWnd formulß°e bInvert - 1 pro blikßnφ, 0 pro zastavenφ blikßnφ
Parametr frm p°edstavuje formulß°, ke kterΘmu se bude AboutBox vztahovat
Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" _ (ByVal hWnd As Long, ByVal szApp As String, _ ByVal szOtherStuff As String, ByVal hIcon As Long) As Long ShellAbout frm.hWnd, Title, Copyright, frm.Icon
Standardnφ systΘmov² dialog Tiskßrny a Fonty
Zobrazenφ dialogu tiskßrny a fonty pomocφ funkce Shell. Nenφ to zrovna elegantnφ °eÜenφ, ale funguje.
x = shell ("C:\windows\rundll32.exe shell32.dll, _
SHHelpShortcuts_RunDLL PrintersFolder", 1)
x = shell ("C:\windows\rundll32.exe shell32.dll, _
SHHelpShortcuts_RunDLL FontsFolder", 1)
M∞jme nap°. menu Soubor a ┌pravy. Proto₧e kolekce menu je Φφslovanß od 0, prvnφ bude mφt automaticky Φφslo 0 a druhΘ 1. Toto Φφslo p°edßvßme p°i volßnφ funkce GetSubMenu (parametr nPos). Prvnφ menu (Soubor) mß p∞t submenu, t°etφ je Φßra, ta obrßzek nemß. Menu ┌pravy mß jedno submenu (bez obrßzku), a to mß takΘ jedno submenu.
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, _
ByVal hBitmapChecked As Long) As Long
Const MF_BYPOSITION = &H400&
Private Sub Form_Load()
Dim mHandle As Long, lRet As Long, sHandle As Long, sHandle2 As Long
mHandle = GetMenu(Me.Hwnd) 'Vrat handle menu formulare,
'kde je menu
sHandle = GetSubMenu(mHandle, 0) 'Vrat handle prvniho (0) menu
lRet = SetMenuItemBitmaps _
(sHandle, 0, MF_BYPOSITION, imOpen.Picture, imOpen.Picture)
lRet = SetMenuItemBitmaps _
(sHandle, 1, MF_BYPOSITION, imSave.Picture, imSave.Picture)
lRet = SetMenuItemBitmaps _
(sHandle, 3, MF_BYPOSITION, imPrint.Picture, imPrint.Picture)
lRet = SetMenuItemBitmaps _
(sHandle, 4, MF_BYPOSITION, imPrintSetup.Picture, imPrintSetup.Picture)
'Mame i jedno submenu
sHandle = GetSubMenu(mHandle, 1) 'Vrat handle druheho (1) menu
sHandle2 = GetSubMenu(sHandle, 0) 'Vrat handle jeho prvniho submenu (0)
lRet = SetMenuItemBitmaps _
(sHandle2, 0, MF_BYPOSITION, imCopy.Picture, imCopy.Picture)
End Sub
Jak schovat celΘ menu najednou
Private Declare Function SetMenu Lib "user32" _
(ByVal hwnd As Long, ByVal hMenu As Long) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Sub SchovejMenu(hwnd As Long)
Static hMenu As Long
If hMenu = 0 Then
hMenu = GetMenu(hwnd)
SetMenu hwnd, 0
Else
SetMenu hwnd, hMenu
hMenu = 0
End If
End Sub
Menu EDIT pomocφ funkce SendKeys
Private Sub mnuEdit_Click(Index As Integer)
Select Case Index
Case 0: SendKeys "%{BACKSPACE}" ' Zp∞t
Case 1: SendKeys "+{DELETE}" ' Vy°φzni
Case 2: SendKeys "^{INSERT}" ' Kopie
Case 3: SendKeys "+{INSERT}" ' Vlo₧it
End Select
End Sub
Jak zakßzat CTRL+ALT+DEL a ALT+TAB
Volßnφ funkce:
Disallowkeys(False) - povolφ klßvesy
Disallowkeys(True) - zakß₧e klßvesy
Private Const SPI_SCREENSAVERRUNNING = 97& Private Declare Function SystemParametersInfo Lib "User32" _ Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal _ uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) _ As Long Public Sub DisallowKeys(bParam as Boolean) As Long Dim lRetVal As Long, bOld As Boolean lRetVal = SystemParametersInfo(SPI_SCREENSAVERRUNNING ,bParam, bOld, 0&) DisallowKeys=lRetVal End Sub
Jak nastavit obrßzek na pozadφ plochy
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 = &H1P°φklad:
WallPaper = "C:\pozadi.bmp" a = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, WallPaper, SPIF_UPDATEINIFILE)
Declare Function ExitWindowsEx Lib "user32" Alias "ExitWindowsEx" _ (ByVal uFlags As Long, ByVal wReserved As Long) As Long Public Const EWX_LOGOFF = 0 Public Const EWX_SHUTDOWN = 1 Public Const EWX_REBOOT = 2 Public Const EWX_FORCE = 4 'EWX_LOGOFF - ukonci vsechny procesy a odhlasi uzivatele 'EWX_SHUTDOWN - ukonci Windows (pred ukoncenim posle signal vsem aplikacim, ' vcetne zapisu cache na disk) 'EWX_REBOOT - restartuje pocitac 'EWX_FORCE - pri ukoceni neposila signal aplikacimP°φklad:
x = ExitWindowsEx(Hodnota, &HFFFF)
Dotaz na restart systΘmu po proveden²ch zm∞nßch
P°i pou₧itφ nφ₧e uvedenΘ API funkce se zobrazφ standardnφ systΘmov² dialog s dotazem: "NovΘ nastavenφ se projevφ po restartu poΦφtaΦe. ChceÜ pokraΦovat ?". Reakcφ na odpov∞d ANO je restart systΘmu.
Declare Function SHRestartSystemMB Lib "shell32" Alias "#59" _ (ByVal hOwner As Long, ByVal sExtraPrompt As String, ByVal uFlags As Long) As Long 'hOwner - vlastnik dialogu, pri 0& je to plocha 'sExtraPrompt - pomoci tohoto parametru muzete zobrazit vlastni text, ' puvodni text je pridan az na konec (najde se ho zbavit) 'uFlags - nastaveni zavisla na OS. Pri 0& posle OS ExitWindowsEx(EWX_FORCE, 0&) x = SHRestartSystemMB(0&, vbNullString, 0&)
V²pis prom∞nn²ch prost°edφ operaΦnφho systΘmu
Pro zjiÜt∞nφ prom∞nn²ch prost°edφ operaΦnφho systΘmu existuje ve Visual Basicu funkce Environ. Jako parametr m∙₧ete zadat bu∩ Φφslo (po°adφ prom∞nnΘ) nebo p°φmo nßzev. V²pis prom∞nn²ch potom vypadß nßsledovn∞:
Public Sub EnumEnviron()
Dim i As Long
i=1
Do While Len(Environ(i))<>0
Debug.Print Environ(i)
i=i+1
Loop
End Sub
RychlΘ kopφrovßnφ obsahu jednΘ prom∞nnΘ do druhΘ
Rychlost funkce MEMCOPY, kterß provßdφ kopφrovßnφ obsahu prom∞nn²ch, jsem testoval na dvou polφch (obsah prvnφho jsem kopφroval do druhΘho). Ka₧dΘ m∞lo velikost 10 MB. Pomocφ cyklu FOR...NEXT jsem kopφroval 40 sekund, pomocφ MEMCOPY Φtvrtinu sekundy. Ob∞ metody jsem zkouÜel na poΦφtaΦi s procesorem Pentium 100 a pam∞tφ 64 MB. Rozdφl mezi kopφrovßnφm pomocφ FOR...NEXT a funkcφ MEMCOPY se samoz°ejm∞ projevφ jen u v∞tÜφch polφ nebo prom∞nn²ch.
Private Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" _ (dest As Any, src As Any, ByVal numbytes As Long) MemCopy Array2(1), Array1(1), Bytes 'dest - promenna (v tomto pripade array2), do ktere chceme data zkopirovat 'src - promenna (v tomto pripade array1), ze ktere chceme data zkopirovat 'numBytes - pocet bytu pro kopirovani