VB入门技巧N例(5)

13.  无边框窗体的右键菜单
设计无边框窗体时，如果使用菜单编辑器，就会自动改变成有边框的窗体，此时，可以在另外一个窗体中（一般情况下你的程序应该不止一个窗体的吧，如果真的只有一个，可以利用其他人写的类，添加右键）编辑菜单（VISIBLE属性设为FALSE），然后在本窗体中调用。调用形式如下：

1. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
2. If Button = 2 Then
   
3. PopupMenu Form2.mymenu
   
4. End If
   
5. End Sub

复制代码

14.创建圆角无边框窗体

1. Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Integer, ByVal Y1 _ As Integer, ByVal X2 As Integer, ByVal Y2 As Integer, ByVal x3 As Integer, ByVal y3 As _ Integer) As Long
   
2. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
   
3. Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hrgn As _ Long, ByVal bRedraw As Boolean) As Long
   
4. Private Sub Form_Load()
   
5.      hround = CreateRoundRectRgn(0, 0, ScaleX(Form1.ScaleWidth, vbTwips, vbPixels), _ ScaleY(Form1.ScaleHeight, vbTwips, vbPixels), 20, 20)
   
6. SetWindowRgn Me.hwnd, hround, True
   
7. DeleteObject hround
   
8. End Sub

复制代码

15.拖动没有标题栏的窗体
方法一：

1. Private Declare Function ReleaseCapture Lib "user32" () As Long
   
2. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As _ Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
   
3. Private Const HTCAPTION = 2
   
4. Private Const WM_NCLBUTTONDOWN = &HA1
   
5. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   
6.    Dim ncl As Long
   
7.    Dim rel As Long
   
8.    If Button = 1 Then
   
9.      i = ReleaseCapture()
   
10.      ncl = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    
11.    End If
    
12. End Sub

复制代码

方法二：回调函数

1. 'module:
   
2. Public Const GWL_WNDPROC = (-4)
   
3. Public Const WM_NCHITTEST = &H84
   
4. Public Const HTCLIENT = 1
   
5. Public Const HTCAPTION = 2
   
6. 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
   
7. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As _
   
8. Long,  ByVal nIndex As Long) As Long
   
9. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As _
   
10. Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
11. Public prevWndProc As Long
    
12. Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal _Param As Long) As Long
    
13. WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
    
14.    If Msg = WM_NCHITTEST And WndProc = HTCLIENT Then
    
15.    WndProc = HTCAPTION
    
16.    End If
    
17. End Function
    
18. 窗体中:
    
19. Private Sub Form_Load()
    
20.    prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    
21.    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
    
22. End Sub
    
23. Private Sub Form_Unload(Cancel As Integer)
    
24.   SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
    
25. End Sub

复制代码