Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Программирование, связанное с MS Office > Matrix Outlook Plugin


Автор: RinOSpro 5.9.2008, 15:32
Здравствуйте! Написал на досуге макрос для Outlook-a в общем набранный текст выводит в стиле Matrix. Предлагаю его вам попробывать smile особенно фанатам фильма матрица smile

Код

Sub Martix()
  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 [email protected]'></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("ラ", "イ", "フ", "ス", "マ", "と", "人", "ま", _
    "メ", "ム", "の", "ホ", "エ", "テ", "く", "し", "不")
  
  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
End Sub



Кроме того новичкам этот код будет пособием как работать с Outlook-ом в VBA.

Добавлено @ 15:38
Для удобства в архиве этот скрипт, т.к. при размещение на сайте символы аля & # 12452 ; превратились в "ラ", "イ", "フ", "ス"... и т.д. smile а скопировав их там они будут отображаться как "?" "?" "?"

Автор: RinOSpro 2.9.2009, 11:42
Вот так выглядит результат:

http://www.radikal.ru

http://www.radikal.ru

Автор: RockClimber 2.9.2009, 11:49
Второй скриншот выглядит особенно зачетно  smile Жаль только, практической пользы мало. Хотя, если писать текст горизонтально, и читать будет можно, и стиль узнаваться будет...

Автор: RinOSpro 2.11.2009, 10:53
Первый вариант был именно горизонтальный, гораздо сложнее было сделать вертикальный текст)

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)