| RinOS Подключенный к Матрице
 
   На форумах с февраля 2009
 Местонахождение:
 Сообщений: 4
 | Matrix Outlook Plugin Здравствуйте! Написал на досуге макрос для Outlook-a в общем набранный текст выводит в стиле Matrix. Предлагаю его вам попробывать!
 
 Цитата:
 Dim myTask As MailItem
 Dim TextMail, BodyHTML, HeadHtml, EndHtml, TempStr As String
 Dim ArrQuoted, ArrStyle, ArrStyleChar, WordArr As Variant
 Dim LLeft, iCountArr, iCountWrd As Integer
 Dim AddMatrixSymbol As Boolean
 
 AddMatrixSymbol = True ' Добавлять ли в текст симолы из матрицы, если True да False нет
 
 Randomize (50)
 
 ArrQuoted = Array("Matrix has you", "Это безумие. Я не смогу сделать это!", "Я умер?", _
 "Вы не напугаете меня этим гестаповским дерьмом! Свои права я знаю!", _
 "Я знаю кунг-фу.", "Мистер Волшебник! Вытащи меня на хрен отсюда!", _
 "Оружие. Много оружия.", "Что такое Матрица?", "Ложки не существует!", _
 "Тук, тук, Нео.", "Следуй за белым кроликом.", "Проснись, Нео.", _
 "Вставай, Тринити. Вставай! Надо встать!", "Попробуй увернись.", _
 "Ответ где то там, Нео, и он ищет тебя и найдет если ты хочешь этого.", _
 "Есть разница между тем чтобы знать путь и идти по нему.", _
 "Страх, сомнение, недоверие отбрось... освободи свой разум.", _
 "Добро пожаловать в реальный мир.", "Веришь ты или нет мразь, дерьмо, а здохнуть тебе придется", _
 "Ты слушаешь меня, Нео, или любуешься на женщину в красном платье? Оглянись.", _
 "Хватит попыток. Просто бей!", _
 "Если бы он сказал нам правду, мы бы засунули ему красную таблетку в его задницу!", _
 "Пристегнись, Дороти, и скажи Канзасу прости прощай.", "Счастье в неведение.", _
 "Скажите мне, мистер Андерсон... зачем вам телефон, если вы немы?", _
 "Я буду наслаждаться вашей смертью, мистер Андерсон.", _
 "Вы боитесь, мистер Андерсон? Это звук неизбежности. Звук вашей смерти.", _
 "Прощайте, мистер Андерсон.", "Убить Вас - наслаждение, мистер Андерсон.", _
 "Ложки нет.", "Всего лишь человек.", "Черт, это мой телефон, эй, этот парень спер мой телефон!", _
 "Я бы предложила тебе присесть, но ты все равно откажешься. И не переживай из за вазы.", _
 "Не пытайся согнуть ложку; это невозможно.", "Это не ложка гнется, дело в тебе.")
 
 HeadHtml = "<html><head><meta name='GENERATOR' content='Matrix Outlook Plugin vers. 1.5'><meta name='author' content='RinOS rinospro@mail.ru'></head><body bgcolor='#000000'>"
 HeadHtml = HeadHtml + "<font face='Courier New' size='3' color='#009900'>"
 
 ArrStyle = Array("<font face='Courier New' color='#009900'>", _
 "<font face='Courier New' color='#00ff00'>", _
 "<font face='Courier New' color='#33ff66'><b>")
 
 Set myTask = ActiveInspector.CurrentItem
 
 ArrStyleChar = Array("& #12521;", "& #12452;", "& #12501;", "& #12473;", "& #12510;", "& #12392;", "& #20154;", "& #12414;", _
 "& #12513;", "& #12512;", "& #12398;", "& #12507;", "& #12456;", "& #12486;", "& #12367;", "& #12375;", "& #19981;")
 
 TextMail = myTask.Body
 
 WordArr = Split(TextMail, " ", , vbTextCompare)
 
 For iCountArr = LBound(WordArr) To UBound(WordArr)
 TempStr = WordArr(iCountArr)
 LLeft = ((iCountArr + 1) * 28) + Int(0 + (Rnd() * 10))
 
 BodyHTML = BodyHTML + "<div style=""position: absolute; left:" + Str(LLeft) + _
 "px; top:" + Str(Int(10 + (Rnd() * 30))) + "px;"">"
 
 If Len(TempStr) > LHeight Then LHeight = Len(TempStr)
 
 For iCountWrd = 1 To Len(TempStr)
 If (Int(0 + (Rnd() * 3)) = 2) And (AddMatrixSymbol) Then
 BodyHTML = BodyHTML + ArrStyle(Int(0 + (Rnd() * 3))) + ArrStyleChar(Int(0 + (Rnd() * 17))) + "</font></b><br>"
 End If
 BodyHTML = BodyHTML + ArrStyle(Int(0 + (Rnd() * 3))) + Mid(TempStr, iCountWrd, 1) + "</font></b><br>"
 Next
 BodyHTML = BodyHTML + "</div>"
 Next
 
 EndHtml = "<font face='Courier New' size='3' color='#00FF00'><div style='position: absolute;top=" + Str(LHeight * 34) + _
 "'>" + ArrQuoted((Int(0 + (Rnd() * 34)))) + "</div></font></body></html>"
 
 myTask.HTMLBody = HeadHtml + BodyHTML + EndHtml
 myTask.Display
 
 
 
 Макрос -> Макросы. Появится окошко, там вводим имя макроса К примеру Matrix.
 
 Полжен появиться редактор с текстом
 
 Sub Martix()
 
 Вот сюда вы и скопируйте текст скрипта.
 
 End Sub
 
 И еще в тексте макроса:
 
 ArrStyleChar = Array("& #12521;", "& #12452;", "& #12501;", "& #12473;", "& #12510;", "& #12392;", "& #20154;", "& #12414;", _
 "& #12513;", "& #12512;", "& #12398;", "& #12507;", "& #12456;", "& #12486;", "& #12367;", "& #12375;", "& #19981;")
 
 удалите пробелы между & #
 
 Адрес поста | Один пост | Сообщить модератору | IP: Logged |