Перебор массива чисел

@big_brat_06 · Регистрация: 30.03.2015

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

Здравствуйте, помогите пожалуйста. Есть код, который генерирует числа (координаты точек) и записывает их в файл, при этом те точки, которые удовлетворяют условию записываются в отдельный файл, но что-то не получается его запустить.

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
Public a As Double
Public x1, x2, y1, y2, r1, r2 As Integer
Option Explicit
 
Private Sub Command1_Click()
Call Tochki_Perebor
End Sub
Private Sub Tochki_Perebor()
Dim MyRes As String
 
 
Dim i As Long
a = Text1.Text
 
Dim MyFile As String 'Объявляем переменную для свободного файла
 
MyFile = FreeFile ' Присваиваем свободный канал, для работы с файлами
Open ("C:\Users\Public\Documents\лабораторные\tochki.txt") For Output As #MyFile 'Открываем файл
 
For i = 1 To a
 
 
      r1 = 600 + Int(Rnd() * 8600)
      r2 = 600 + Int(Rnd() * 4400)
      
      Circle (r1, r2), 20, 0
      Print i
    
   Print #MyFile, i, r1 / 100, r2 / 100
MyRes = FreeFile
Open ("C:\Users\Public\Documents\лабораторные\result.txt") For Output As #MyRes
   If r1 > x1 And r1 < x2 And y1 < r2 And r2 < y2 Then
   Print #MyRes, i, r1, r2
   Close #MyRes
   Else
   End If
    
Next i
Close #MyFile 'Закрываем файл
 
End Sub

Visual Basic
1
2
3
4
 x1 = (Text2.Text * 100) + 600
    y1 = (Text3.Text * 100) + 600
    x2 = (Text4.Text * 100) + 600
    y2 = (Text5.Text * 100) + 600

от сюда берутся условия для сравнения

@Казанский · 17.09.2015, 08:44

big_brat_06, проблема в том, что открытие файла result.txt происходит в цикле, а закрытие может и не произойти. Переделайте алгоритм так: открыть оба файла - в цикле записывать данные либо в один, либо в другой файл - закрыть оба файла.
Для отладки запустите программу в пошаговом режиме - F8.

@big_brat_06 · 18.09.2015, 09:02 **[ТС]**

Почему эти строки всегда генерируют одни и те же значения. например для 7 точек х и у не меняются и при каждом запуске точки находятся на одинаковых местах?

Visual Basic
1
2
r1 = 600 + Int(Rnd() * 8600)
      r2 = 600 + Int(Rnd() * 4400)

@Казанский · 18.09.2015, 09:40

big_brat_06, используйте Randomize

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

For any given initial seed, the same number sequence is generated because each successive call to the Rnd function uses the previous number as a seed for the next number in the sequence.
Before calling Rnd, use the Randomize statement without an argument to initialize the random-number generator with a seed based on the system timer.

@big_brat_06 · 18.09.2015, 10:44 **[ТС]**

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
Private Sub Tochki_Perebor()
Dim MyRes As String
    x1 = (Text2.Text * 100) + 600
    y2 = (Text3.Text * 100) + 200
    x2 = (Text4.Text * 100) + 600
    y1 = (Text5.Text * 100) + 200
 
 
Dim i As Long
a = Text1.Text
 
Dim MyFile As String 'Îáúÿâëÿåì ïåðåìåííóþ äëÿ ñâîáîäíîãî ôàéëà
 
MyFile = FreeFile ' Ïðèñâàèâàåì ñâîáîäíûé êàíàë, äëÿ ðàáîòû ñ ôàéëàìè
Open ("C:\Users\Public\Documents\ëàáîðàòîðíûå\tochki.txt") For Output As #MyFile 'Îòêðûâàåì ôàéë
 
For i = 1 To a
 
Randomize
      r1 = 600 + Int(Rnd() * 8600)
      r2 = 200 + Int(Rnd() * 4800)
      
      Circle (r1, r2), 20, 0
      Print i
    
   Print #MyFile, i, r1, r2
MyRes = FreeFile
   If r1 < x2 And r1 > x1 And r2 < y1 And r2 > y2 Then
   Open ("C:\Users\Public\Documents\ëàáîðàòîðíûå\result.txt") For Output As #MyRes
 
   Print #MyRes, i, r1, r2
      Close #MyRes
 
   Else
   
   End If
Next i
Close #MyFile 
 
End Sub

запустил пошагово и увидел, что в файл result если условие выполняется то пишется, но потом если снова выполняется, то он перезаписывается. как сделать, чтоб просто ниже добавлялась строка?

@Казанский · 18.09.2015, 11:40

big_brat_06, Open ... For Append ...
Но все же - зачем в цикле каждый раз открывать файл, записывать и закрывать? Почему не сделать как с первым файлом: открыть, в цикле записывать, после цикла закрыть?

@big_brat_06 · 18.09.2015, 11:53 **[ТС]**

Точно! спасибо, вытащил из цикла и все заработало. Open ... For Append ... даже не стал добавлять. У меня еще вопрос, как удалять созданные объекты circle перед рисованием новых? а то нажал кнопку, они появились, потом нажимаешь надо чтоб те удалились, а новые появились, а те не удаляются

@Апострофф · 18.09.2015, 12:37

Visual Basic
1
CLS

@big_brat_06 · 26.09.2015, 10:46 **[ТС]**

Visual Basic
1
2
3
4
5
6
7
8
Public a As Double
Public x1, x2, y1, y2, r1, r2, r21, Mas  As Integer
Public i As Variant
 
Public Arrayx As Long
 
 
Option Explicit

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
Private Sub Tochki_Perebor()
Dim MyRes As String
    x1 = (Text2.Text * 100) + 600
    y2 = (Text3.Text * 100) + 200
    x2 = (Text4.Text * 100) + 600
    y1 = (Text5.Text * 100) + 200
Cls
 
a = Text1.Text
Mas = 0
Dim MyFile As String 'Îáúÿâëÿåì ïåðåìåííóþ äëÿ ñâîáîäíîãî ôàéëà
 
MyFile = FreeFile ' Ïðèñâàèâàåì ñâîáîäíûé êàíàë, äëÿ ðàáîòû ñ ôàéëàìè
Open ("C:\Users\Public\Documents\ëàáîðàòîðíûå\tochki.txt") For Output As #MyFile 'Îòêðûâàåì ôàéë
 MyRes = FreeFile
  
   Open ("C:\Users\Public\Documents\ëàáîðàòîðíûå\result.txt") For Output As #MyRes
 
For i = 1 To a
ReDim Arrayx(i To a, 0 To 2)
Randomize
      Arrayx(i, 0) = i
      Arrayx(i, 1) = 600 + Int(Rnd() * 8600)
      Arrayx(i, 2) = 200 + Int(Rnd() * 4800)
      Circle (Arrayx(i, 1), Arrayx(i, 2)), 20, 0
      Print i
    
   Print #MyFile, i, (Arrayx(i, 1) - 600) / 100, (Arrayx(i, 2) - 200) / 100
   If Arrayx(i, 1) < x2 And Arrayx(i, 1) > x1 And Arrayx(i, 2) < y1 And Arrayx(i, 2) > y2 Then
   Mas = Mas + 1
   Print #MyRes, i, Arrayx(i, 1), Arrayx(i, 2)
      
 
   Else
   
   End If
   
Next i
 
 
Close #MyRes
Close #MyFile 
 
End Sub

решил в массив записать числа, чтоб дальше с ними работать. Но выдает ошибку не могу понять почему. Expected array.

@Апострофф · 27.09.2015, 12:42

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

~~Public Arrayx As Long~~

Visual Basic
1
Public Arrayx() As Long

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

For i = 1 To a
ReDim Arrayx(i To a, 0 To 2)
Randomize

Visual Basic
1
2
3
ReDim Arrayx(1 To a, 0 To 2)
Randomize
For i = 1 To a

@big_brat_06 · 06.10.2015, 14:29 **[ТС]**

Хочу отсортировать массив по возрастанию построчно по координате х. Строка состоит из номер точки, координата х, координата у. и найти середину массива. Всего строк в массиве а.

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
Private Sub Command7_Click()
Dim I As Long
    Dim J As Long
    Dim Tmp As Double
    Dim N, Sort As Long
    
 
    For I = 0# To N - 1# Step 1
        For J = 0# To N - 2# - I Step 1
            If Arrayx(I, 1) > Arrayx(I + 1#, 1) Then
                Tmp = Arrayx(I, 1)
                Arrayx(I, 1) = Arrayx(I + 1#, 1)
                Arrayx(I + 1#, 1) = Tmp
            End If
        Next J
    Next I
 
 
 
List2.AddItem (Arrayx(I, 0) & "" & Arrayx(I, 1) & "" & Arrayx(I, 2))
b = a \ 2
MsgBox Arrayx(b, 0)
End Sub

хочу чтоб он вывел номер средней строки после сортировки и вывел массив в listbox. Он не выводит: subscript out of range. Номер строки всегда одинаковый выходит (он же номер точки как я понял и не должен меняться т.к. сортировка идет не по нему).

@Апострофф · 06.10.2015, 14:46

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

b = a \ 2

Что есть a (по коду не увидел)?

@big_brat_06 · 06.10.2015, 14:50 **[ТС]**

Всего строк в массиве а. а берется из текст бокса (число точек). a = Text1.Text

@Апострофф · 06.10.2015, 14:51

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

Dim N, Sort As Long ' N=EMPTY
For I = 0# To N - 1# Step 1 'т.е. В тело цикла не зайдем ни разу!

...

@big_brat_06 · 06.10.2015, 15:05 **[ТС]**

Точно, исправил, а как правильно объявить массив глобально? Public не разрешает. я через Private объявил. и теперь он на строке

Visual Basic
1
If Arrayx(I, 1) > Arrayx(I + 1#, 1) Then

выдает ошибку subscript out of range.

Добавлено через 6 минут
еще нашел ошибку.

Visual Basic
1
2
3
4
5
6
7
8
9
For J = 0# To N - 1# Step 1
        For I = 0# To N - 2# - J Step 1
            If Arrayx(I, 1) > Arrayx(I + 1#, 1) Then
                Tmp = Arrayx(I, 1)
                Arrayx(I, 1) = Arrayx(I + 1#, 1)
                Arrayx(I + 1#, 1) = Tmp
            End If
        Next I
    Next J

так вроде должно быть

@Апострофф · 06.10.2015, 15:07

Сам алгоритм сортировки выглядит подозрительно - где такой нарыли?

Я бы так примерно написал -

Visual Basic
1
2
3
4
5
6
7
8
9
    For I = 0 To N - 1
        For J = i+1 To N
            If Arrayx(I, 1) > Arrayx(j, 1) Then
                Tmp = Arrayx(I, 1)
                Arrayx(I, 1) = Arrayx(j, 1)
                Arrayx(j, 1) = Tmp
            End If
        Next J
    Next I

@big_brat_06 · 06.10.2015, 15:16 **[ТС]**

Алгоритм тут же с форума взял из темы "Массивы. Обьявление массивов. Сортировка массивов - Visual Basic" чуть переделал под двумерный.

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

Visual Basic
1
If Arrayx(I, 1) > Arrayx(I + 1#, 1) Then

выдает ошибку.
Вот полный код. первая часть нормально работает.

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
106
107
Public a As Double
Public x1, x2, y1, y2, r1, r2, r21, I, b As Integer
Public Mas As Integer
Private Arrayx(), MyRes, Sort As String
Option Explicit
 
Private Sub Command1_Click()
Call Tochki_Perebor
End Sub
Private Sub Tochki_Perebor()
 
 
    x1 = (Text2.Text * 100) + 600
    y2 = (Text3.Text * 100) + 200
    x2 = (Text4.Text * 100) + 600
    y1 = (Text5.Text * 100) + 200
Cls
 
a = Text1.Text
Mas = 0
Dim MyFile As String
 
MyFile = FreeFile
Open ("C:\Users\Ôåäîð\Documents\ëàáîðàòîðíûå\tochki.txt") For Output As #MyFile
 MyRes = FreeFile
  
   Open ("C:\Users\Ôåäîð\Documents\ëàáîðàòîðíûå\result.txt") For Output As #MyRes
ReDim Preserve Arrayx(1 To a, 0 To 2)
Randomize
For I = 1 To a
 
      Arrayx(I, 0) = I
      Arrayx(I, 1) = 600 + Int(Rnd() * 8600)
      Arrayx(I, 2) = 200 + Int(Rnd() * 4800)
      Circle (Arrayx(I, 1), Arrayx(I, 2)), 20, 0
      Print I
    List1.AddItem (Arrayx(I, 0) & "" & ((Arrayx(I, 1) - 600) / 100) & "" & ((Arrayx(I, 2) - 200) / 100))
   Print #MyFile, I, (Arrayx(I, 1) - 600) / 100, (Arrayx(I, 2) - 200) / 100
   If Arrayx(I, 1) < x2 And Arrayx(I, 1) > x1 And Arrayx(I, 2) < y1 And Arrayx(I, 2) > y2 Then
   Mas = Mas + 1
   Print #MyRes, I, Arrayx(I, 1), Arrayx(I, 2)
      
 
   Else
   
   End If
   
Next I
 
Close #MyRes
Close #MyFile
    Dim J As Long
    Dim Tmp As Double
    Dim N As Integer
 
    For I = 0 To a - 1
        For J = I + 1 To a
            If Arrayx(I, 1) > Arrayx(J, 1) Then
                Tmp = Arrayx(I, 1)
                Arrayx(I, 1) = Arrayx(J, 1)
                Arrayx(J, 1) = Tmp
            End If
        Next J
    Next I
 
List2.AddItem (Arrayx(I, 0) & "" & Arrayx(I, 1) & "" & Arrayx(I, 2))
b = a \ 2
MsgBox Arrayx(b, 0)
End Sub
 
Private Sub Command2_Click()
    
    
    x1 = (Text2.Text * 100) + 600
    y2 = (Text3.Text * 100) + 200
    x2 = (Text4.Text * 100) + 600
    y1 = (Text5.Text * 100) + 200
 
     Line6.x1 = x1
     Line6.x2 = x2
     Line6.y1 = y1
     Line6.y2 = y1
    
    Line6.Visible = True
    
     Line7.x1 = x2
     Line7.x2 = x2
     Line7.y1 = y1
     Line7.y2 = y2
    
    Line7.Visible = True
    
     Line8.x1 = x1
     Line8.x2 = x1
     Line8.y1 = y1
     Line8.y2 = y2
    
    Line8.Visible = True
     
     Line9.x1 = x1
     Line9.x2 = x2
     Line9.y1 = y2
     Line9.y2 = y2
         
    Line9.Visible = True
    
End Sub

в это месте

Visual Basic
1
For I = 0 To a - 1

написал

Visual Basic
1
For I = 1 To a - 1

.
в лист бокс начала записываться последняя строка массива.

@Апострофф · 06.10.2015, 15:29

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

в лист бокс начала записываться последняя строка массива.

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
For I = 0 To a - 1
* * * * For J = I + 1 To a
* * * * * * If Arrayx(I, 1) > Arrayx(J, 1) Then
* * * * * * * * Tmp = Arrayx(I, 1)
* * * * * * * * Arrayx(I, 1) = Arrayx(J, 1)
* * * * * * * * Arrayx(J, 1) = Tmp
* * * * * * End If
* * * * Next J
* * Next I
'при выходе из цикла I=(A-1)+1, т.е. в листбокс записываете последнюю строку массива
List2.AddItem (Arrayx(I, 0) & "" & Arrayx(I, 1) & "" & Arrayx(I, 2))

...

@big_brat_06 · 06.10.2015, 18:26 **[ТС]**

C листбоксом понял куда надо вставить. а с сортировкой что-то не то

в листбоксах результат. должно было получиться (по номерам точек) 7,4,1,5,6,3,2 (сортировка по Х)

@Апострофф · 07.10.2015, 09:29

big_brat_06, вы бы вместе с картинкой приложили последний вариант своего проекта (упакованного ZIP`ом желательно).
Навскидку -
1) зачем дважды заполняется второй листбокс?
2) при сортировке точек по X координаты Y тоже надо переносить по массиву параллельно с Х?
На этом моя фантазия кончилась, сочинять ваши баги самому влом

Новые блоги и статьи Все статьи Все блоги /
Functional First Web Framework Suave DevAlt 30.03.2026 Sauve. IO Апнулись до NET10. Из зависимостей один пакет, работает одинаково хорошо как в режиме проекта так и в интерактивном режиме. из сложностей - чисто функциональный подход. Решил. . .	Автоматическое создание документа при проведении другого документа Maks 29.03.2026 Реализация из решения ниже выполнена на нетиповых документах, разработанных в конфигурации КА2. Есть нетиповой документ "ЗаявкаНаРемонтСпецтехники" и нетиповой документ "ПланированиеСпецтехники". В. . .	Настройка движения справочника по регистру сведений Maks 29.03.2026 Решение ниже реализовано на примере нетипового справочника "ТарифыМобильнойСвязи" разработанного в конфигурации КА2, с целью учета корпоративной мобильной связи в коммерческом предприятии. . . .	Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .
Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .	Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .	Кому нужен AOT? DevAlt 26.03.2026 Решил сделать простой ланчер Написал заготовку: dotnet new console --aot -o UrlHandler var items = args. Split(":"); var tag = items; var id = items; var executable = args;. . .

@Казанский 15155 / 6428 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	17.09.2015, 08:44
	big_brat_06, проблема в том, что открытие файла result.txt происходит в цикле, а закрытие может и не произойти. Переделайте алгоритм так: открыть оба файла - в цикле записывать данные либо в один, либо в другой файл - закрыть оба файла. Для отладки запустите программу в пошаговом режиме - F8. 0

@Казанский 15155 / 6428 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	18.09.2015, 11:40
	big_brat_06, Open ... For Append ... Но все же - зачем в цикле каждый раз открывать файл, записывать и закрывать? Почему не сделать как с первым файлом: открыть, в цикле записывать, после цикла закрыть? 1

@big_brat_06 1 / 1 / 0 Регистрация: 30.03.2015 Сообщений: 33
	18.09.2015, 11:53 [ТС]
	Точно! спасибо, вытащил из цикла и все заработало. Open ... For Append ... даже не стал добавлять. У меня еще вопрос, как удалять созданные объекты circle перед рисованием новых? а то нажал кнопку, они появились, потом нажимаешь надо чтоб те удалились, а новые появились, а те не удаляются 0

@big_brat_06 1 / 1 / 0 Регистрация: 30.03.2015 Сообщений: 33
	06.10.2015, 14:50 [ТС]
	Всего строк в массиве а. а берется из текст бокса (число точек). a = Text1.Text 0

@big_brat_06 1 / 1 / 0 Регистрация: 30.03.2015 Сообщений: 33
	06.10.2015, 18:26 [ТС]
	C листбоксом понял куда надо вставить. а с сортировкой что-то не то в листбоксах результат. должно было получиться (по номерам точек) 7,4,1,5,6,3,2 (сортировка по Х) 0

@Апострофф 9908 / 3924 / 742 Регистрация: 11.10.2011 Сообщений: 5,907
	07.10.2015, 09:29
	big_brat_06, вы бы вместе с картинкой приложили последний вариант своего проекта (упакованного ZIP`ом желательно). Навскидку - 1) зачем дважды заполняется второй листбокс? 2) при сортировке точек по X координаты Y тоже надо переносить по массиву параллельно с Х? На этом моя фантазия кончилась, сочинять ваши баги самому влом 0