|
|
API Tips #1
2. How can you change your current monitor settings?
3. How can you put an icon in the TrayBar (near the clock)?
4.Find out where is the Windows OS directory.
5.What is your Windows OS version (Win95/Win98/NT)?
6.Read and write to system registry.
7.How can you find out when will finish running process?
8.A minimal window size.
9.Restart/LogOff/Shutdown your computer.
1. Find your monitor resolution and colors number
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long Declare Function GetDesktopWindow Lib "user32" () As Long Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long Public Const HORZRES = 8 Public Const VERTRES = 10 Public Const BITSPIXEL = 12 Public Sub GetVideoMode(ByRef Width As Long, ByRef Height As Long, ByRef Depth As Long) Dim hDC As Long hDC = GetDC(GetDesktopWindow()) Width = GetDeviceCaps(hDC, HORZRES) Height = GetDeviceCaps(hDC, VERTRES) Depth = GetDeviceCaps(hDC, BITSPIXEL) ReleaseDC GetDesktopWindow(), hDC End Sub
Using:
Dim Height As Long, Width As Long, Depth As Long GetVideoMode Width, Height, Depth
Tip: Variable Depth return bt/pxl , not how many color we have. That's mean 16 colors = 4 bt per pxl , 256 - 8 bt, 65536 - 16 bt and so on.
2. How can you change your current monitor settings?
Public Const DM_BITSPERPEL = &H40000 Public Const DM_PELSWIDTH = &H80000 Public Const DM_PELSHEIGHT = &H100000 Public Const CCHDEVICENAME = 32 Public Const CCHFORMNAME = 32 Type DEVMODE dmDeviceName As String * CCHDEVICENAME dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * CCHFORMNAME dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (lpDevMode As DEVMODE, ByVal dwFalgs As Long) As Long Public Sub SetVideoMode(Width As Long, height As Long, Depth As Long) Dim dm As DEVMODE dm.dmPelsWidth = Width dm.dmPelsHeight = height dm.dmBitsPerPel = Depth dm.dmSize = Len(dm) dm.dmFields = DM_PELSWIDTH + DM_PELSHEIGHT + DM_BITSPERPEL ChangeDisplaySettings dm, 0 End Sub
Using:
SetVideoMode 1024, 768, 8 ' Set videomode to 1024x768x256
3. How can you put an icon in the TrayBar (near the clock)?
Place a PictureBox and name it picNotifier.
Declare Function Shell_NotifyIconA Lib "SHELL32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Integer Public Const NIM_ADD = 0 Public Const NIM_MODIFY = 1 Public Const NIM_DELETE = 2 Public Const NIF_MESSAGE = 1 Public Const NIF_ICON = 2 Public Const NIF_TIP = 4 Public Const WM_MOUSEMOVE = &H200 Public Const WM_LBUTTONDOWN = &H201 Public Const WM_LBUTTONUP = &H202 Public Const WM_LBUTTONDBLCLK = &H203 Public Const WM_RBUTTONDOWN = &H204 Public Const WM_RBUTTONUP = &H205 Public Const WM_RBUTTONDBLCLK = &H206 Public Const WM_MBUTTONDOWN = &H207 Public Const WM_MBUTTONUP = &H208 Public Const WM_MBUTTONDBLCLK = &H209 Type NOTIFYICONDATA cbSize As Long hWnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64 End Type Public Function SetTrayIcon(Mode As Long, hWnd As Long, Icon As Long, tip As String) As Long Dim nidTemp As NOTIFYICONDATA nidTemp.cbSize = Len(nidTemp) nidTemp.hWnd = hWnd nidTemp.uID = 0& nidTemp.hIcon = Icon nidTemp.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE nidTemp.uCallbackMessage = WM_MOUSEMOVE nidTemp.szTip = tip & Chr$(0) SetTrayIcon = Shell_NotifyIconA(Mode, nidTemp) End Function
Using:
Private Sub picNotifier_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static Rec As Boolean, Msg As Long
Msg = X / Screen.TwipsPerPixelX
If Rec = False Then ' To run sub only once at one time
Rec = True
Select Case Msg
' DoubleClick
Case WM_LBUTTONDBLCLK:
Me.Show
' If left mouse button is down
Case WM_LBUTTONDOWN:
' If left mouse button is up
Case WM_LBUTTONUP:
' If right mouse button is doble-clicked
Case WM_RBUTTONDBLCLK:
' If right mouse button is down
Case WM_RBUTTONDOWN:
' If right mouse button is up
Case WM_RBUTTONUP:
' You can show here PoPup-menu:
' PopupMenu mnuPopMenu
End Select
Rec = False
End If
End Sub
' Add an icon of form to traybar
SetTrayIcon NIM_ADD, picNotifier.hWnd, Me.Icon, "Test"
' Modify the icon and the tooltip
SetTrayIcon NIM_MODIFY, picNotifier.hWnd, Me.Icon, "It works!"
' Delete the icon from traybar
SetTrayIcon NIM_DELETE, picNotifier.hWnd, 0&, ""
4.Find out where is the Windows OS directory.
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Using:
Dim sDir As String, sTemp As String * 256 nSize = GetWindowsDirectory(sTemp, 255): sDir = Left(sTemp, nSize) ' sDir = "C:\WINDOWS" nSize = GetSystemDirectory(sTemp, 255): sDir = Left(sTemp, nSize) ' sDir = "C:\WINDOWS\SYSTEM" nSize = GetTempPath(255, sTemp): sDir = Left(sTemp, nSize) ' sDir = "C:\WINDOWS\TEMP\"
Tip: The last function return full path with "\" in the exception of first ones.
5.What is your Windows OS version (Win95/Win98/NT)?
Public Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Public Const VER_PLATFORM_WIN32s = 0 Public Const VER_PLATFORM_WIN32_WINDOWS = 1 Public Const VER_PLATFORM_WIN32_NT = 2 Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long Public Function IsWindowsNT() As Boolean Dim osvi As OSVERSIONINFO osvi.dwOSVersionInfoSize = Len(osvi) GetVersionEx osvi IsWindowsNT = (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT) End Function Public Function IsWindows98() As Boolean Dim osvi As OSVERSIONINFO osvi.dwOSVersionInfoSize = Len(osvi) GetVersionEx osvi IsWindows98 = (osvi.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And osvi.dwMinorVersion >= 10 And osvi.dwMajorVersion = 4) End Function
Using:
bWindowsNT = IsWindowsNT() ' True, for Windows NT bWindows98 = IsWindows98() ' True, for Windows98
6.Read and write to system registry.
'Registry keys
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
'Registry access constants
Public Const KEY_QUERY_VALUE = &H1 'Permission to query subkey data.
Public Const KEY_SET_VALUE = &H2 'Permission to set subkey data.
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_READ = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Public Const KEY_WRITE = KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Public Const KEY_ALL_ACCESS = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_SUB_KEY Or KEY_CREATE_LINK Or KEY_SET_VALUE
Public Const REG_OPTION_NON_VOLATILE = 0&
Public Const REG_OPTION_VOLATILE = &H1
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Enum RegTypes
RegNonee = 0
RegSZ = 1
RegExpandSz = 2
RegBinary = 3
RegDword = 4
RegDwordLittleEndian = 4
RegDwordBigEndian = 5
RegLink = 6
RegMultiSz = 7
RegResourceList = 8
RegFulResourceDesc = 9
End Enum
Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Public Function RegGetValue(Root As Long, SubKey As String, Key As String) As String
Dim Buffer As String, hKey As Long, nType As Long, nSize As Long
RegGetValue = ""
If Not RegOpenKeyEx(Root, SubKey, 0, KEY_READ, hKey) Then
nSize = 0
RegQueryValueEx hKey, Key, 0, nType, Buffer, nSize
If hKey And nSize > 0 And nType = RegSZ Then
Buffer = Space(nSize + 1)
RegQueryValueEx hKey, Key, 0, nType, Buffer, nSize
RegGetValue = Left(Buffer, nSize - 1)
RegCloseKey hKey
End If
End If
End Function
Public Sub RegSetValue(Root As Long, SubKey As String, Key As String, value As String)
Dim hKey As Long, sa As SECURITY_ATTRIBUTES, nDisp As Long
If Not RegCreateKeyEx(Root, SubKey, 0, vbNull, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, sa, hKey, nDisp) Then
RegSetValueEx hKey, Key, 0, RegSZ, value, Len(value) + 1
RegCloseKey hKey
End If
End Sub
Using:
sUser = RegGetValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion", "RegisteredOwner") RegSetValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion", "RegisteredOwner", "Darth Vader"
Tip: this functions works only withs text keys (which have simbol 'ab' ).
7.How can you find out when will finish running process?
Option Explicit
Const INFINITE = &HFFFF
'StartupInfo constants
Public Const STARTF_FORCEOFFFEEDBACK = &H80
Public Const STARTF_FORCEONFEEDBACK = &H40
Public Const STARTF_RUNFULLSCREEN = &H20
Public Const STARTF_USECOUNTCHARS = &H8
Public Const STARTF_USEFILLATTRIBUTE = &H10
Public Const STARTF_USEPOSITION = &H4
Public Const STARTF_USESHOWWINDOW = &H1
Public Const STARTF_USESIZE = &H2
Public Const STARTF_USESTDHANDLES = &H100
'ShowWindow constants
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Public Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
'
Public Function RunAndWait(ComLine As String, DefaultDir As String, ShowFlag As VbAppWinStyle) As Boolean
Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
si.wShowWindow = ShowFlag
si.dwFlags = STARTF_USESHOWWINDOW
If CreateProcess(vbNullString, ComLine, ByVal 0&, ByVal 0&, False, 0, ByVal 0&, DefaultDir, si, pi) Then
WaitForSingleObject pi.hProcess, INFINITE
CloseHandle pi.hProcess
RunAndWait = True
Exit Function
End If
RunAndWait = False
End Function
Using:
If RunAndWait("rar.exe a regbackup system.dat user.dat", "c:\windows", vbNormalFocus) Then
MsgBox "Registry backuped!"
End If
8.A minimal window size.
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Const WM_GETMINMAXINFO = &H24 Public Type POINTAPI x As Long y As Long End Type Public Type MINMAXINFO ptReserved As POINTAPI ptMaxSize As POINTAPI ptMaxPosition As POINTAPI ptMinTrackSize As POINTAPI ptMaxTrackSize As POINTAPI End Type Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
Using: You need one more spechial control - Message Hooker. You can download it from here: msghoo32.zip. Put it on the form and write the next code:
At Form_Load:
Msghook1.HwndHook = Me.hwnd Msghook1.Message(WM_GETMINMAXINFO) = True
At Msghook1_Message:
Dim mmi As MINMAXINFO CopyMem mmi, ByVal lp, Len(mmi) mmi.ptMinTrackSize.x = 100 ' Minimal horizontal size in pxl mmi.ptMinTrackSize.y = 100 ' Minimal vertical size in pxl CopyMem ByVal lp, mmi, Len(mmi)
9.Restart/LogOff/Shutdown your computer.
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long Public Const EWX_FORCE = 4 Public Const EWX_LOGOFF = 0 Public Const EWX_REBOOT = 2 Public Const EWX_SHUTDOWN = 1
Using:
ExitWindowsEx EWX_FORCE + EWX_REBOOT, 0