VPF::Matrix Outlook Plugin - Форум программистов

RinOSpro

Дата 5.9.2008, 15:32 (ссылка)

(голосов: 1)

Загрузка ...

Unregistered

Здравствуйте! Написал на досуге макрос для 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 - 12.11.2009, 17:36

Присоединённый файл ( Кол-во скачиваний: 12 )

Matrix_Outlook_Plugin.rar 1,73 Kb

RinOSpro

Дата 2.9.2009, 11:42 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Вот так выглядит результат:

RockClimber

Дата 2.9.2009, 11:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 848
Регистрация: 5.5.2006
Где: планета 013 в тен туре

Репутация: 7
Всего: 15

Второй скриншот выглядит особенно зачетно smile

Жаль только, практической пользы мало. Хотя, если писать текст горизонтально, и читать будет можно, и стиль узнаваться будет...

--------------------

Хорошо кинутый дятел далеко летит, крепко встревает, долго торчит.

RinOSpro

Дата 2.11.2009, 10:53 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Первый вариант был именно горизонтальный, гораздо сложнее было сделать вертикальный текст)

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Программирование, связанное с MS Office \| Следующая тема »