回 帖 发 新 帖 刷新版面

主题:把按纽放到窗体标题栏的代码

通常窗体标题栏的右边是最小化、最大化、关闭三个按纽,左边是窗体图标和窗体标题。现在我们
把功能按纽放到标题栏左边去,不但节省了空间,也使窗体看起来别有一番风味。
新建一个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旗舰版通过,未在其它版本试验,理论上应该没什么问题。


回复列表 (共1个回复)

沙发

①框架中放一个660×360的按纽,名称要改为command,位置要在框架的左上角。

②7个command的标题,实际也可以纳入循环。

Private Sub Form_Load()
    Dim i As Integer, MingCheng As Variant
    MingCheng = Array("打开", "保存", "另存为", "编辑", "选项", "设置", "帮助", "关于")
    For i = 0 To 7
        If i Then Load Command1(i)
        Command1(i).Visible = True
        Command1(i).Top = 15
        Command1(i).Left = Command1(0).Width * i + 15
        Command1(i).Caption = MingCheng(i)
    Next
    Fhwnd = Frame1.hwnd
    Mhwnd = Me.hwnd
    Hook
End Sub
③替大侠增补一个效果图


我来回复

您尚未登录,请登录后再回复。点此登录或注册