VB6.0寫的,搭肆棗代碼很雹帶簡單,無意中寫成的。應該可以參考。不需要任何api函數(shù)。在無邊框窗體頂部中放入一個label標簽。然后用知拆label的 mouse down 和mouse move事件實現(xiàn)
創(chuàng)新互聯(lián)建站長期為近1000家客戶提供的網(wǎng)站建設服務,團隊從業(yè)經(jīng)驗10年,關注不同地域、不同群體,并針對不同對象提供差異化的產(chǎn)品和服務;打造開放共贏平臺,與合作伙伴共同營造健康的互聯(lián)網(wǎng)生態(tài)環(huán)境。為阿克塞哈薩克族自治企業(yè)提供專業(yè)的網(wǎng)站制作、成都網(wǎng)站設計,阿克塞哈薩克族自治網(wǎng)站改版等技術服務。擁有十載豐富建站經(jīng)驗和眾多成功案例,為您定制開發(fā)。
Dim a, b As Single
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
a = X
b = Y
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Form1.Move Left + X - a, Top + Y - b
End If
End Sub
在VB中,BorderStyle屬性為0的窗體沒有邊框,并且也沒有與邊框相關的元素。這種窗體具有簡潔、占用空間少等優(yōu)點,用它可以設計出某些富有個性的窗體。但是,由于它沒有標題欄,窗體不能移動,同時也不能改變大小,在某些情況下會給使用者造成一定的麻煩。本文介紹在VB中如何用API函數(shù)操作無邊框窗體。
移動窗體
新建一標準工程,設置Form1的BorderStyle屬性為0。此時運行程序后,無法移動窗體。為能移動窗體,在Form1的代碼窗口聲明下列函數(shù)和常數(shù):
Option Explicit
Private Declare Function ReleaseCapture Lib “user32” ()AsLong
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,XAs Single, Y As Single)
按下鼠標左鍵
If Button = vbcenterButton Then
為當前的應用程序釋放鼠標捕獲
ReleaseCapture
移動窗租逗體
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
End If
End Sub
雹型歲注意:此時窗體上不能放置除Shape控件以外的任何控件,否則,在被控件遮住的地方點按鼠標還是無法移動窗體。要使點按控件也能移動窗體,需再添加一個該控件的MouseDown事件過程,代碼與上述過程代碼相似。
改變窗體的大小
為了改變窗體的大小,需要添加一個Timer控件,以定時捕獲鼠標在窗體中的位置。當鼠標位于窗體邊緣時,改變鼠標的形狀,以通知用戶可以進行改變大小的操作。為此,將Timer控件的Interval屬性設為100(即每過100毫秒檢測一下鼠標位置),其他取默認值。
在Form1的代碼窗口中再添加下列兩個函數(shù),并定義兩個自定義變量和一個字符串變量:
取得窗體位置的函數(shù)
Private Declare Function GetWindowRect Lib “user32” (ByVal hwndAsLong, lpRect As RECT) As Long
取得鼠標位置的函數(shù)
Private Declare Function GetCursorPos Lib “user32” (lpPointAsPOINTAPI) As Long
鼠標位置變量
Private Type POINTAPI
x As Long
y As Long
End Type
窗體位置變量
Private Type RECT
center As Long
Top As Long
center As Long
Bottom As Long
End Type
所要執(zhí)行的動作變量,是移動還是改變大小及從哪個方向改變大小
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.center + 5 And MyPoint.y ="" p=""
Screen.MousePointer = vbSizeNWSE
Action = “centerUp”
鼠標位于窗體右下方
Case MyPoint.x MyRect.center - 5 And MyPoint.yMyRect.Bottom - 5
Screen.MousePointer = vbSizeNWSE
Action = “centerDown”
鼠標位于窗體右上方
Case MyPoint.x MyRect.center - 5 And MyPoint.y="" p="" +=""
’45度雙向鼠標指針
Screen.MousePointer = vbSizeNESW
Action = “centerUp”
鼠標位于窗體左下方
Case MyPoint.x MyRect.center + 5 And MyPoint.yMyRect.Bottom - 5
Screen.MousePointer = vbSizeNESW
Action = “centerDown”
鼠標位于窗體左邊
Case MyPoint.x MyRect.center + 5
水平雙向鼠標指針
Screen.MousePointer = vbSizeWE
Action = “center”
鼠標位于窗體右邊熱門推薦: C++程序設計之四書五經(jīng) 談談JAVA程序的反編譯1 2
MyRect.center - 5
Screen.MousePointer = vbSizeWE
Action = “center”
鼠標位于窗體上方
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函數(shù)由系統(tǒng)向窗口發(fā)送改變大小的信息時,只要將上面移動窗體的語句“SendMessageMe.hwnd,WM_SYSCOMMAND, SC_MOVE, 0”中的第3個參數(shù)改為相應的常數(shù)即可。
VB中HF001~HF008分別是從左、右、上、左上、右上、下、左下、右下8個方向改變窗體大小的常數(shù)。結合移動窗體的代碼,將上述Form_MouseDown事件的代碼綜合如下(也可以把這8個常數(shù)聲明為自定義常數(shù)):
Private Sub Form_MouseDown(Button As Integer, Shift As Integer,xAs Single, y As Single)
按下鼠標左鍵
If Button = vbcenterButton Then
為當前的應用程序釋放鼠標捕獲
ReleaseCapture
Select Case Action
Case “center”
SendMessage Me.hwnd, WM_SYSCOMMAND, HF001, 0
Case “center”
SendMessage Me.hwnd, WM_SYSCOMMAND, HF002, 0
Case “Up”
SendMessage Me.hwnd, WM_SYSCOMMAND, HF003, 0
Case “centerUp”
SendMessage Me.hwnd, WM_SYSCOMMAND, HF004, 0
Case “centerUp”
SendMessage Me.hwnd, WM_SYSCOMMAND, HF005, 0
Case “Down”
SendMessage Me.hwnd, WM_SYSCOMMAND, HF006, 0
Case “centerDown”
SendMessage Me.hwnd, WM_SYSCOMMAND, HF007, 0
Case “centerDown”
SendMessage Me.hwnd, WM_SYSCOMMAND, HF008, 0
Case “Move”
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
End Select
End If
End Sub
Imports System Drawing Imports System Windows Forms 裂搭手 ****************************************** Private oOriginalRegion As Region = Nothing 用于窗體移動 Private bFormDragging As Boolean = False Private oPointClicked As Point ****************************************** Private Sub Form _MouseDown(ByVal sender As Object ByVal e As System Windows Forms MouseEventArgs) Handles MyBase MouseDown Me bFormDragging = True Me oPointClicked = New Point(e X e Y) End Sub ****************************************** Private Sub Form _MouseUp(ByVal sender As Object ByVal e As System Windows Forms MouseEventArgs) Handles MyBase MouseUp Me bFormDragging = False End Sub ****************************************** Private Sub Form _MouseMove(ByVal sender As Object ByVal e As System Windows Forms MouseEventArgs) Handles MyBase MouseMove If Me bFormDragging Then Dim oMoveToPoint As Point 以當前鼠標肆嫌位置為基礎 找出目標位置 oMoveToPoint = Me PointToScreen(New Point(e X e Y)) 枝兄 根據(jù)開始位置作出調整 oMoveToPoint Offset(Me oPointClicked X * _ (Me oPointClicked Y + _ SystemInformation CaptionHeight + _ SystemInformation BorderSize Height) * ) 移動窗體 Me Location = oMoveToPoint End If
lishixinzhi/Article/program/ASP/201311/21755
當用戶按下旁空左鍵時,為按下對象的MouseMove事件綁定處理方法,并記錄鼠標坐標(窗體左上角為原點,在事件的MouseEventArgs類型的e參數(shù)中提供)。運敗瞎此時用戶移動鼠標,保持窗體原點與鼠標新坐標的相對位置不變枯肢。當用戶釋放左鍵時,撤銷按下對象的MouseMove事件處理方法