Взаимный обмен параметров у объектов (похоже на пятнашки)

@8i_class · Регистрация: 07.12.2012

Студворк — интернет-сервис помощи студентам

Нужно организовать обмен текста,цвета,картинок и т.д. у лайбелов и имайджем(но не суть)

допустим у нас есть 6 лайбелов (значения от 1 до 6) и мы перетаскиваем 5й на 1й и их значения меняются местами.
Количество вот таких обменов бесконечно.

Помогите написать кусок обмена параметров.

вот на клепал примерчик.

Добавлено через 23 минуты
Пример : http://youtu.be/MkRTm9weqTk

@8i_class · 07.02.2013, 20:06 **[ТС]**

Помогите сделать хотябы для 4х объектов.
Можно и на другом байсике , главное принцип проверки.

@Апострофф · 07.02.2013, 20:18

8i_class, покажи свой способ таскания объектов, чтобы не получилось игры в испорченный телефон.

dev.Free · 07.02.2013, 20:41

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Option Explicit 
 
Private Sub Form_Load()
    Me.AutoRedraw = True
    Me.OLEDropMode = vbOLEDropManual
End Sub 
 
'над формой "проносим файл"
Private Sub Form_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
    Me.Cls
    Me.Print "Список перетаскиваемых файлов:"
    Dim File As Variant
    For Each File In Data.Files
        Me.Print File
    Next File
End Sub 
 
'"отпускаем файл" на форму
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.Cls
    Me.Print "Список полученных файлов:"
    Dim File As Variant
    For Each File In Data.Files
        Me.Print File
    Next File
End Sub

Попробуй на примере этого сделать. Только там наверно надо будет переменные использовать для хранения цвета того Label, которому передаем цвет, чтобы можно было вернуть его назад.

@8i_class · 07.02.2013, 20:48 **[ТС]**

Как перетаскивание сделать то я знаю )
как я задумывал каждый лайбл принимает другой и он же перетаскивается.

Visual Basic
1
2
3
4
5
6
7
Private Sub Label6_DragDrop(Source As Control, X As Single, Y As Single)
Label6.Caption = Source.Caption
End Sub
'''''''''''''''''''''''
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Call Label1.Drag(vbBeginDrag)
End Sub

то есть лайбл 1 тащим в лайбл6 и они меняются местами.

Только там наверно надо будет переменные использовать для хранения цвета того Label,

да вот это мне и нужно.

dev.Free · 07.02.2013, 20:50

Ну на память. Примерно так:

Visual Basic
1
2
3
4
Dim a As String
 
a = label1.BackColor
Label1.BackColor = Label2.BackColor

a потом возвращай кому надо.

morgann55 · 08.02.2013, 02:17

Не проще ли координаты объектов поменять (Top и Left) ?? На старте проги предварительно забить стартовые координаты в двумерный массив (если потребуется восстановить) KoO(N,2) --> KoO(N,1) это Left, KoO(N,2) это Top....

morgann55 · 08.02.2013, 05:17

И ведь не заснуть пока на "бумагу" не выложишь - скребётся под темечком

Вроде похоже...

morgann55 · 08.02.2013, 12:48

Вот код - "причесал" с утра на свежую голову...

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Dim KoO(5, 2), NomK, Rez
Private Type ObmenOb
Nom As Byte       ''индекс
To As Integer     ''топ
Le As Integer     ''лефт
End Type
Dim ObO(2) As ObmenOb
 
Private Sub Command1_Click()
Rez = Rez + 1: Command1.Caption = "Сквозной":
If Rez = 2 Then Rez = 0: Command1.Caption = "Попарный": Exit Sub
ObO(1).Nom = 0:
ObO(1).Le = La1(0).Left:
ObO(1).To = La1(0).Top:
End Sub
 
Private Sub Command2_Click()
For i = 0 To 5:
La1(i).Left = KoO(i, 1): La1(i).Top = KoO(i, 2):
Next:
End Sub
 
Private Sub Form_Load()
For i = 0 To 5:
KoO(i, 1) = La1(i).Left: KoO(i, 2) = La1(i).Top:
Next:
End Sub
 
Private Sub La1_Click(Index As Integer)
If Rez = 0 Then 'попарный обмен
NomK = NomK + 1: If NomK = 3 Then NomK = 1:
ObO(NomK).Nom = Index
ObO(NomK).Le = La1(Index).Left:
ObO(NomK).To = La1(Index).Top:
 
If NomK = 2 Then
La1(ObO(1).Nom).Left = ObO(2).Le:
La1(ObO(1).Nom).Top = ObO(2).To:
La1(ObO(2).Nom).Left = ObO(1).Le:
La1(ObO(2).Nom).Top = ObO(1).To:
End If: End If:
'-------------------------
If Rez = 1 Then 'циклический обмен (на новое место переходит последний кликнутый)
ObO(2).Nom = Index
ObO(2).Le = La1(Index).Left:
ObO(2).To = La1(Index).Top:
 
La1(ObO(1).Nom).Left = ObO(2).Le:
La1(ObO(1).Nom).Top = ObO(2).To:
La1(ObO(2).Nom).Left = ObO(1).Le:
La1(ObO(2).Nom).Top = ObO(1).To:
 
ObO(1).Nom = ObO(2).Nom:
End If:
End Sub

Форма в пикселях...
(критика приветствуется)

@8i_class · 08.02.2013, 13:50 **[ТС]**

morgann55 спасибо за идею с координатами.

А вы можете чуть подправить код ?
что бы перетаскивать эти элементы ?)
каждый лайбыл принимает другой и сам же может перетаскиваться (ну вы поняли

)

Visual Basic
1
2
3
4
5
6
7
Private Sub Label1_DragDrop(Source As Control, X As Single, Y As Single)
Label1.Caption = Source.Caption
End Sub
'''''''''''''''''''''''
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Call Label1.Drag(vbBeginDrag)
End Sub

Зажимаем мышку на первом и тащим на второй.
эт было бы шикарно )

@gaw · 08.02.2013, 21:44

на форме Label1(0) и Command1

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Dim xp As Single, yp As Single
Dim t As Single, l As Single
Dim w%, h%
Dim tr As Boolean
Dim N%
 
 
Private Sub Command1_Click()
For i = 1 To N
Randomize (Timer)
Label1(i).BackColor = RGB(Int(Rnd * 255) + 1, 255 - Int(Rnd * 255), Int(Rnd * 155) + 1)
Next i
End Sub
 
Private Sub Form_Load()
N = 9
With Label1(0)
 
.BorderStyle = 1: .BackColor = vbGreen: .FontSize = 14: .Alignment = 2
.Caption = 1
w = .Width / 10
h = .Height / 10
.Move w, h
Me.Move Me.Left, Me.Top, (N + 1) * .Width / 2, 1.5 * (N + 1) * .Height
End With
For i = 1 To N
Load Label1(i)
Label1(i).Move Label1(i - 1).Left + 4 * w, Label1(i - 1).Top + 1.2 * Label1(0).Height
Randomize (Timer)
Label1(i).BackColor = RGB(Int(Rnd * 255) + 1, 255 - Int(Rnd * 255), Int(Rnd * 255) + 1)
Label1(i) = i + 1
Label1(i).Visible = True
Next i
 
End Sub
 
Private Sub Label1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
yp = Y
xp = X
t = Label1(Index).Top
l = Label1(Index).Left
Label1(Index).MousePointer = 15
End If
End Sub
 
Private Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If tr = False Then
 
If Button = 1 Then
Label1(Index).ZOrder 0
Label1(Index).Move Label1(Index).Left + X - xp, Label1(Index).Top + Y - yp
prov Index
End If
Else
Label1(Index).Move l, t
End If
End Sub
 
Private Sub Label1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1(Index).Move l, t
Label1(Index).MousePointer = 0
tr = False
End Sub
Sub prov(ind%)
For i = 0 To N
If i <> ind Then
If Abs(Label1(i).Left - Label1(ind).Left) < w And Abs(Label1(i).Top - Label1(ind).Top) < h Then
Lbl_p = Label1(ind).BackColor
   Label1(ind).BackColor = Label1(i).BackColor
      Label1(i).BackColor = Lbl_p
Lbl_p = Label1(ind)
   Label1(ind) = Label1(i)
      Label1(i) = Lbl_p
tr = True
End If
End If
Next i
End Sub

Добавлено через 9 минут
prov Index можно перенести в Private Sub Label1_MouseUp

Добавлено через 5 часов 44 минуты
немного изменил (можно размещение свое)
на форме Label1(0) , Command1 , Timer1

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
Dim xp As Single, yp As Single
Dim t As Single, l As Single
Dim ind1%
Dim w%, h%
Dim tr As Boolean, tr1 As Boolean
Dim N%, dh
 
 
Private Sub Command1_Click()
For i = 1 To N
   Randomize (Timer)
   Label1(i).BackColor = RGB(Int(Rnd * 255) + 1, 255 - Int(Rnd * 255), Int(Rnd * 155) + 1)
Next i
End Sub
 
Private Sub Form_Load()
dh = 200
Timer1.Enabled = False: Timer1.Interval = 2
N = 9
With Label1(0)
.BorderStyle = 1: .BackColor = vbGreen: .FontSize = 14: .Alignment = 2
.Caption = 1
w = .Width / 5
h = .Height / 5
.Move w, h
Me.Move Me.Left, Me.Top, (N + 1) * .Width / 2, 1.5 * (N + 1) * .Height
End With
For i = 1 To N
   Load Label1(i)
   Label1(i).Move Label1(i - 1).Left + w, Label1(i - 1).Top + 1.2 * Label1(0).Height
   Randomize (Timer)
   Label1(i).BackColor = RGB(Int(Rnd * 255) + 1, 255 - Int(Rnd * 255), Int(Rnd * 255) + 1)
   Label1(i) = i + 1
   Label1(i).Visible = True
Next i
 
End Sub
 
Private Sub Label1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   yp = Y
   xp = X
   t = Label1(Index).Top
   l = Label1(Index).Left
   ind1 = Index
   Label1(Index).MousePointer = 15
   tr1 = False
End If
End Sub
 
Private Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If tr = False Then
   If Button = 1 Then
      Label1(Index).ZOrder 0
      Label1(Index).Move Label1(Index).Left + X - xp, Label1(Index).Top + Y - yp
'prov Index
   End If
Else
   Label1(Index).Move l, t
End If
End Sub
 
Private Sub Label1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
prov Index
If tr1 = False Then Timer1.Enabled = True
'Label1(Index).Move l, t
Label1(Index).MousePointer = 0
tr = False
tr1 = False
End Sub
 
Sub prov(ind%)
For i = 0 To N
   If i <> ind Then
       If Abs(Label1(i).Left - Label1(ind).Left) < w And Abs(Label1(i).Top - Label1(ind).Top) < h Then
Lbl_p = Label1(ind).BackColor
   Label1(ind).BackColor = Label1(i).BackColor
      Label1(i).BackColor = Lbl_p
Lbl_p = Label1(ind)
   Label1(ind) = Label1(i)
      Label1(i) = Lbl_p
tr = True
Exit Sub
End If
End If
Next i
tr1 = True
End Sub
 
Private Sub Timer1_Timer()
If Abs(Label1(ind1).Left - l) > dh Then
  Label1(ind1).Left = Label1(ind1).Left - Sgn((Label1(ind1).Left - l)) * dh
Else
  Label1(ind1).Left = l
End If
 
 If Abs(Label1(ind1).Top - t) > dh Then
    Label1(ind1).Top = Label1(ind1).Top - Sgn((Label1(ind1).Top - t)) * dh
 Else
    Label1(ind1).Top = t
 End If
Timer1.Enabled = Not ((Label1(ind1).Left = l And Label1(ind1).Top = t))
 
 
End Sub

morgann55 · 08.02.2013, 23:00

Сообщение от 8i_class

morgann55 спасибо за идею с координатами.

А вы можете чуть подправить код ?
что бы перетаскивать эти элементы ?)
каждый лайбыл принимает другой и сам же может перетаскиваться (ну вы поняли

)
Зажимаем мышку на первом и тащим на второй.
эт было бы шикарно )

Ну gaw уже показал как таскать, а как сменить координаты ты знаешь....

@gaw · 09.02.2013, 00:05

Сообщение от morgann55

Ну gaw уже показал как таскать

не только,
если перетаскивать на свободное место, метка там и остается
если перетаскиваемый отпустить над любым другим, они обмениваются фоном и надписью
и перетаскиваемый возвращается на место

morgann55 · 09.02.2013, 00:59

gaw, Ну мне так глубоко не вникнуть за 5 минут перерыва

Вижу перетаскивает как и я - значит можно в аут

Dragokas · 09.02.2013, 15:41

gaw, строка 29.
Load Label1(i) при i=1 - Object already loaded.

Что я делаю не так?

@gaw · 09.02.2013, 15:47

похоже на форме Label1 без индекса - в свойствах установить индекс 0

@gaw · 09.02.2013, 15:51

вот архив (рабочий)

@8i_class · 09.02.2013, 15:57 **[ТС]**

Всем спасибо

Теперь буду думать про защиту

в чем заключается защита:
если промахиваешься мимо квадрата , то он прилипает к форме.
а я хочу сделать что если промахнулся то он назад улетит )

@gaw · 09.02.2013, 16:07

в последнем коде
стр 65 --- If tr1 = False Then Timer1.Enabled = True
заменить на Timer1.Enabled = True

Добавлено через 1 минуту
точность накладывания
строки 23 24
w = .Width / 5
h = .Height / 5

при 6,7,... большая точность и наоборот

Dragokas · 09.02.2013, 19:33

gaw, спасибо. Это я не внимательный. Создал более одного Label.

Новые блоги и статьи Все статьи Все блоги /
Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .	Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .
Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .	Подстановка значения реквизита справочника в табличную часть документа Maks 10.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .	Очистка реквизитов документа при копировании Maks 09.04.2026 Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .

@8i_class 374 / 12 / 3 Регистрация: 07.12.2012 Сообщений: 169

	Взаимный обмен параметров у объектов (похоже на пятнашки) 06.02.2013, 19:39. Показов 3247. Ответов 37 Метки нет (Все метки) Нужно организовать обмен текста,цвета,картинок и т.д. у лайбелов и имайджем(но не суть) допустим у нас есть 6 лайбелов (значения от 1 до 6) и мы перетаскиваем 5й на 1й и их значения меняются местами. Количество вот таких обменов бесконечно. Помогите написать кусок обмена параметров. вот на клепал примерчик. Добавлено через 23 минуты Пример : http://youtu.be/MkRTm9weqTk 0

@8i_class 374 / 12 / 3 Регистрация: 07.12.2012 Сообщений: 169
	07.02.2013, 20:06 [ТС]
	Помогите сделать хотябы для 4х объектов. Можно и на другом байсике , главное принцип проверки. 0

@Апострофф 9908 / 3928 / 742 Регистрация: 11.10.2011 Сообщений: 5,908
	07.02.2013, 20:18
	8i_class, покажи свой способ таскания объектов, чтобы не получилось игры в испорченный телефон. 0

morgann55 1365 / 207 / 37 Регистрация: 09.02.2012 Сообщений: 745
	08.02.2013, 02:17
	Не проще ли координаты объектов поменять (Top и Left) ?? На старте проги предварительно забить стартовые координаты в двумерный массив (если потребуется восстановить) KoO(N,2) --> KoO(N,1) это Left, KoO(N,2) это Top.... 0

morgann55 1365 / 207 / 37 Регистрация: 09.02.2012 Сообщений: 745
	09.02.2013, 00:59
	gaw, Ну мне так глубоко не вникнуть за 5 минут перерыва Вижу перетаскивает как и я - значит можно в аут 2

Dragokas 18033 / 7736 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16
	09.02.2013, 15:41
	gaw, строка 29. Load Label1(i) при i=1 - Object already loaded. Что я делаю не так? 0

@gaw 6644 / 1511 / 169 Регистрация: 09.01.2010 Сообщений: 4,298
	09.02.2013, 15:47
	похоже на форме Label1 без индекса - в свойствах установить индекс 0 0

@8i_class 374 / 12 / 3 Регистрация: 07.12.2012 Сообщений: 169
	09.02.2013, 15:57 [ТС]
	Всем спасибо Теперь буду думать про защиту в чем заключается защита: если промахиваешься мимо квадрата , то он прилипает к форме. а я хочу сделать что если промахнулся то он назад улетит ) 0

@gaw 6644 / 1511 / 169 Регистрация: 09.01.2010 Сообщений: 4,298
	09.02.2013, 16:07
	в последнем коде стр 65 --- If tr1 = False Then Timer1.Enabled = True заменить на Timer1.Enabled = True Добавлено через 1 минуту точность накладывания строки 23 24 w = .Width / 5 h = .Height / 5 при 6,7,... большая точность и наоборот 1

Dragokas 18033 / 7736 / 892 Регистрация: 25.12.2011 Сообщений: 11,502 Записей в блоге: 16
	09.02.2013, 19:33
	gaw, спасибо. Это я не внимательный. Создал более одного Label. 0