动态添加控件问题，用户自己画控件!

Question

动态添加控件的模块作好了，左右高宽用数字设置，但用户要求要自己画，怎么在Form上用鼠标画方框，就象在vb环境下用鼠标画框加控件，急！！！
下面代码贴上即可：
Option Explicit
Dim Current_Start_X, Current_End_X, Current_Start_Y, Current_End_Y As Long
Dim PaintNow As Boolean
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 1 Then
        PaintNow = True   ' 启动绘图。
        Current_Start_X = x
        Current_Start_Y = Y
    End If
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 1 Then
        PaintNow = False   ' 禁止绘图。
        Current_End_X = x
        Current_End_Y = Y
        MsgBox Current_Start_X & "{}" & Current_End_X & "{}" & Current_Start_Y & "{}" & Current_End_Y
    End If
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
   If PaintNow Then
      PSet (x, Y)      ' 画一个点。
      ???????? 画框
   End If
End SubPrivate Sub Form_Load()
    'Me.MouseIcon = LoadPicture(App.Path & "\rect.cur")
    'Me.MousePointer = 99
End Sub

Answer 1

像delphi 那样选择控件后在窗体上点击添加默认大小位置的空间。用户再拖动它的位置和大小是不是也可以呢 。如果可以的话网上有相应的拖动位置和大小的代码 。用google查找vb+动态改变控件的位置和大小

Answer 2

自己寫個ActiveX控件﹐在上面畫好控件﹐加圖片﹐自己定義ActiveX控件的屬性﹐事件﹐方法只有這樣做才能滿足你的用戶的要求﹐寫好控件后﹐在你的工程中引用﹐這樣你就可以得到你用戶所需的控件了

Answer 3

好了，还有个问题，控件画好后，如何让鼠标在该控件上能自由移动位置，盼高手指点，代码如下贴上即可运行：
Option Explicit
Dim Current_Start_X, Current_End_X, Current_Start_Y, Current_End_Y As Long
Dim PaintNow, Drow_Control, MouseDown As Boolean
Dim Control As VB.Control
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 1 Then
        PaintNow = True   ' 启动绘图。
        MouseDown = True
        Current_Start_X = x
        Current_Start_Y = Y
        If Drow_Control Then DrowControl Current_Start_X, Current_Start_Y, "vb.commandbutton", "Add_Command"
    End If
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 1 Then
        PaintNow = False   ' 禁止绘图。
        Drow_Control = False
        'Current_End_X = x
        'Current_End_Y = Y
        Me.MousePointer = 0
    End If
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If PaintNow And Drow_Control Then
        Control.Width = x - Current_Start_X
        Control.Height = Y - Current_Start_Y
    End If
End SubPrivate Sub Form_Load()
    Drow_Control = True
    Me.MouseIcon = LoadPicture(App.Path & "\rect.cur")
    Me.MousePointer = 99
End SubPrivate Sub DrowControl(ByVal Current_Start_X As Long, ByVal Current_Start_Y As Long, ByVal ControlType As String, ByVal ControlName As String)
    Set Control = Me.Controls.Add(ControlType, ControlName)
    Control.Width = 0
    Control.Height = 0
    Control.Left = Current_Start_X
    Control.Top = Current_Start_Y
    Control.Visible = True
    If (Left$("VB.commandbutton", 3) = "VB.") Then
        CallByName Control, "Caption", VbLet, "ddd"
    Else
        CallByName Control, "Caption", VbLet, "ddd"
    End If
End Sub

Answer 4

看这个行不行 ，使用鼠标画了个矩形，在矩形内点击后 调用DoClick 函数，不过先要放一个Timer控件
Option ExplicitPrivate Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypePrivate m_MyRect As RECT
Private m_bBegin As Boolean
Private m_X As Single, m_Y As SinglePrivate Sub Form_Load()
    Timer1.Enabled = True
    Timer1.Interval = 500 '鼠标按住0.5秒不动 说明开始画方形
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    m_X = X
    m_Y = Y
    Timer1.Enabled = True
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If m_bBegin Then
        If X > m_MyRect.Left Then
            m_MyRect.Right = X
        Else
            m_MyRect.Right = m_MyRect.Left
            m_MyRect.Left = X
        End If
        If Y > m_MyRect.Top Then
            m_MyRect.Bottom = Y
        Else
            m_MyRect.Bottom = m_MyRect.Top
            m_MyRect.Top = Y
        End If
        Me.Cls
        Me.Line (m_MyRect.Left, m_MyRect.Top)-(m_MyRect.Right, m_MyRect.Top)
        Me.Line (m_MyRect.Left, m_MyRect.Bottom)-(m_MyRect.Right, m_MyRect.Bottom)
        Me.Line (m_MyRect.Left, m_MyRect.Top)-(m_MyRect.Left, m_MyRect.Bottom)
        Me.Line (m_MyRect.Right, m_MyRect.Top)-(m_MyRect.Right, m_MyRect.Bottom)
        m_bBegin = False
    Else
        If X > m_MyRect.Left And X < m_MyRect.Right _
            And Y > m_MyRect.Top And Y < m_MyRect.Bottom Then
            Call DoClick
        End If
        Timer1.Enabled = False
    End If
End SubPrivate Function DoClick()
    MsgBox "点击到了"
End FunctionPrivate Sub Timer1_Timer()
    m_MyRect.Left = m_X
    m_MyRect.Top = m_Y
    m_bBegin = True
    Timer1.Enabled = False
End Sub

Answer 5

baoaya(点头) :
  谢谢，看下我上面的，如何让鼠标使该控件上能自由移动位置?

Answer 6

另外把加载的控件DragMode 属性设置为 VbAutomatic在窗体上添加DragDrop事件
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Left = X
Source.Top = Y
End Sub

Answer 7

有点想不明白为什么要用callbyname呢？
能够使用callbyname的地方，不是都能够直接引用对象的方法或者属性吗？
请高手指点！

Answer 8

   If (Left$("VB.commandbutton", 3) = "VB.") Then
        CallByName Control, "Caption", VbLet, "ddd"
    Else
        CallByName Control, "Caption", VbLet, "ddd"
    End If//
这些语句好像没什么用哦 楼主
(Left$("VB.commandbutton", 3) = "VB.") 永远=true      而且 then 跟else 是一样的语句不如直接Control.Caption="ddd"

Answer 9

baoaya(点头) ：
是的，还没全部做好，要动态添加的控件有n种，这里要传参的，先用command来试，功能作到后再封装，用你的方法可以移动了，但Source.Left = X，Source.Top = Y是鼠标的位置，移动时控件的左上角对应这个位置，move的太难看了，而又不能要求用户把鼠标精确的放在控件的左上角，能否解决？

Answer 10

我的理解是是这样的，既然要画图最简单的方法就是用PICTURE控件，然后用图象方法来实现画图的功能。

Answer 11

不是画图，是画控件，控件大小、位置、事件、属性等均由用户自己来定，控件的类型也由用户定（textbox、command、checkbox等等).其他的都好了，只是控件的左右高宽原来用数字设置，但用户觉得不好，不直观，要求要自己画，tmd......，3年没用VB了，现在全忘了，痛苦，盼各位指点。

Answer 12

可是可以 ，不过需要在创建控件里添加事件了， 定义的时候使用withevents 关键字，这里只是为了演示 所以 设计时候加了一个叫command1的CommandButton,并添加了他的MouseMove事件Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Command1.Tag = X & "," & Y
End SubPrivate Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Dim xx As Single, yy As Single, strPos() As String, strTag As String
strTag = Source.Tag
If strTag <> "" Then
    strPos = Split(strTag, ",")
    xx = CSng(strPos(0))
    yy = CSng(strPos(1))
End If
Source.Left = X - xx
Source.Top = Y - yy
End Sub