Abaduaber

TOP22_M

Apr 14th, 2019
777
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. DECLARE FUNCTION GetWord$ (Tex$)
  2. CONST EndOfLine = "_EOL_", Delimiter = " ", EmptyString = ""
  3. DIM A$, Words$(1 TO 100), Word$
  4. DIM SHARED I AS INTEGER     'SHARED - общая с функциями переменная. ее значение видно в них
  5. DIM WI AS INTEGER
  6. CLS
  7. INPUT "Введите строку A$: ", A$
  8. I = 1
  9. DO
  10.     Word$ = GetWord$(A$)
  11.     SELECT CASE Word$
  12.         CASE Delimiter, EmptyString, EndOfLine
  13.         CASE ELSE
  14.             WI = WI + 1
  15.             Words$(WI) = Word$
  16.     END SELECT
  17. LOOP UNTIL Word$ = EndOfLine
  18. TotalWords = WI
  19.  
  20. 'Реализация сортировки выбором и слиянием прямо с википедии)00
  21. FOR J = 1 TO WI - 1
  22.     F = 0
  23.     Min = J
  24.     FOR I = J TO WI - J
  25.        IF ASC(UCASE$(Words$(I))) > ASC(UCASE$(Words$(I + 1))) THEN SWAP Words$(I), Words$(I + 1): F = 1
  26.        IF ASC(UCASE$(Words$(I))) < ASC(UCASE$(Words$(Min))) THEN Min = I
  27.     NEXT I
  28.     IF F = 0 THEN EXIT FOR
  29.     IF Min <> J THEN SWAP Words$(J), Words$(Min)
  30. NEXT J
  31. PRINT "Выходная отсортированная строка: ";
  32. FOR WI = 1 TO TotalWords
  33.     PRINT Words$(WI); " ";
  34. NEXT WI
  35.  
  36. 'Функция получает отдельное слово и возвращает его.
  37. 'Если вместо слова натыкается на пунктуацию всякую - возвращает пробел
  38. 'Этим дает знать, что наткнулась на разделитель. Стало быть
  39. 'точка запятая воск знак и прочее такое у нас разделяют слова.
  40. 'Если достигает последнего символа в строке - возвращает контстанту EndOfLine как индикатор
  41. FUNCTION GetWord$ (Tex$)
  42.     StartIndex = I
  43.     Length = 0
  44.     SELECT CASE MID$(Tex$, I, 1)
  45.         'CP866 - у мелких русских разрыв от а до п и потом р к я - из-за специфики 866 кодировки
  46.         CASE "A" TO "Z", "a" TO "z", "А" TO "Я", "а" TO "п", "р" TO "я", "'"
  47.             DO
  48.                 SELECT CASE MID$(Tex$, I, 1)
  49.                     CASE "A" TO "Z", "a" TO "z", "А" TO "Я", "а" TO "п", "р" TO "я", "'"
  50.                         I = I + 1
  51.                         Length = Length + 1
  52.                     CASE ELSE
  53.                         GetWord$ = MID$(Tex$, StartIndex, Length)
  54.                         EXIT DO
  55.                 END SELECT
  56.             LOOP
  57.         CASE Delimiter, ".", ",", "!", "?"
  58.             I = I + 1
  59.             GetWord$ = Delimiter
  60.         CASE ELSE
  61.             IF I >= LEN(Tex$) THEN
  62.                 GetWord$ = EndOfLine
  63.             ELSE
  64.                 I = I + 1
  65.                 GetWord$ = EmptyString
  66.             END IF
  67.     END SELECT
  68. END FUNCTION
RAW Paste Data