Метод программируемого перетаскивания

On Error resume Next

function del()
   On Error resume Next
   x= 0 / 0 
   if err then msgbox ("ошибка деления")
end function

Dim a() As Integer
Dim w
 
Private Sub Command1_Click()
g
z
End Sub
 
Private Sub Form_Load()
With Label1(0)
.BorderStyle = 1
.BackColor = &HC0FFFF
.Caption = ""
.Width = 960
 
.FontSize = 32
.Alignment = 2
w = .Width
.Move 0, 0, w, w
End With
Picture1.Width = 4 * w: Picture1.Height = 4 * w
Picture1.Scale (0, 0)-(4, 4)
Picture1.BackColor = &HE0E0E0
For i = 1 To 15
   Load Label1(i)
   Label1(i).Caption = i
   Label1(i).Visible = True
Next i
Label1(0).BackStyle = 0
g
z
End Sub
Sub g()
ReDim a(4, 4)
For i = 1 To 16
    Do
      p = Int(Rnd * 4) + 1
      o = Int(Rnd * 4) + 1
    Loop While a(p, o) <> 0
    a(p, o) = i - 1
Next i
End Sub
Sub z()
For i = 1 To 4
   For j = 1 To 4
      Label1(((a(i, j)) \ 4) * 4 + ((a(i, j)) Mod 4)).Move j - 1, i - 1
   Next j
Next i
End Sub
 
Private Sub Label1_Click(Index As Integer)
r = Label1(Index).Top + 1: c = Label1(Index).Left + 1
If a(r, c) <> 0 Then
 
For i = 1 To 4
If a(r, i) = 0 Then
zn = Sgn(c - i)
   For j = i To c - zn Step zn
      a(r, j) = a(r, j + zn)
   Next j
      a(r, c) = 0
      z
      Exit Sub
End If
Next i
 
For i = 1 To 4
If a(i, c) = 0 Then
zn = Sgn(r - i)
   For j = i To r - zn Step zn
      a(j, c) = a(j + zn, c)
   Next j
      a(r, c) = 0
      z
      Exit Sub
End If
 
Next i
 
End If
End Sub

Dim a() As Integer
Dim w
 
Private Sub Command1_Click()
    g
    z
End Sub
 
Private Sub Form_Load()
 
    With Label1(0)
        .BorderStyle = 1
        .BackColor = &HC0FFFF
        .Caption = ""
        .Width = 960
        .FontSize = 32
        .Alignment = 2
        w = .Width
        .Move 0, 0, w, w
    End With
    Picture1.Width = 4 * w: Picture1.Height = 4 * w
    Picture1.Scale (0, 0)-(4, 4)
    Picture1.BackColor = &HE0E0E0
 
    For i = 1 To 15
        Load Label1(i)
        Label1(i).Caption = i
        Label1(i).Visible = True
    Next i
    Label1(0).BackStyle = 0
    g
    z
End Sub
 
Sub g()
    ReDim a(4, 4)
 
    For i = 1 To 16
 
        Do
            p = Int(Rnd * 4) + 1
            o = Int(Rnd * 4) + 1
        Loop While a(p, o) <> 0
        a(p, o) = i - 1
    Next i
End Sub
 
Sub z()
 
    For i = 1 To 4
 
        For j = 1 To 4
            Label1(((a(i, j)) \ 4) * 4 + ((a(i, j)) Mod 4)).Move j - 1, i - 1
        Next j
    Next i
End Sub
 
Private Sub Label1_Click(Index As Integer)
    r = Label1(Index).Top + 1: c = Label1(Index).Left + 1
 
    If a(r, c) <> 0 Then
 
        For i = 1 To 4
 
            If a(r, i) = 0 Then
                zn = Sgn(c - i)
 
                For j = i To c - zn Step zn
                    a(r, j) = a(r, j + zn)
                Next j
                a(r, c) = 0
                z
                Exit Sub
            End If
        Next i
 
        For i = 1 To 4
 
            If a(i, c) = 0 Then
                zn = Sgn(r - i)
 
                For j = i To r - zn Step zn
                    a(j, c) = a(j + zn, c)
                Next j
                a(r, c) = 0
                z
                Exit Sub
            End If
        Next i
    End If
End Sub

Private Sub num_DragDrop(Index As Integer, Source As Control, x As Single, y As Single)
ind = Index
Text1.Text = num(ind).Left
Text2.Text = num(ind).Top
x1 = num(ind).Left
y1 = num(ind).Top
End Sub
 
Private Sub num_DragOver(Index As Integer, Source As Control, x As Single, y As Single, State As Integer)
If (x1 = num(Index).Left And y1 <> num(Index).Top) Or (x1 <> num(Index).Left And y1 = num(Index).Top) Then
    temp = num(Index).Caption
    num(Index).Caption = num(ind).Caption
    num(ind).Caption = temp
    End If
End Sub