13. 無邊框窗體的右鍵菜單 設(shè)計(jì)無邊框窗體時(shí)，如果使用菜單編輯器，就會(huì)自動(dòng)改變成有邊框的窗體，此時(shí)，可以在另外一個(gè)窗體中（一般情況下你的程序應(yīng)該不止一個(gè)窗體的吧，如果真的只有一個(gè)，可以利用其他人寫的類，添加右鍵）編輯菜單（VISIBLE屬性設(shè)為FALSE），然后在本窗體中調(diào)用。調(diào)用形式如下：
- Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- If Button = 2 Then
- PopupMenu Form2.mymenu
- End If
- End Sub
- 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
- Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
- Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hrgn As _ Long, ByVal bRedraw As Boolean) As Long
- Private Sub Form_Load()
- hround = CreateRoundRectRgn(0, 0, ScaleX(Form1.ScaleWidth, vbTwips, vbPixels), _ ScaleY(Form1.ScaleHeight, vbTwips, vbPixels), 20, 20)
- SetWindowRgn Me.hwnd, hround, True
- DeleteObject hround
- End Sub
方法一：
- Private Declare Function ReleaseCapture Lib "user32" () As Long
- 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
- Private Const HTCAPTION = 2
- Private Const WM_NCLBUTTONDOWN = &HA1
- Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- Dim ncl As Long
- Dim rel As Long
- If Button = 1 Then
- i = ReleaseCapture()
- ncl = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
- End If
- End Sub
方法二：回調(diào)函數(shù)
- 'module:
- Public Const GWL_WNDPROC = (-4)
- Public Const WM_NCHITTEST = &H84
- Public Const HTCLIENT = 1
- Public Const HTCAPTION = 2
- 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
- Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As _
- Long, ByVal nIndex As Long) As Long
- Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As _
- Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
- Public prevWndProc As Long
- Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal _Param As Long) As Long
- WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
- If Msg = WM_NCHITTEST And WndProc = HTCLIENT Then
- WndProc = HTCAPTION
- End If
- End Function
- 窗體中:
- Private Sub Form_Load()
- prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
- SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
- End Sub
本站僅提供存儲(chǔ)服務(wù)，所有內(nèi)容均由用戶發(fā)布，如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請(qǐng)
點(diǎn)擊舉報(bào)。
