; Call DisableCtrlAltDelete(False)
16、如何移动没有标题栏的窗口？
我们一般是用鼠标按住窗口的标题栏，然后移动窗口，当窗口没有标题栏时，我们可以用下面的方法来移动窗口：
*API函数声明：
Declare Function ReleaseCapture Lib "user32" () As Long 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 HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
在 Form_MouseDown 事件中：
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION,0&
End Sub
17、VB中如何使用延时函数？
*API函数声明：
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
调用：
注释：延时1秒
Call Sleep(1000)
18、调用修改屏幕保护口令的窗口：
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)
19、使Windows开始屏幕保护：
*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&)
20、如何改变Windows桌面背景？
*API函数声明
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, "C:windowsClouds.bmp", SPIF_UPDATEINIFILE)
21、怎样确定系统是否安装了声卡？
*API函数声明：
Declare Function waveOutGetNumDevs Lib "winmm.dll" Alias "waveOutGetNumDevs" () As Long
代码如下：
Dim i As Integer
i = waveOutGetNumDevs()
If i > 0 Then MsgBox "你的系统可以播放声音。", vbInformation, "声卡检测"
Else
MsgBox "你的系统不能播放声音。", vbInformation, "声卡检测"
End If
22、如何找到CD-ROM驱动器的盘号？
下面的函数将检查你计算机所有的驱动器看是否是 CD-ROM，如果是就返回驱动器号，如果没有就返回空字符
Public Function GetCDROMDrive() As String
Dim lType As Long,i As Integer,tmpDrive as String,found as Boolean
On Error GoTo errL
For i = 0 To 25
tmpDrive = Chr(65 + i) & ":"
lType = GetDriveType(tmpDrive) 注释：Win32 API 函数
If (lType = DRIVE_CDROM) Then 注释：Win32 API 常数
found = True
Exit For
End If
Next
If Not found Then tmpDrive = ""
BI_GetCDROMDrive = tmpDrive
exit Function
errL: msgbox error$
End Function
23、如何将文件放入回收站？
**API函数声明
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
Public Declare Function SHFileOperation Lib _ "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40
注释：调用
Dim SHop As SHFILEOPSTRUCT, strFile as string
With SHop
.wFunc = FO_DELETE
.pFrom = strFile + Chr(0)
.fFlags = FOF_ALLOWUNDO
End With
24、VB中如何使用未安装的字体？
Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long
增加字体：
Dim lResult As Long
lResult = AddFontResource("c:myAppmyFont.ttf")
删除字体：
Dim lResult As Long
lResult = RemoveFontResource("c:myAppmyFont.ttf")
上一页 [1] [2] |
