Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос:  Помогите - сортировка методом пузырька VBasi Добавлено: 20.12.08 23:35  

Автор вопроса:  #Nii
Вот мне надо сделать, сортировку методом пузырька в Delphi или Visual Basic. И чтоб данные брались из файла, и записывались в другой файл.

Исходник

001:
002:
003:
004:
005:
006:
007:
008:
009:
010:
011:
012:
013:
014:
015:
016:
017:
018:
019:
020:
021:
022:
023:
024:
025:
026:
027:
028:
029:
030:
031:
032:
033:
034:
035:
036:
037:
038:
039:
040:
041:
042:
043:
044:
045:
046:
047:
048:
049:
050:
051:
052:
053:
054:
055:
056:
057:
058:
059:
060:
061:
062:
063:
064:
065:
066:
067:
068: 'На форме одна кнопка. Подключаем в референсах библиотеку Microsoft Scripting Runtime
'Допустим что входной файл престаляет собой строку вида 3,22,66,44,88,,23,97,345,321
Private Sub Command1_Click()
  Dim MyArrStr() As String
  Dim MyArr() As Long
  Dim sStr As String
  Dim i As Long
  
  'Читаем из файла
  sStr = MyRead("in.txt")
  'Получаем массив строк
  MyArrStr = Split(sStr, ",")
  i = 0
  ReDim MyArr(i)
  'Преобразуем в массив Long
  For i = LBound(MyArrStr) To UBound(MyArrStr)
    ReDim Preserve MyArr(i)
    MyArr(i) = CLng(MyArrStr(i))
  Next i
  'Сортируем
  Call Sort(MyArr)
  'Собираем строку (чтоб вид бил как у входного файла)
  sStr = ""
  For i = LBound(MyArr) To UBound(MyArr)
    MyArrStr(i) = CStr(MyArr(i))
    sStr = sStr & MyArrStr(i)
    If i <> UBound(MyArr) Then sStr = sStr & ","
  Next i
  'Записываем файл
  Call MyWrite(sStr, "out.txt")
End Sub

Private Sub Sort(Mus() As Long)
  Dim n As Long, i As Long, j As Long, tmp  As Long
  i = 0 'немного подправил, чтоб начинало с 0
  Do While i < UBound(Mus)
    If Mus(i) > Mus(i + 1) Then
      tmp = Mus(i)
      Mus(i) = Mus(i + 1)
      Mus(i + 1) = tmp
      If i > 1 Then
        i = i - 1
      Else
        i = i + 1
      End If
    Else
      i = i + 1
    End If
  Loop
End Sub

'Процедура записи, используется FSO
Private Sub MyWrite(MyStr As String, outFile As String)
Dim fsoSave As New FileSystemObject
Dim filSave As TextStream
Set filSave = fsoSave.CreateTextFile(App.Path & "\" & outFile, True)
filSave.WriteLine (MyStr)
filSave.Close
End Sub

'Процедура чтения, используется FSO
Private Function MyRead(inFile As String) As String
Dim fsoSave As New FileSystemObject
Dim filSave As TextStream
Set filSave = fsoSave.OpenTextFile(App.Path & "\" & inFile)
MyRead = filSave.ReadLine
filSave.Close
End Function


только он у меня не запускается, как образом не пойму

И еще незнаю как сделать загрузить исходные данные из файла в окно (text или label)в программе чтоб значения показывались сначала в окне, потом нажимаешь на кнопку полученные данные переходят в другое окно, а потом нажав кнопку сохранить все в файл?

Ответить

  Ответы Всего ответов: 10  

Номер ответа: 1
Автор ответа:
 Ra$cal



ICQ: 8068014 

Вопросов: 18
Ответов: 817
  Web-сайт: www.rascalspb.narod.ru
 Профиль | Цитата | #1 		Добавлено: 21.12.08 00:27
мне кажется или тут пузырек в один цикл пытаются реализовать?

Ответить

Номер ответа: 2
Автор ответа:
 



Вопросов: 5
Ответов: 79
  Профиль | Цитата | #2 Добавлено: 21.12.08 00:35
Хм, обработал я твой код. Я повыкидывал и Scripting Runtime и FSO - если надо сделаешь сам
Вот этот код стабилен:
  1. 'На форме одна кнопка, Текстбоксы text1 и text2.
  2.  'БИБЛИОТЕКА Microsoft Scripting Runtime НЕ НУЖНА!!!
  3. 'Допустим что входной файл престаляет собой строку вида 3,22,66,44,88,,23,97,345,321
  4. Private Sub Command1_Click()
  5.   Dim MyArrStr() As String
  6.   Dim MyArr() As Long
  7.   Dim sStr As String
  8.   Dim i As Long
  9.    
  10.   'Читаем из файла
  11.   sStr = MyRead("in.txt")
  12.   Text1 = sStr 'отображаем в текстбокс
  13.   'Получаем массив строк
  14.   MyArrStr = Split(sStr, ",")
  15.   i = 0
  16.   ReDim MyArr(i)
  17.   'Преобразуем в массив
  18.   For i = 0 To UBound(MyArrStr)
  19.     ReDim Preserve MyArr(i)
  20.     MyArr(i) = Val(MyArrStr(i))
  21.   Next i
  22.   'Сортируем
  23.   Sort MyArr
  24.   'Собираем строку
  25.   sStr = ""
  26.   For i = LBound(MyArr) To UBound(MyArr)
  27.     MyArrStr(i) = CStr(MyArr(i))
  28.     sStr = sStr & MyArrStr(i)
  29.     If i <> UBound(MyArr) Then sStr = sStr & ","
  30.   Next i
  31.   Text2 = sStr 'отображаем в текстбокс
  32.   'Записываем файл
  33.   MyWrite sStr, "out.txt"
  34. End Sub
  35.  
  36. 'по-моему то что было у тебя написано в процедуре сортировки не было методом пузыря
  37. 'вот это по сути тоже самое, но несколько более близкое к истине :)
  38. Private Sub Sort(Mus() As Long)
  39.   Dim n As Long, i As Long, j As Long, tmp  As Long, f As Boolean
  40.   Do While Not f
  41.   f = True
  42.   For i = 0 To UBound(Mus) - 1
  43.     If Mus(i) > Mus(i + 1) Then
  44.       tmp = Mus(i)
  45.       Mus(i) = Mus(i + 1)
  46.       Mus(i + 1) = tmp
  47.       f = False
  48.     End If
  49.     Next i
  50.   Loop
  51. End Sub
  52.  
  53. 'Процедура записи (ну зачем тебе этот FSO???)
  54. Private Sub MyWrite(MyStr As String, outFile As String)
  55. Open app.Path + "\" + outFile For Output As #1
  56. Print #1, MyStr
  57. Close #1
  58. End Sub
  59.  
  60. 'Процедура чтения
  61. Private Function MyRead(inFile As String) As String
  62. Open app.Path + "\" + inFile For Input As #1
  63. Line Input #1, MyRead
  64. Close #1
  65. End Function

Ответить

Номер ответа: 3
Автор ответа:
 



Вопросов: 5
Ответов: 79
  Профиль | Цитата | #3 Добавлено: 21.12.08 00:38
Ой кажется FSO это часть Scripting Runtime... ну вихор с им...

Ответить

Номер ответа: 4
Автор ответа:
 #Nii



Вопросов: 1
Ответов: 4
  Профиль | Цитата | #4 Добавлено: 21.12.08 14:30
Понятно спасибо, но с FSO я проверил тоже работает, подключил Microsoft Scripting Runtime и все пашет.

Только вот терь надо чтоб выводилось в Textbox значение из in.txt а во второй textbox уже значения после сортировки. Как это сделать?
И можно ли еще сделать кнопку чтобы можно было вписать имя файла, и чтоб сохранились значения пузырька?

Ответить

Номер ответа: 5
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | Цитата | #5 		Добавлено: 22.12.08 02:54
Разве в текстбоксы не выводятся in.txt и значения после сортировки?
  sStr = MyRead("in.txt";)
  Text1 = sStr 'отображаем в текстбокс
...
  Text2 = sStr 'отображаем в текстбокс

И можно ли еще сделать кнопку чтобы можно было вписать имя файла, и чтоб сохранились значения пузырька?
можно.делай.
или вопросы какие-то?

Ответить

Номер ответа: 6
Автор ответа:
 #Nii



Вопросов: 1
Ответов: 4
  Профиль | Цитата | #6 Добавлено: 22.12.08 22:30
Наверно я не правильно выразился, надо чтобы на форме была кнопка при нажатии которой в Textbox загрузились числа из файла, и чтоб они были видны в программе, при нажатии другой кнопки массив сортируется, и в самой программе должно показаться массив уже обработанный. После чего нажимаем кнопку сохранить, значение сохраняется в файл.

Ответить

Номер ответа: 7
Автор ответа:
 Winand



Вопросов: 87
Ответов: 2795
  Web-сайт: winandfx.narod.ru
 Профиль | Цитата | #7 		Добавлено: 23.12.08 01:18
Хорошо. Ок. Давай так: сейчас как оно работает?

Ответить

Номер ответа: 8
Автор ответа:
 



Вопросов: 5
Ответов: 79
  Профиль | Цитата | #8 Добавлено: 23.12.08 02:27
Не скажет он тебе этого никогда-никогда, потому что настоящие мальчиши умеют хранить тайну своей Родины.

Ответить

Номер ответа: 9
Автор ответа:
 #Nii



Вопросов: 1
Ответов: 4
  Профиль | Цитата | #9 Добавлено: 23.12.08 09:46
Сейчас работает оно посредством одной кнопки, т.е. в папке с программой есть два файла in.txt и out.txt. В программе нажимаем кнопку, берется значения файла, и отправляет сразу отсортированный в out.txt

Ответить

Номер ответа: 10
Автор ответа:
 #Nii



Вопросов: 1
Ответов: 4
  Профиль | Цитата | #10 Добавлено: 23.12.08 09:49
Йопт, извиняюсь все выводит, сильно ступил

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам