问专家-如何实现浮动没有标题的窗体

软件注册站

热情软件屋

如何实现浮动没有标题的窗体

编号：	QA000091
建立日期：	1998年11月12日	最后修改日期：	1999年8月31日
所属类别：	Visual Basic - 窗体与菜单

如何实现RichWin或两岸通的浮动的工具栏?(George)

    这个问题的关键是要实现移动没有标题的窗体。下面我们以VB为例介绍如何实现这点。
    首先，建立一个窗体，将BorderStyle设为0 - None，去掉窗体的标题。
    然后建立一个模块，输入下面这些声明语句：
    Option Explicit

    Public Type RECT
     Left As Long
     Top As Long
     Right As Long
     Bottom As Long
    End Type

    Public Type POINTAPI
     x As Long
     y As Long
    End Type

    Public Const COLOR_ACTIVECAPTION = 2
    Public Const SM_CXDLGFRAME = 7
    Public Const SM_CYDLGFRAME = 8

    Public Declare Function GetWindowRect Lib "user32" _
     (ByVal hwnd As Long, lpRect As RECT) As Long

    Public Declare Function GetSysColor Lib "user32" _
     (ByVal nIndex As Long) As Long

    Public Declare Function GetSystemMetrics Lib "user32" _
     (ByVal nIndex As Long) As Long

    Public Declare Function DrawFocusRect Lib "user32" _
     (ByVal hdc As Long, lpRect As RECT) As Long

    Public Declare Function ClientToScreen Lib "user32" _
     (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

    Public Declare Function GetDC Lib "user32" _
     (ByVal hwnd As Long) As Long

    Public Declare Function ReleaseDC Lib "user32" _
     (ByVal hwnd As Long, ByVal hdc As Long) As Long

    在窗体中输入以下代码：

    Option Explicit
    Dim tpoint As POINTAPI
    Dim temp As POINTAPI
    Dim dpoint As POINTAPI

    Dim fbox As RECT
    Dim tbox As RECT
    Dim oldbox As RECT

    Dim TwipsPerPixelX
    Dim TwipsPerPixelY

    Private Sub BeginFRDrag(x As Single, y As Single)
     Dim tDc As Long
     Dim sDc As Long
     Dim d As Long

     MousePointer = 5
     'convert points to POINTAPI struct
     dpoint.x = x
     dpoint.y = y

     'get screen area of toolbar
     GetWindowRect hwnd, fbox
     'screen Rect of toolbar
     TwipsPerPixelX = Screen.TwipsPerPixelX
     TwipsPerPixelY = Screen.TwipsPerPixelY

     'get point of mousedown in screen coordinates
     temp = dpoint
     ClientToScreen hwnd, temp

     sDc = GetDC(ByVal 0)
     DrawFocusRect sDc, tbox
     d = ReleaseDC(0, sDc)
     oldbox = tbox
    End Sub

    Private Sub DoFRDrag(x As Single, y As Single)
     Dim tDc As Long
     Dim sDc As Long
     Dim d As Long

     tpoint.x = x
     tpoint.y = y

     ClientToScreen hwnd, tpoint

     tbox.Left = (fbox.Left + tpoint.x / TwipsPerPixelX) - temp.x / TwipsPerPixelX
     tbox.Top = (fbox.Top + tpoint.y / TwipsPerPixelY) - temp.y / TwipsPerPixelY
     tbox.Right = (fbox.Right + tpoint.x / TwipsPerPixelX) - temp.x / TwipsPerPixelX
     tbox.Bottom = (fbox.Bottom + tpoint.y / TwipsPerPixelY) - temp.y / TwipsPerPixelY

     sDc = GetDC(ByVal 0)
     DrawFocusRect sDc, oldbox
     DrawFocusRect sDc, tbox
     d = ReleaseDC(0, sDc)
     oldbox = tbox
    End Sub

    Private Sub EndFRDrag(x As Single, y As Single)
     Dim tDc As Long
     Dim sDc As Long
     Dim d As Long

     Dim newleft As Single
     Dim newtop As Single

     sDc = GetDC(ByVal 0)
     DrawFocusRect sDc, oldbox
     d = ReleaseDC(0, sDc)

     newleft = x + fbox.Left * TwipsPerPixelX - dpoint.x
     newtop = y + fbox.Top * TwipsPerPixelY - dpoint.y

     Move newleft, newtop
     MousePointer = 0
    End Sub

    Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Button = 2 Then BeginFRDrag x, y
    End Sub

    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Button = 2 Then DoFRDrag x, y
    End Sub

    Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     If Button = 2 Then EndFRDrag x, y
    End Sub
    这样只要你按下右键就可以移动窗体。这里面的一个关键就是使用ClientToScreen函数转换窗体坐标为屏幕坐标。
    另外，参考 QA001635 "如何在无标题窗体上使用菜单"。

此问题由李海回答。

附加关键字：编程, 源程序, programming, source code, Visual Basic, VB, 窗体与菜单, form, window, tform。

	把这个问题推荐给朋友

版权所有 1997-2008 热情软件屋
如果您有任何建议和意见, 请给我发个电子邮件 askpro@china-askpro.com。

Web Designed by ZebraStudio