想用vb做个排座位软件,实现了两个文本框的拖拽和位置互换,但50多个的用这个办法显然不行。望高手指点。

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了想用vb做个排座位软件,实现了两个文本框的拖拽和位置互换,但50多个的用这个办法显然不行。望高手指点。相关的知识,希望对你有一定的参考价值。

想用vb做个排座位软件,用一个很蠢的办法实现了两个文本框的拖拽和位置互换,但50多个文本框的拖拽和互换,用这个办法显然不行。望高手指点。
Private Declare Function ReleaseCapture Lib "user32" () As Long
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 = &HF010&
Const HTCAPTION = 2
Dim hwndx, Text1Left, Text2Left, Text1top, Text2top, js

Private Sub MoveWindow(ByVal hwnd As Long)
Dim ret As Long
ReleaseCapture
ret = SendMessage(hwndx, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0)
End Sub
Private Sub Form_Load()
js = 1
End Sub
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
hwndx = Text1.hwnd
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Abs(Text2.Left - Text1.Left) < 1215 And Abs(Text2.Top - Text1.Top) < 495 Then
Text1.Left = Text2Left '--------------------------交换位置-------------------------
Text2.Left = Text1Left
Text1.Top = Text2top
Text2.Top = Text1top
js = 1
End If
MoveWindow hwnd
End Sub
Private Sub Text2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
hwndx = Text2.hwnd
End Sub
Private Sub Text2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Abs(Text2.Left - Text1.Left) < 1215 And Abs(Text2.Top - Text1.Top) < 495 Then
Text1.Left = Text2Left '--------------------------交换位置-------------------------
Text2.Left = Text1Left
Text1.Top = Text2top
Text2.Top = Text1top
js = 1
End If
MoveWindow hwnd
End Sub
Private Sub Timer1_Timer()
If js = 1 Then
Text2Left = Text2.Left '--------------------------获取新的位置值-------------------
Text1Left = Text1.Left
Text2top = Text2.Top
Text1top = Text1.Top
js = 0
End If
End Sub
一楼的只能拖动,但不能交换位置。需要控件和控件重叠则交换两控件的位置。控件数组拖动已经可以搞定了。

二楼的拼图只需要相临的两个控件互换位置就可以了,但是排座位需要相隔比较远的任意控件也能交换位置,而且拼图一般控件数量有限,而排座位有50多个控件。

谢谢!

望高人继续。

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1.Move X + Label1.Left, Y + Label1.Top
End Sub
在运行后,可以用鼠标将这个标签移动到窗体内的任何地方。
我想起与的以此类推就可以了(当然做成控件数组是最好的)

答案补充:
“控件和控件重叠则交换两控件的位置”十分简单。
通过对放置处坐标的检测,循环对比其他控件数组元素,如果发现误差在一定范围,就将该位置的原元素移动到拖动前的位置。
具体代码如下:
Const 宽度 = 250, 高度 = 150, 个数 = 50

Private Sub Form_Load()
For i = 0 To 个数 - 1
If i > 1 Then Load Label1(i)
Label1(i).Visible = True
Label1(i) = i + 1
Label1(i).Move (i Mod 8 + 0.5) * 4 * 宽度, (i \ 8 + 0.5) * 4 * 高度, 宽度, 高度
Next i
End Sub

Private Sub Label1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim 原位置x As Single, 原位置y As Single
Dim 新位置x As Single, 新位置y As Single
原位置x = Label1(Index).Left
原位置y = Label1(Index).Top
新位置x = 原位置x + X
新位置y = 原位置y + Y
For i = 0 To 个数 - 1
If i <> Index And Abs(新位置x - Label1(i).Left) < 宽度 And Abs(新位置y - Label1(i).Top) < 高度 Then
Label1(i).Move 原位置x, 原位置y
Exit For
End If
Next i
Label1(Index).Move (新位置x \ 4 \ 宽度 + 0.5) * 4 * 宽度, (新位置y \ 4 \ 高度 + 0.5) * 4 * 高度
End Sub
参考技术A 你可以找个拼图的例子(不是那种通过移动的拼图,是对调图块的拼图例子),感觉和你说的差不多,你可以找来参考一下。。

vue3-directives 自定义指令 做个聊天窗口拖拽和拖拽按钮

<button v-focus style="position: absolute">drag</button>

directives: 
    focus: 
      // 指令的定义
      mounted(el, binding, vnode) 
        /** el可以获取当前dom节点,并且进行编译,也可以操作事件 **/
        /** binding指的是一个对象,一般不用 **/
        /** vnode 是 Vue 编译生成的虚拟节点 **/
        let x = 0
        let y = 0
        let l = 0
        let t = 0
        let isDown = false
        el.onmousedown = function (e) 
          x = e.clientX
          y = e.clientY
          l = el.offsetLeft
          t = el.offsetTop
          isDown = true
          el.style.cursor = 'move'
          window.onmousemove = function (e) 
            if (isDown == false) 
              return
            
            let nx = e.clientX
            let ny = e.clientY
            let nl = nx - (x - l)
            let nt = ny - (y - t)
            el.style.left = nl + 'px'
            el.style.top = nt + 'px'
          
          window.onmouseup = function () 
            isDown = false
            el.style.cursor = 'default'
            window.onmousemove = null
            window.onmouseup = null
          
          return false
        
      
    
  

以上是关于想用vb做个排座位软件,实现了两个文本框的拖拽和位置互换,但50多个的用这个办法显然不行。望高手指点。的主要内容,如果未能解决你的问题,请参考以下文章

Android一步一步带你实现RecyclerView的拖拽和侧滑删除功能

VB.net 实现TreeView控件的拖拽事件

vue3-directives 自定义指令 做个聊天窗口拖拽和拖拽按钮

vue3-directives 自定义指令 做个聊天窗口拖拽和拖拽按钮

vue3-directives 自定义指令 做个聊天窗口拖拽和拖拽按钮

第八章 d3拖拽和事件及缩放