vb技巧6

使用 IIF 和 SWITCH 以精减代码
在很多地方你都可以使用一个更紧凑的 IIf?函数来代替 If...Else...Endif 的结构：
例：返回两个值中较大的一个
maxValue = IIf(first >= second, first, second)
Switch 则是一个很少使用的函数，可是在很多方面它都提供比 If...ElesIf 结构更好的
例：判断 "x" 是正、负还是 null?
Print Switch(x<0,"负",x>0,"正", True, "Null")
返回
取得 DOS 环境变量
使用 Environ 函数：
Dim x As Integer
Dim Env As String
x = 1
Env = Environ(x)
Do Until Env = ""
Env = Environ(x)
Debug.Print Env
x = x + 1
Loop
返回

修改屏幕保护的口令
声明：
Private Declare Function PwdChangePassword Lib "mpr" Alias "PwdChangePasswordA" _
(ByVal lpcRegkeyname As String, ByVal hwnd As Long, ByVal uiReserved1 As _
Long, ByVal uiReserved2 As Long) As Long
使用：
' 出现修改屏幕保护口令的窗口
Call PwdChangePassword("SCRSAVE", Me.hwnd, 0, 0)
返回

使用 API 开始屏幕保护
声明：
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg _
As Long, ByVal wParam As Long, ByVal lParam As Long) _
As Long
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
代码：
Dim result As Long
result = SendMessage(Form1.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
返回

取得和设置系统颜色
声明：
Public Const COLOR_SCROLLBAR = 0 '滚动条
Public Const COLOR_BACKGROUND = 1 '桌面背景
Public Const COLOR_ACTIVECAPTION = 2 '活动窗口标题
Public Const COLOR_INACTIVECAPTION = 3 '非活动窗口标题
Public Const COLOR_MENU = 4 '菜单
Public Const COLOR_WINDOW = 5 '窗口背景
Public Const COLOR_WINDOWFRAME = 6 '窗口框
Public Const COLOR_MENUTEXT = 7 '窗口文字
Public Const COLOR_WINDOWTEXT = 8 '3D 阴影 (Win95)
Public Const COLOR_CAPTIONTEXT = 9 '标题文字
Public Const COLOR_ACTIVEBORDER = 10 '活动窗口边框
Public Const COLOR_INACTIVEBORDER = 11 '非活动窗口边框
Public Const COLOR_APPWORKSPACE = 12 'MDI 窗口背景
Public Const COLOR_HIGHLIGHT = 13 '选择条背景
Public Const COLOR_HIGHLIGHTTEXT = 14 '选择条文字
Public Const COLOR_BTNFACE = 15 '按钮
Public Const COLOR_BTNSHADOW = 16 '3D 按钮阴影
Public Const COLOR_GRAYTEXT = 17 '灰度文字
Public Const COLOR_BTNTEXT = 18 '按钮文字
Public Const COLOR_INACTIVECAPTIONTEXT = 19 '非活动窗口文字
Public Const COLOR_BTNHIGHLIGHT = 20 '3D 选择按钮

Declare Function SetSysColors Lib "user32" Alias "SetSysColors" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
Declare Function GetSysColor Lib "user32" Alias "GetSysColor" (ByVal nIndex As Long) As Long
使用：
i =GetSysColors(COLOR_ACTIVECAPTION)
'i 是 RGB 值
i = SetSysColors(1, COLOR_ACTIVECAPTION, RGB(255,0,0))
'把标题设置为红色
返回

改变墙纸
声明：
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
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
用法：
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, BMP名称, SPIF_UPDATEINIFILE)
例子：
' 1. 把桌面图片设为 c:\windows\setup.bmp
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:\windows\setup.bmp", SPIF_UPDATEINIFILE)
' 2. 将桌面图片清除
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "", SPIF_UPDATEINIFILE)
返回

动态改变屏幕设置
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Private 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
Private Declare Function _
ChangeDisplaySettings Lib _
"User32" Alias "ChangeDisplaySettingsA" (_
ByVal lpDevMode As Long, _
ByVal dwflags As Long) As Long
'函数
Public Function SetDisplayMode(Width As _
Integer,Height As Integer, Color As _
Integer) As Long
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_BITSPERPEL = &H40000
Dim NewDevMode As DEVMODE
Dim pDevmode As Long
With NewDevMode
.dmSize = 122
If Color = -1 Then
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
Else
.dmFields = DM_PELSWIDTH Or _
DM_PELSHEIGHT Or DM_BITSPERPEL
End If
.dmPelsWidth = Width
.dmPelsHeight = Height

If Color <> -1 Then
.dmBitsPerPel = Color
End If
End With
pDevmode = lstrcpy(NewDevMode, NewDevMode)
SetDisplayMode = ChangeDisplaySettings(pDevmode, 0)
End Function
例子调用：改变为 640x480x24位：
i = SetDisplayMode(640, 480, 24)
如果成功返回 0 。参见：X059 改变屏幕到16位彩色的演示
返回

桌面的大小
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public Const SPI_GETWORKAREA = 48

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

Private Sub Command1_Click()

Dim lRet As Long
Dim apiRECT As RECT

lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, apiRECT, 0)

If lRet Then
Print "Left: " & apiRECT.Left
Print "Top: " & apiRECT.Top
Print "Width: " & apiRECT.Right - apiRECT.Left
Print "Height: " & apiRECT.Bottom - apiRECT.Top
Else
Print "调用 SystemParametersInfo 失败"
End If

End Sub

其他方法：
Sub Command1_Click ()
CR$ = Chr$(13) + Chr$(10)
TWidth% = screen.Width \ screen.TwipsPerPixelX
THeight% = screen.Height \ screen.TwipsPerPixelY

MsgBox "屏幕大小为" + CR$ + CR$ + Str$(TWidth%) + " x" + Str$(THeight%), 64, "Info"
End Sub
返回

禁止使用 Alt+F4 关闭窗口
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Const MF_BYPOSITION = &H400&

Private Sub Form_Load()
Dim hwndMenu As Long
Dim c As Long
hwndMenu = GetSystemMenu(Me.hwnd, 0)

c = GetMenuItemCount(hwndMenu)

DeleteMenu hwndMenu, c - 1, MF_BYPOSITION

c = GetMenuItemCount(hwndMenu)
DeleteMenu hwndMenu, c - 1, MF_BYPOSITION

End Sub