操作VB中的無邊框窗體

發表于:2007-07-14來源:作者:點擊數: 標簽:
湖南省郴州市蘇仙區信用聯社(423000) 段岳輝 在 VB 中,BorderStyle屬性為0的窗體沒有邊框,并且也沒有與邊框相關的元素。這種窗體具有簡潔、占用空間少等優點,用它可以設計出某些富有個性的窗體。但是,由于它沒有標題欄,窗體不能移動,同時也不能改變大
湖南省郴州市蘇仙區信用聯社(423000) 段岳輝

VB中,BorderStyle屬性為0的窗體沒有邊框,并且也沒有與邊框相關的元素。這種窗體具有簡潔、占用空間少等優點,用它可以設計出某些富有個性的窗體。但是,由于它沒有標題欄,窗體不能移動,同時也不能改變大小,在某些情況下會給使用者造成一定的麻煩。本文介紹在VB中如何用API函數操作無邊框窗體。
移動窗體
新建一標準工程,設置Form1的BorderStyle屬性為0。此時運行程序后,無法移動窗體。為能移動窗體,在Form1的代碼窗口聲明下列函數和常數:
Option Explicit
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
Const WM_SYSCOMMAND = &H112
Const SC_MOVE = &HF012
在Form_MouseDown事件中輸入以下代碼:
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'按下鼠標左鍵
If Button = vbLeftButton Then  
'為當前的應用程序釋放鼠標捕獲
ReleaseCapture  
'移動窗體
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0  
End If
End Sub
注意:此時窗體上不能放置除Shape控件以外的任何控件,否則,在被控件遮住的地方點按鼠標還是無法移動窗體。要使點按控件也能移動窗體,需再添加一個該控件的MouseDown事件過程,代碼與上述過程代碼相似。
改變窗體的大小
為了改變窗體的大小,需要添加一個Timer控件,以定時捕獲鼠標在窗體中的位置。當鼠標位于窗體邊緣時,改變鼠標的形狀,以通知用戶可以進行改變大小的操作。為此,將Timer控件的Interval屬性設為100(即每過100毫秒檢測一下鼠標位置),其他取默認值。
在Form1的代碼窗口中再添加下列兩個函數,并定義兩個自定義變量和一個字符串變量:
'取得窗體位置的函數
Private Declare Function GetWindowRect Lib “user32” (ByVal hwnd As Long, lpRect As RECT) As Long  
'取得鼠標位置的函數
Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long  
'鼠標位置變量
Private Type POINTAPI  
x As Long
y As Long
End Type
'窗體位置變量
Private Type RECT  
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'所要執行的動作變量,是移動還是改變大小及從哪個方向改變大小
Dim Action As String  
在Timer1控件的Timer事件過程中添加以下代碼:
Private Sub Timer1_Timer()
Dim MyRect As RECT
Dim MyPoint As POINTAPI
' MyRect返回當前窗口位置
Call GetWindowRect(Me.hwnd, MyRect)
' MyPoint返回當前鼠標位置  
Call GetCursorPos(MyPoint)  
Select Case True
'鼠標位于窗體左上方
Case MyPoint.x < MyRect.Left + 5 And MyPoint.y < MyRect.Top + 5  
Screen.MousePointer = vbSizeNWSE  
Action = “LeftUp”
'鼠標位于窗體右下方
Case MyPoint.x > MyRect.Right - 5 And MyPoint.y > MyRect.Bottom - 5  
Screen.MousePointer = vbSizeNWSE  
Action = “RightDown”
'鼠標位于窗體右上方
Case MyPoint.x > MyRect.Right - 5 And MyPoint.y < MyRect.Top + 5
’45度雙向鼠標指針  
Screen.MousePointer = vbSizeNESW  
Action = “RightUp”
'鼠標位于窗體左下方
Case MyPoint.x < MyRect.Left + 5 And MyPoint.y > MyRect.Bottom - 5  
Screen.MousePointer = vbSizeNESW  
Action = “LeftDown”
'鼠標位于窗體左邊
Case MyPoint.x < MyRect.Left + 5  
'水平雙向鼠標指針
Screen.MousePointer = vbSizeWE  
Action = “Left”
'鼠標位于窗體右邊
Case MyPoint.x > MyRect.Right - 5  
Screen.MousePointer = vbSizeWE  
Action = “Right”
'鼠標位于窗體上方
Case MyPoint.y < MyRect.Top + 5  
'垂直雙向鼠標指針
Screen.MousePointer = vbSizeNS  
Action = “Up”
'鼠標位于窗體下方
Case MyPoint.y > MyRect.Bottom - 5  
Screen.MousePointer = vbSizeNS  
Action = “Down”
'鼠標位于窗體其他位置
Case Else  
'默認鼠標指針
Screen.MousePointer = 0  
Action = “Move”
End Select
End Sub
當利用SendMessage函數由系統向窗口發送改變大小的信息時,只要將上面移動窗體的語句“SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0”中的第3個參數改為相應的常數即可。
VB中&HF001~&HF008分別是從左、右、上、左上、右上、下、左下、右下8個方向改變窗體大小的常數。結合移動窗體的代碼,將上述Form_MouseDown事件的代碼綜合如下(也可以把這8個常數聲明為自定義常數):
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'按下鼠標左鍵
If Button = vbLeftButton Then  
'為當前的應用程序釋放鼠標捕獲
ReleaseCapture  
Select Case Action
Case “Left”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF001, 0
Case “Right”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF002, 0
Case “Up”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF003, 0
Case “LeftUp”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF004, 0
Case “RightUp”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF005, 0
Case “Down”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF006, 0
Case “LeftDown”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF007, 0
Case “RightDown”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF008, 0
Case “Move”
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
End Select
End If
End Sub

原文轉自:http://www.anti-gravitydesign.com

国产97人人超碰caoprom_尤物国产在线一区手机播放_精品国产一区二区三_色天使久久综合给合久久97