如何在所有控件上边画出线框?比如拖拽控件时的那个跟随鼠标的线框。

解决方案 »

  1.   

    在mousemove事件中,先在窗体上拉出四条线,在需要划线的时候,根据当前控件的位置移动线条,.move即可
      

  2.   

    鼠标拖拽的线框,是一个反色框。实现移动其实就是:时不断擦除原来的线段,再重画现有的线段。所谓的擦除就是在原来位置上再重画一次。绘制窗口的焦点虚线框,有现成的 API 可用:DrawFocusRect 如果你嫌他画太细了,可以多画几道。以下是我以前写的一个函数,他可以围绕窗口画一个框(不过不是虚线,如更改为虚线只需把构造画笔的 API 函数传递的常量改一下:CreatePen(PS_INSIDEFRAME, 3, vbRed) 把 PS_INSIDEFRAME 改为 PS_Dot 即可)。注意:API 画虚线时是不可以设定宽度的只能是 1 ,如果想画粗点还是上面说的老办法,以不同矩形大小多画几道框框。'围绕窗口绘制反色方框。
    Public Sub DrawFrame(ByVal hWnd As Long)
        Dim hDC As Long, Rect As Rect
        Dim Pen As Long, Brush As Long
        Dim OldMode As Long, OldPen As Long, OldBrush As Long
        
        Call GetWindowRect(hWnd, Rect)                      '获取窗口矩形区域
        hDC = GetWindowDC(hWnd)                             '获取窗口场景
        
        Pen = CreatePen(PS_INSIDEFRAME, 3, vbRed)           '构造画笔
        Brush = GetStockObject(NULL_BRUSH)                  '构造画刷
        
        OldMode = SetROP2(hDC, vbInvert)                    '选定绘制模式
        OldPen = SelectObject(hDC, Pen)                     '选定画笔
        OldBrush = SelectObject(hDC, Brush)                 '选定画刷
        
        Rectangle hDC, 0, 0, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top '绘制矩形
        
        Call SetROP2(hDC, OldMode)                          '恢复现场
        Call SelectObject(hDC, OldPen)
        Call SelectObject(hDC, OldBrush)
        
        DeleteObject Pen                                    '删除画笔
        DeleteObject Brush                                  '删除画刷
        ReleaseDC hWnd, hDC                                 '释放场景
    End Sub
      

  3.   

    http://www.china-askpro.com/download/formdsgn.zip
      

  4.   

    Mister(菜青虫) //想请问下大家Rect As Rect中的Rect是什么类型?自己定义的?可是又没看到自定义的模块
    请教...^_^
      

  5.   

    RECT 是描述矩形结构的一个用户自定义类型,用 API 浏览器生成一下。
      

  6.   

    '定义如下:
    Public Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    End Type