Главная страница Случайная страница
Разделы сайта
АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника
Нарезалка бреда
|
|
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Поначалу написав код, я не подумал о такой значимой детали, как слова, все 'слоги' которых одинаковы. Они могли зациклить код намертво, а посему, говно код был переписан.
Шедевры слога от Кулхацкера [образцы работы]
Переделано в:
Возможно, кому-то этот бред покажется интересным:)
|
|