如何实现richwin或两岸通的浮动的工具栏.txt

VB技巧问答10000例 VB技巧问答10000例

这 个 问 题 的 关 键 是 要 实 现 移 动 没 有 标 题 的 窗 体 。 下 面 我 们 以 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函 数 转 换 窗 体 坐 标 为 屏 幕 坐 标 
<END>