主题:把按纽放到窗体标题栏的代码
把功能按纽放到标题栏左边去,不但节省了空间,也使窗体看起来别有一番风味。
新建一个8882×4950的窗体(如果你新建窗体的宽度不相同,那么就要修改模块中的有关代码的数
据),在窗体上放置一个文本框、一个框架,框架中放一个660×360的按纽,其Index属性值设为0。窗
体代码如下:
Option Explicit
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 7: Load Command(i): Command(i).Visible = True: Command(i).Left = Command(0).Width * i + 15: Next
Command(0).Caption = "打开"
Command(1).Caption = "保存"
Command(2).Caption = "另存为"
Command(3).Caption = "编辑"
Command(4).Caption = "选项"
Command(5).Caption = "设置"
Command(6).Caption = "帮助"
Command(7).Caption = "关于"
Fhwnd = Frame1.hwnd
Mhwnd = Me.hwnd
Hook
End Sub
Private Sub Command_Click(Index As Integer)
Select Case Index
Case 0: 打开
Case 1:
Case 2: 另存为
End Select
End Sub
Private Sub 打开()
On Error GoTo 100
Dim Dlg As Object, openName As String, st As String, z As String
Set Dlg = CreateObject("MSComDlg.CommonDialog")
With Dlg
.DialogTitle = "打开"
.Flags = &H1000
.CancelError = True
.Filter = "txt文件|*.txt"
.showopen
openName = .FileName
End With
Open openName For Input As #1
Do Until EOF(1)
Line Input #1, z
st = st & z & vbCrLf
Loop
Close #1
Text1 = st
100
End Sub
Private Sub 另存为()
On Error GoTo 100
Dim Dlg As Object, saveName As String
Set Dlg = CreateObject("MSComDlg.CommonDialog")
With Dlg
.DialogTitle = "另存为"
.Flags = &H802
.CancelError = True
.Filter = "txt文件|*.txt"
.showsave
saveName = .FileName
End With
Open saveName For Output As #2
Print #2, Text1
Close #2
100
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub
我在代码里设置了8个按纽,按纽数量你可根据需要增减(模块中的有关代码数据也须作相应修改)。
再在工程中添加一个模块,模块代码如下:
Option Explicit
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Fhwnd As Long '框架的句柄
Public Mhwnd As Long '窗体的句柄
Dim lpPrevWndProc As Long
Sub Hook()
SetParent Fhwnd, 0
SetWindowLong Fhwnd, -8, Mhwnd
lpPrevWndProc = SetWindowLong(Mhwnd, -4, AddressOf WindowProc)
End Sub
Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = 5 Or uMsg = 3 Then '如果是窗口变化的消息才处理
Dim t As RECT, w As Long
GetWindowRect hw, t
w = t.Right - t.Left
w = IIf(w > 463, 355, w - 108 - 2)'框架的最大宽度为355像素
MoveWindow Fhwnd, t.Left, t.Top + 2, w, 24, 1
End If
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function
Sub Unhook()
SetWindowLong Mhwnd, -4, lpPrevWndProc
End Sub
下面对模块中的WindowProc函数作一简要分析。
在勾子函数中,uMsg = 5,指第5类消息,是关于窗口或焦点变化的消息。uMsg = 3,第3类消息,
是投放至消息队列中的消息。
GetWindowRect获取窗体矩形左、上、右、下4个数据,其中右数据减去左数据=矩形宽度,这个宽
度值很重要。
MoveWindow移动框架在矩形中的位置,所以在框架的句柄后面紧跟着框架左边距、上边距、宽度、
高度4个参数。代码中的左边距相当于=0,把窗体图标遮住了,如果想露出图标,可以改成t.Left+24,
那么上面一句也要改为:w = IIf(w > 487, 355, w - 132 - 2)。w是框架的宽度,当窗体宽缩小时,
它也会相应缩小。355是框架在常态下的宽度,如果按纽数量不是8个,那么这个值也要变化,目的是不
把框架显示出来。24是框架的高度值。这4个参数的单位都是像素。
CallWindowProc是将消息传给窗口的API函数,第3类消息和第5类消息本代码进行了处理,其它还有
未经处理的消息,这些都要由此函数传给窗口。
本代码在win7旗舰版通过,未在其它版本试验,理论上应该没什么问题。