Студопедия

Главная страница Случайная страница

КАТЕГОРИИ:

АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника






Нарезалка бреда






Cуществуя одним прекрасным вечером, товарищу по имени Кулхацкер в голову стукнула идея: " Надо перемешать буквы в каждом слове предложения". Поскольку думать ему было лень, он это взвалил на меня). Подумав, я решил обрезать слова на 'слоги', определяемые по гласным буквам. Вот, какой неаккуратный и малопонятный код я выдал:

Private Const abc As String = " ёeеыаоэяию" Private Sub Main() Dim S As String, S_Arr() As String, words() As String Dim i As Integer, j As Integer, x As Integer, s_out As String, s_rnd As Integer Dim g As Integer, syllable As New Collection S = InputBox(" ", " Input", " интуп ёур текст хиар") S_Arr = Split(S, " ") 'MsgBox UBound(words) Randomize ReDim words(UBound(S_Arr)) For i = 0 To UBound(S_Arr)gen: Call get_Syllables(S_Arr(i), syllable) 'coolhacker' => 'co', 'o', 'lha', 'cke', 'r' x = syllable.Count 'MsgBox x,, " q" For j = 1 To x s_rnd = Int(syllable.Count * Rnd) + 1 '1...j 'MsgBox syllable.Item(s_rnd),, s_rnd words(i) = words(i) & syllable.Item(s_rnd) 'vb sucks syllable.Remove (s_rnd) Next If words(i) = S_Arr(i) And x > 1 Then loopword = False Call get_Syllables(S_Arr(i), syllable) For g = 1 To syllable.Count If syllable.Item(1) = syllable.Item(g) Then words(i) = S_Arr(i) Else words(i) = " " GoTo gen End If Next End If s_out = s_out & words(i) & " " 'fucking vb, vb sucks Next MsgBox s_out End Sub Private Sub get_Syllables(ByVal word As String, ByRef ss As Collection) Dim ss_tmp As String, ix As Integer, a As String, b As Integer do while ss.count ss.remove(1) loop For ix = 1 To Len(word) a = Mid$(word, ix, 1) ss_tmp = ss_tmp & a For j = 1 To Len(abc) If a = Mid$(abc, j, 1) Then ss.Add ss_tmp: ss_tmp = " " Next Next If ss_tmp < > " " Then ss.Add ss_tmp End Sub

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

Шедевры слога от Кулхацкера [образцы работы]

Переделано в:

Возможно, кому-то этот бред покажется интересным:)


Поделиться с друзьями:

mylektsii.su - Мои Лекции - 2015-2024 год. (0.005 сек.)Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав Пожаловаться на материал