1. Alreader 2.5
Наиболее распространенная читалка. Понимает файлы в форматах html, rtf, fb2, doc, docx, odt, sxw, abw, zabw, rb, tcr, chm, txt, pbd/prc. Умеет читать из архивов zip. Сайт программы alreader.kms.ru
2. Haali Reader 2.0
Уже несколько устаревшая программа, поддерживающая только txt и fb2. Сайт: haali.su/pocketpc/index.html.ru
3. Freda 1.1
Новая читалка, поддерживающая форматы txt, html и новый, набирающий популярность формат epub. От версии 1.0 до версии 1.1 программа весьма заметно усовершенствовалась. Скачать можно здесь.
Макрос для конвертации старой орфографии в новую
Кто занимался вычиткой текста в старой орфографии, тот поймет меня. Конвертация в новую представляется необходимым и оправданным решением. С этой целью я написал небольшой макрос, который текст из старой орфографии переводит в новую. Однако, от простого макроса не стоит ждать чудес, возможны неверные срабатывания, а также за бортом остается большое количество слов, написание которых со временем изменилось, например: стратиг и стратег, литтература и литература. Такие слова придется править вручную.
Скопируйте текст макроса и вставьте его в свой normal.dot
Sub КонвертацияИзСтаройОрфографии()
' КонвертацияИзСтаройОрфографии Макрос
' Конвертация старой орфографии в современную.
' Текст должен быть распознан программой Fine Reader, в которой
' для старой орфографии используется шрифт Cabria.
' Макрос ориентирован на использование этого шрифта.
'---------------------------------------------
' Переменные
' Символы означающие конец слова
EndOfWortString = " .,:;!?-)"
'Шипящие
Hiss = "шщч"
'Звонкие
Sonorous = "бвгджзйльнр"
'Глухие
Deaf = "пфкешсхцчщ"
'---------------------------------------------
' Убираем буквы "ять", "i", "фита"
Dim Simv(1 To 6, 1 To 2) As String
' Заменяем букву "ять"
Simv(1, 1) = ChrW(1123)
Simv(1, 2) = "е"
Simv(2, 1) = ChrW(1122)
Simv(2, 2) = "Е"
' Заменяем букву "i"
Simv(3, 1) = ChrW(1110)
Simv(3, 2) = "и"
Simv(4, 1) = ChrW(1030)
Simv(4, 2) = "И"
' Заменяем букву "фита"
Simv(5, 1) = ChrW(1139)
Simv(5, 2) = "ф"
Simv(6, 1) = ChrW(1138)
Simv(6, 2) = "Ф"
For i = 1 To 6
With Selection.Find
.Text = Simv(i, 1)
.Replacement.Text = Simv(i, 2)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
'---------------------------------------------
'Конечная буква Ъ
For i = 1 To Len(EndOfWortString)
With Selection.Find
.Text = "ъ" + Mid(EndOfWortString, i, 1)
.Replacement.Text = Mid(EndOfWortString, i, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
'---------------------------------------------
'Замена окончаний прилагательные и причастия аго (яго) на ого (его)
' возможны неправильные срабатывания
Dim EndS(1 To 2, 1 To 2)
EndS(1, 1) = "аго"
EndS(1, 2) = "ого"
EndS(2, 1) = "яго"
EndS(2, 2) = "его"
For j = 1 To Len(EndOfWortString)
For i = 1 To 2
With Selection.Find
.Text = EndS(i, 1) + Mid(EndOfWortString, j, 1)
.Replacement.Text = EndS(i, 2) + Mid(EndOfWortString, j, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
' исправим косяки - "его" после шипящих
For k = 1 To Len(Hiss)
For j = 1 To Len(EndOfWortString)
With Selection.Find
.Text = Mid(Hiss, k, 1) + "ого" + Mid(EndOfWortString, j, 1)
.Replacement.Text = Mid(Hiss, k, 1) + "его" + Mid(EndOfWortString, j, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
'---------------------------------------------
'Замена окончаний - родительный падеж, прилагательные, множественное число, женский род
' ыя (ия) на ые (ие)
For j = 1 To Len(EndOfWortString)
With Selection.Find
.Text = "ыя" + Mid(EndOfWortString, j, 1)
.Replacement.Text = "ые" + Mid(EndOfWortString, j, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
'окончание ия напрямую не заменяем, будет путаться с существительными :(
'но нам помогут суффикусы прилагательных
' -- ащ, ющ, ш, ск
Dim Suffix(1 To 3)
Suffix(1) = "ш"
Suffix(2) = "щ"
Suffix(3) = "ск"
For j = 1 To Len(EndOfWortString)
For i = 1 To 3
With Selection.Find
.Text = Suffix(i) + "ия" + Mid(EndOfWortString, j, 1)
.Replacement.Text = Suffix(i) + "ие" + Mid(EndOfWortString, j, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
'но а теперь проделаем тоже самое, но учтем суффик -ся
For j = 1 To Len(EndOfWortString)
With Selection.Find
.Text = "ыяся" + Mid(EndOfWortString, j, 1)
.Replacement.Text = "ыеся" + Mid(EndOfWortString, j, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
For j = 1 To Len(EndOfWortString)
With Selection.Find
.Text = "ияся" + Mid(EndOfWortString, j, 1)
.Replacement.Text = "иеся" + Mid(EndOfWortString, j, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
' сюда же добавим прилагательные оканчивающиеся на ия, но не обработанные выше
Dim Repl(1 To 10, 1 To 2)
Repl(1, 1) = "древния"
Repl(1, 2) = "древние"
Repl(2, 1) = "средния"
Repl(2, 2) = "средние"
Repl(3, 1) = "какия"
Repl(3, 2) = "какие"
Repl(4, 1) = "другия"
Repl(4, 2) = "другие"
Repl(5, 1) = "мелкия"
Repl(5, 2) = "мелкие"
Repl(6, 1) = "многия"
Repl(6, 2) = "многие"
Repl(7, 1) = "последния"
Repl(7, 2) = "последние"
Repl(8, 1) = "высокия"
Repl(8, 2) = "высокие"
Repl(9, 1) = "дальния"
Repl(9, 2) = "дальние"
Repl(10, 1) = "низкия"
Repl(10, 2) = "низкие"
For j = 1 To Len(EndOfWortString)
For i = 1 To 10
With Selection.Find
.Text = Repl(i, 1) + Mid(EndOfWortString, j, 1)
.Replacement.Text = Repl(i, 2) + Mid(EndOfWortString, j, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
'---------------------------------------------
' Замена местоимений: оне, одне, однех, однемъ, однеми на они, одни, одних, одним, одними;
' написание с учетом того, что яти и твердые знаки уже убраны
' Замена местоимений: ея (нея) - на её (неё).
Dim Pronout(1 To 7, 1 To 2)
Pronout(1, 1) = "оне"
Pronout(1, 2) = "они"
Pronout(2, 1) = "одне"
Pronout(2, 2) = "одни"
Pronout(3, 1) = "однех"
Pronout(3, 2) = "одних"
Pronout(4, 1) = "однем"
Pronout(4, 2) = "одним"
Pronout(5, 1) = "однеми"
Pronout(5, 2) = "одними"
Pronout(6, 1) = "ея"
Pronout(6, 2) = "её"
Pronout(7, 1) = "нея"
Pronout(7, 2) = "неё"
For j = 1 To Len(EndOfWortString)
For i = 1 To 7
With Selection.Find
.Text = " " + Pronout(i, 1) + Mid(EndOfWortString, j, 1)
.Replacement.Text = " " + Pronout(i, 2) + Mid(EndOfWortString, j, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
'---------------------------------------------
' приставки на З
' без-(бес-), вз-(вс-), воз-(вос-), из-(ис-), низ-(нис-), раз-(рас-), роз-(рос-), через-(черес-)
Dim Prefix(1 To 9, 1 To 2)
Prefix(1, 1) = " без"
Prefix(1, 2) = " бес"
Prefix(2, 1) = " вз"
Prefix(2, 2) = " вс"
Prefix(3, 1) = " воз"
Prefix(3, 2) = " вос"
Prefix(4, 1) = " из"
Prefix(4, 2) = " ис"
Prefix(5, 1) = " низ"
Prefix(5, 2) = " нис"
Prefix(6, 1) = " раз"
Prefix(6, 2) = " рас"
Prefix(7, 1) = " роз"
Prefix(7, 2) = " рос"
Prefix(8, 1) = " через"
Prefix(8, 2) = " черес"
Prefix(9, 1) = " обез"
Prefix(9, 2) = " обес"
' перед глухой - з меняем на с
For i = 1 To 9
For j = 1 To Len(Deaf)
With Selection.Find
.Text = Prefix(i, 1) + Mid(Deaf, j, 1)
.Replacement.Text = Prefix(i, 2) + Mid(Deaf, j, 1)
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
' исправим косяк: образования от слова "низ" - низший, низкий и т.д.
With Selection.Find
.Text = " нисш"
.Replacement.Text = " низш"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " ниск"
.Replacement.Text = " низк"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' а теперь исправим вновь созданный косяк - нисколько
With Selection.Find
.Text = "низколько"
.Replacement.Text = "нисколько"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Сноски и примечания в текстах, размещенных на этом сайте, имеют следующий формат:
.... [n]......
...[n+1]......
...
{n ... }
{n+1 ...}
В квадратных скобках номер сноски, в фигурных ее текст. Обычно я помещаю текст сносок под абзац, в котором они встречаются. По просьбе посетителей сайта помещаю макрос, который такие сноски преобразует в "обычные" постраничные примечания. Вставьте этот макрос в свой Word, возьмите текст с сайта и запускайте макрос.
Этот макрос также удобно использовать при вычитке. Вычитав страницу, и оформив примечения, как указано выше (нумерация при этом не важна), запускайте макрос: он найдей все примечания и преобразует их. Нумерация при этом будет сквозная во всем тексте.
' ПравильныеСноски() Макрос
'
'
StartNumber = InputBox("Начальный номер сноски")
EndNumber = InputBox("Конечный номер сноски")
For i = StartNumber To EndNumber
Selection.Find.ClearFormatting
With Selection.Find
.Text = "\{" + CStr(i) + " *\}^0013"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.Text = Replace(Selection.Text, "{", "")
Selection.Text = Replace(Selection.Text, "}", "")
Selection.Cut
Selection.Find.ClearFormatting
With Selection.Find
.Text = "[" + CStr(i) + "]"
.Replacement.Text = ""
.Forward = False
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
With .FootnoteOptions
.Location = wdEndOfDocument
.NumberingRule = wdRestartContinuous
.StartingNumber = 1
.NumberStyle = wdNoteNumberStyleArabic
End With
.Footnotes.Add Range:=Selection.Range, Reference:=""
End With
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "[" + CStr(i) + "]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Cut
Next
MsgBox ("Все!")
End Sub
При распознавании текстов, посвященных античной истории часто возникает проблема: что делать с греческими буквами? Впрочем, проблема не такая уж и большая; среди рядовых любителей истории мало найдется знатоков и ценителей греческого языка. Греческие буквы можно просто выбросить, или оставить абракадабру, получившуюся в результате распознавания, никто по этому поводу огорчаться не будет. Fine Reader, между прочим знает и распознает греческие буквы, вот только результат такого распознавания не всегда удовлетворителен: во-первых Fine Reader не всегда узнает места написанные по-гречески, а во-вторых, вычитывать сколь-либо большие куски греческого текста, без знания языка, попросту невозможно.
Допустим, вы достаточно дотошны и скрупулезны, и всенепременно хотите, чтобы в распознанном вами тексте были греческие слова. Можно, конечно, подключить греческую раскладку. Можно подыскать виртуальную клавиатуру, поддерживающую греческий язык. В конце концов, можно использовать штанное средство Word’а – вставка символов.
Я достаточно ленив, чтобы что-то устанавливать на свой компьютер, нужное лишь эпизодически, но в то же время, достаточно квалифицирован, чтобы решить проблему подручными средствами.
Я написал макрос для Word’а, который вместо меня пишет греческие буквы.
Первым делом я попытался найти готовое решение и подобрать программу транслитерации для греческого алфавита. То, что я нашел, меня не вполне устраивало. И я пошел своим путем.
Сначала я составил свою таблицу перевода латиницы и кириллицы в греческие буквы. В первую очередь я исходил из фонетического звучания, во-вторую из начертания. В-третьях, мне нужна была не полноценная система транслитерации, а простая схема замены латинских и русских символов на греческие. Важно было добиться того, чтобы текст заменялся за один проход программы, без излишнего усложнения алгоритма.
Вот таблица соответствия:
|
Греческие буквы |
Латиница |
Кириллица |
|
Α α |
A a |
А а |
|
Ά ά |
-A -a |
-А -а |
|
Β β |
B b |
Б б В в |
|
Γ γ |
G g |
Г г |
|
Δ δ |
D d |
Д д |
|
Ε ε |
E e |
Е е |
|
Έ έ |
-E -e |
-Е -е |
|
Ζ ζ |
Z z |
З з |
|
Η η |
H h |
Э э |
|
Ή ή |
-H -h |
-Э -э |
|
Θ |
-TH -th |
-Т -т |
|
Ι |
I i |
И |
|
Ί |
-I -i |
Й |
|
Ϊ ϊ |
:I :i |
:И :и |
|
ΐ |
-:i |
:й |
|
Κ κ |
K k |
К к |
|
Λ λ |
L l |
Л л |
|
Μ μ |
M m |
М м |
|
Ν ν |
N n v |
Н н |
|
Ξ ξ |
X x |
-Х -х |
|
Ο ο |
O o |
О о |
|
Ό ό |
-O -o |
-О -о |
|
Π π |
P p |
П п |
|
Ρ ρ |
R r |
Р р |
|
Σ σ |
S s |
С с |
|
ς |
c |
ц |
|
Τ τ |
T t |
Т т |
|
Υ υ |
U u Y y |
У у |
|
Ύ ύ |
-U -u -Y -y |
-У -у |
|
Ϋ ϋ |
:U :u :Y :y |
:У :у |
|
ΰ |
-:u -:y |
-:у |
|
Φ φ |
-PH -ph |
Ф ф |
|
Χ χ |
-CH -ch |
Х х |
|
Ψ ψ |
-PS -ps |
-Ж ж |
|
Ω ω |
W w |
Ш ш |
|
Ώ ώ |
-W -w |
-Ш -ш |
А вот текст макроса:
Function Translit(Simv)
Result = ""
Select Case Simv
Case "a", "а"
Result = ChrW(945)
Case "-a", "-а"
Result = ChrW(940)
Case "b", "б", "в"
Result = ChrW(946)
Case "g", "г"
Result = ChrW(947)
Case "d", "д"
Result = ChrW(948)
Case "e", "е"
Result = ChrW(949)
Case "-e", "-е"
Result = ChrW(941)
Case "z", "з"
Result = ChrW(950)
Case "h", "э"
Result = ChrW(951)
Case "-h", "-э"
Result = ChrW(942)
Case "-th", "-т"
Result = ChrW(952)
Case "i", "и"
Result = ChrW(953)
Case "-i", "й"
Result = ChrW(943)
Case ":i", ":и"
Result = ChrW(970)
Case "-:i", ":й"
Result = ChrW(912)
Case "k", "к"
Result = ChrW(954)
Case "l", "л"
Result = ChrW(955)
Case "m", "м"
Result = ChrW(956)
Case "n", "v", "н"
Result = ChrW(957)
Case "x", "-х"
Result = ChrW(958)
Case "o", "о"
Result = ChrW(959)
Case "-o", "-о"
Result = ChrW(972)
Case "p", "п"
Result = ChrW(960)
Case "r", "р"
Result = ChrW(961)
Case "c", "ц"
Result = ChrW(962)
Case "s", "с"
Result = ChrW(963)
Case "t", "т"
Result = ChrW(964)
Case "u", "y", "у"
Result = ChrW(965)
Case "-u", "-y", "-у"
Result = ChrW(973)
Case ":u", ":y", ":у"
Result = ChrW(971)
Case "-:u", "-:y", "-:у"
Result = ChrW(944)
Case "-ph", "ф"
Result = ChrW(966)
Case "-ch", "х"
Result = ChrW(967)
Case "-ps", "ж"
Result = ChrW(968)
Case "w", "ш"
Result = ChrW(969)
Case "-w", "-ш"
Result = ChrW(974)
End Select
Translit = Result
End Function
Sub ГрекоПись()
' транлитерация латиницы и кириллицы в греческие буквы
' используется моя система :)
Neuchet = " .,!?1234567890"
Text = Selection.Text
GreekText = ""
Simv = ""
For i = 1 To Len(Text)
Dob = Mid(Text, i, 1)
If Dob = UCase(Dob) Then
bigLetter = True
Else
bigLetter = False
End If
Simv = LCase(Simv + LCase(Dob))
If InStr(Neuchet, Simv) > 0 Then
GreekText = GreekText + Simv
Simv = ""
Else
If Len(Simv) > 3 Then
MsgBox ("Какая-то фигня! проверьте написание")
Stop
End If
greekSimv = Translit(Simv)
If greekSimv <> "" Then
If bigLetter Then
greekSimv = UCase(greekSimv)
End If
GreekText = GreekText + greekSimv
Simv = ""
End If
End If
Next
Selection.Text = GreekText
End Sub
Скопируйте текст макроса, и вставьте его в свой Normal.dot , в меню «Макросы» у вас появится макрос «ГрекоПись». Наберите текст, пользуясь таблицей соответствия, выделите этот текст, вызовите макрос и вуаля! Ваш текст будет написан по-гречески.
Пример: пишем Але-хандроц Мегац, получаем Αλεξανδρος Μεγας