|
把 VB 标准的工具栏变成平面式
平面式的工具栏好象显得很酷！但 VB5 只提供了普通的凸起的工具栏。你是否想把它变成平面的？这似乎很不容易。但事实并非如此，试试：
BAS:
Public Const WM_USER = &H400
Public Const TB_SETSTYLE = WM_USER + 56
Public Const TB_GETSTYLE = WM_USER + 57
Public Const TBSTYLE_FLAT = &H800
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
SUB:
Private Sub MakeFlat()
Dim style As Long
Dim hToolbar As Long
Dim r As Long
hToolbar = FindWindowEx(Toolbar1.hwnd, 0&, "ToolbarWindow32", vbNullString)
style = SendMessageLong(hToolbar, TB_GETSTYLE, 0&, 0&)
If style And TBSTYLE_FLAT Then
style = style Xor TBSTYLE_FLAT
Else: style = style Or TBSTYLE_FLAT
End If
r = SendMessageLong(hToolbar, TB_SETSTYLE, 0, style)
Toolbar1.Refresh
End Sub
注意：需要 4.70 或其以上版本的 comctl32.dll 支持。
--------------------------------------------------------------------------------
在 Caption 中显示 & 符号
大家知道，& 符号是 Windows 的快捷键表示符号，如果要在 Caption 中显示 & ，方法很简单，连续输入两个 & 符号即可。如在 Caption 中输入 Save && Exit，则显示 Save & Exit。
[返回技巧索引]
--------------------------------------------------------------------------------
让窗口一直在上面
很多流行软件都有这样一个选项：Always on Top。它可以让窗口在最上面，别的窗口不能覆盖它。我们在 VB 中，可以使用下面的方法来实现：
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOCOPYBITS = &H80
Private Const SWP_NOOWNERZORDER = &H200
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Private Const SWP_NOREPOSITION = SWP_NOOWNERZORDER Private Const HWND_TOP = 0
Private Const HWND_BOTTOM = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
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 mbOnTop As Boolean
Private Property Let OnTop(Setting As Boolean)
if Setting Then
SetWindowPos hwnd, -1, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Else
SetWindowPos hwnd, -2, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End If
mbOnTop = Setting
End Property
Private Property Get OnTop() As Boolean
''''Return the private variable set in Property Let
OnTop = mbOnTop
End Property
调用 OnTop=True 即可让窗口 Always OnTop。
此技巧由 eaboy 提供。
[返回技巧索引]
--------------------------------------------------------------------------------
播放资源文件文件中的声音
VB 提供的方法使我们可以很容易地使用资源文件中的字符、图片等资源。我们可以用以下方法播放资源文件中的 wav 声音：
首先，在你的资源文件的源文件 (RC) 文件加入下面一行：
MySound WAVE c:\music\vanhalen.wav
然后将其编译为 RES 文件。最后使用下面的声明及代码：
Private Declare Function PlaySound Lib _ "winmm.dll" Alias "PlaySoundA" ( _ ByVal lpszName As String, _ ByVal hModule As Long, _ ByVal dwFlags As Long) As Long
Private Const SND_ASYNC& = &H1
Private Const SND_NODEFAULT& = &H2
Private Const SND_RESOURCE& = &H40004
Dim hInst As Long
Dim sSoundName As String
Dim lFlags As Long
Dim lRet As Long
Private Sub Command1_Click()
hInst = App.hInstance
sSoundName = "MySound"
lFlags = SND_RESOURCE + SND_ASYNC + _ SND_NODEFAULT
lRet = PlaySound(sSoundName, hInst, lFlags)
End Sub
[返回技巧索引]
--------------------------------------------------------------------------------
使用枚举变量
VB5 引入枚举变量，使用它，我们可以显著地改变应用程序的易读性：
Public Enum TimeOfDay
Morning = 0
Afternoon = 1
Evening = 2
End Enum
Sub Main()
Dim RightNow As TimeOfDay
If Time >= #12:00:00 AM# And Time < #12:00:00 PM# Then
RightNow = Morning
ElseIf Time >= #12:00:00 PM# And Time < #6:00:00 PM# Then
RightNow = Afternoon
ElseIf Time >= #6:00:00 PM# Then
RightNow = Evening
End If
End Sub
[返回技巧索引]
--------------------------------------------------------------------------------
动态改变屏幕设置
我们经常看到许多 Win95 的应用程序（尤其是游戏）在运行它的时候改变屏幕的设置，运行完后恢复，在 VB 中，我们可以用以下方法实现：
''''- 定义
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 。
[返回技巧索引]
--------------------------------------------------------------------------------
移动没有标题栏的窗口
我们一般是用鼠标按住窗口的标题栏，然后移动窗口，当窗口没有标题栏时，我们可以用下面的方法来移动窗口：
在 BAS 文件中声明：
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Func [1] [2] 下一页 |
