|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
|
Опции темы | Поиск в этой теме |
13.12.2012, 09:12 | #11 | |
Новичок
Джуниор
Регистрация: 13.12.2012
Сообщений: 2
|
Цитата:
Как показала практика, у людей возникали проблемы с настройкой макроса. Поэтому недавно я создал онлайн версию этой программы на javascript. ManuScript. Имитация рукописного текста онлайн http://anuscript.narod.ru/ С помощью онлайн-программы ManuScript Вы можете имитировать рукописные документы из любых исходных текстов. Для достижения наилучшего эффекта рукописи, рекомендую установить в системе дополнительные рукописные шрифты. Попробуйте воспользоваться рукописными шрифтами из архива. При обработке текстов большого объёма программа может заметно притормаживать. Скрины работы: http://s2.ipicture.ru/uploads/20121212/qWBu25y6.jpg http://s3.uploads.ru/q9WRl.gif Последний раз редактировалось phucker; 13.12.2012 в 09:16. |
|
14.12.2012, 16:03 | #12 |
Новичок
Джуниор
Регистрация: 13.12.2012
Сообщений: 2
|
Важной отличительной особенностью новой программы на javascript является возможность использования двух или более разных шрифтов для имитации рукописного текста (рукописи). Согласитесь, что такой подход позволяет достичь большей свободы в рандомизации написания текста. В принципе, пользователь может сгенерировать под свой почерк два-три шрифта с небольшими отклонениями в написании одних и тех же букв. А после с помощью программы ManuScript создать на их основе живой рукописный текст.
|
03.03.2018, 22:39 | #13 |
Новичок
Джуниор
Регистрация: 03.03.2018
Сообщений: 1
|
Немного доработал макрос. Теперь он перебирает шрифты. В связи с тем, что шрифты разные, отступ слева тоже отличается в каждой строчке. Плюс добавил возможность указывать количество обрабатываемых символов. Спасибо sguschenka за исходный код макроса!
Sub РукописныйШрифт() Dim R As Single, Temp As String Temp = InputBox("Введите количество обрабатываемых символов", "Ввод данных") If Temp <> "" Then R = CSng(Temp) For k = 1 To R 'Блок генерации случайных параметров S = 1.5 * (Rnd) + 21 'Размер шрифта от 21 до 22 L = 1 'Длина выделяемого блока 1 символов P = 1.5 * (Rnd - 0.5) 'Вертикальное отклонение от -0,75 до +0,75 D = 0.5 + (Rnd) 'Разрыв между символами от 0,5 до +1,5 ' Выделение символьного фрагмента Selection.MoveRight Unit:=wdCharacter, Count:=L, Extend:=wdExtend ' Установка параметров текста With Selection.Font .Name = Array("E1", "E2", "E3", "E4")(CInt(Rnd * 3)) ' <---- Рукописный шрифт .Size = S .Bold = False .Italic = False .Underline = wdUnderlineNone .UnderlineColor = wdColorAutomatic .StrikeThrough = False .DoubleStrikeThrough = False .Outline = False .Emboss = False .Shadow = False .Hidden = False .SmallCaps = False .AllCaps = False .Color = 0 .Engrave = False .Superscript = False .Subscript = False .Spacing = D .Scaling = 100 .Position = P .Kerning = 0 .Animation = wdAnimationNone End With Selection.MoveRight Unit:=wdCharacter, Count:=1 Next k MsgBox "Шрифт применён. Обработано " & R & " символов.", , "Результат обработки" Else: MsgBox "Вы отказались от ввода данных! Макрос не применён." End If End Sub |
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Не работает рукописный ввод | vlad911 | Microsoft Office Word | 7 | 25.04.2013 17:29 |
Текст стандартных функций и процедур для работы со строками в Delphi | Pixma | Помощь студентам | 3 | 17.11.2010 13:25 |
Рукописный компонент-кнопка | NoName_emaNoN | Компоненты Delphi | 0 | 24.05.2010 20:06 |
Нужен помощник для сдачи экзамена | gx5rmsu8x | Помощь студентам | 0 | 30.01.2010 18:05 |
Для облегчения работы с TFS - приложение для работы над дефектами и задачами | Аякс | Софт | 1 | 18.03.2009 11:43 |