48231 (Программа для перевода текстов с транслита), страница 2
Описание файла
Документ из архива "Программа для перевода текстов с транслита", который расположен в категории "". Всё это находится в предмете "информатика" из 1 семестр, которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "курсовые/домашние работы", в предмете "информатика, программирование" в общих файлах.
Онлайн просмотр документа "48231"
Текст 2 страницы из документа "48231"
begin
if memCyr.Focused then memCyr.Undo;
if memLat.Focused then memLat.Undo;
end;
-
«Вырезать CTRL+X» acCut
Вырезает выделенный текст в текущем (активном) поле для ввода.
Листинг 10. «Обработчик главного меню Правка -> Вырезать»
procedure TMainForm.acCutExecute(Sender: TObject);
begin
if memCyr.Focused then memCyr.CutToClipboard;
if memLat.Focused then memLat.CutToClipboard;
end;
-
«Копировать CTRL+С» acCopy
Копирует выделенный текст в текущем (активном) поле для ввода.
Листинг 11. «Обработчик главного меню Правка -> Копировать»
procedure TMainForm.acCopyExecute(Sender: TObject);
begin
if memCyr.Focused then memCyr.CopyToClipboard;
if memLat.Focused then memLat.CopyToClipboard;
end;
-
«Вставить CTRL+V» acPaste
Вставляет текст из буфера в текущее (активное) поле для ввода.
Листинг 12. «Обработчик главного меню Правка -> Вставить»
procedure TMainForm.acPasteExecute(Sender: TObject);
begin
if memCyr.Focused then memCyr.PasteFromClipboard;
if memLat.Focused then memLat.PasteFromClipboard;
end;
-
«Удалить CTRL+Del» acDelete
Удаляет выделенный текст из текущего (активного) поля для ввода.
Листинг 13. «Обработчик главного меню Правка -> Удалить»
procedure TMainForm.acDeleteExecute(Sender: TObject);
begin
if MemCyr.Focused then memCyr.ClearSelection;
if MemLat.Focused then memLat.ClearSelection;
end;
-
«Выделить всё CTRL+A»
Выделяет весь текст в текущем (активном) поле для ввода.
Листинг 14. «Обработчик главного меню Правка -> Выделить всё»
procedure TMainForm.N18Click(Sender: TObject);
begin
if memo1.Focused then memo1.SelectAll;
if memo2.Focused then memo2.SelectAll;
end;
-
Меню «Перевод»
-
«перевести с кириллици в латиницу» acCyrToLat
-
Переводит текст из кириллицы в транслит. Текст данной процедуры будет рассмотрен ниже.
-
«перевести с латиници в кириллицу» acLatToCyr
Переводит текст из транслита в кириллицу. Текст данной процедуры будет рассмотрен ниже.
-
«Редактировать алфавит» acAlphEdit
Отображает форму редактирования словаря.
-
Меню «Справка»
-
«О программе»
-
Отображает форму «О программе»
Листинг 15.«Обработчик главного меню Справка -> О программе»
procedure TMainForm.N7Click(Sender: TObject);
begin
AboutForm.show;
end;
-
Форма «Редактор алфавита»
Данная форма предназначена для загрузки, сохранения и редактиро-вания словарей перевода кириллицы в транслит.
рис. 8. Форма «Редактора»
На форме расположены следующие компоненты:
-
TStringGrid;
-
TPanel;
-
TBitBtn (2 шт.);
-
TOpenDialog;
-
TSaveDialog;
-
TButton;
Компонент TStringGrid предназначен для ввода и просмотра таблицы перевода. На TPanel расположены все кнопки. TBitBtn – позволяют сохранять и загружать словари. Диалоги TOpenDialog и TSaveDialog предназначены для выбора файлов словарей. TButton – применяет текущие настройки к глобальному словарю (он расположен в Unit_main).
Обработчики событий.
При создании формы происходит заполнение таблицы (SlovGrid):
Листинг 16. «Созание формы Редактировать алфавит»
procedure TSlovarForm.FormCreate(Sender: TObject);
var
i1 :integer;
begin
SlovGrid.Cells[0,0]:= 'Русский';
SlovGrid.Cells[1,0]:= 'Перевод';
for i1:= 1 to 33 do
begin
SlovGrid.Cells[0,i1]:= alph_r[i1];
if i1 = 7 then SlovGrid.Cells[1,i1]:= b_jo
else SlovGrid.Cells[1,i1]:= alph[alph_r[i1]];
end;
f_name:= '';
end;
Обработчик нажатия на кнопку «Сохранить». Если пользователь выбрал файл, куда сохранить новый словарь, то происходит перезапись этого файла. В него (как в типизированный файл) записывается последовательность переменных типа ShortString. Эти данные (и их количество) берутся из таблицы SlovGrid:
Листинг 17. «Нажатия на кнопку Сохранить»
procedure TSlovarForm.SveButtClick(Sender: TObject);
var
f :file of shortstring;
i1 :integer;
str :shortstring;
begin
if savefile.execute then
begin
assignfile(f,SaveFile.FileName);
f_name:= SaveFile.FileName;
rewrite(f);
for i1:= 1 to SlovGrid.RowCount-1 do
begin
str:= SlovGrid.Cells[1,i1];
write(f,str);
end;
closefile(f);
end;
end;
Обработчик нажатия на кнопку «Загрузить». Если пользователь выбрал файл, откуда загрузить новый словарь, то происходит чтение этого файла. Из него (как из типизированного файла) загружаютчя последовательность переменных типа ShortString. Эти данные записываются в таблицу SlovGrid:
Листинг 18. «Нажатия на кнопку Загрузить»
procedure TSlovarForm.OpenButtClick(Sender: TObject);
var
f :file of shortstring;
str :shortstring;
i1 :integer;
begin
if openfile.execute then
try
assignfile(f,OpenFile.FileName);
reset(f);
for i1:= 1 to 33 do
begin
read(f,str);
SlovGrid.Cells[1,i1]:= str;
end;
closefile(f);
F_name:= OpenFile.FileName;
except
showmessage('Неверный формат фаила!!!');
end;
end;
Обработчик нажатия на кнопку «Применить». Изменяет текущий словарь ( alph : array['А'..'Я'] of shortstring из unit_main) в соответствии с текущими данными из таблицы SlovGrid и пишет название словаря в StatusBar главной формы.
Листинг 19. «Нажатие на кнопку Применить»
procedure TSlovarForm.ApplButtClick(Sender: TObject);
var
i1 :integer;
str :string;
begin
for i1:= 1 to SlovGrid.RowCount-1 do
begin
str:= SlovGrid.Cells[1,i1];
if i1 = 7 then b_jo:= str
else alph[alph_r[i1]]:= str;
end;
if f_name <> '' then
MainForm.StatusBar.Panels[1].Text:= f_name
else
MainForm.StatusBar.Panels[1].Text:= 'Изменено пользователем';
SlovarForm.Close;
end;
-
-
Форма «О программе»
На форме расположено несколько Label с изменённым свойством Caption. Никаких обработчиков событий нет.
-
Основные алгоритмы
Перевод из кириллицы в транслит:
Построчно для каждой строки поля MemCyr и посимвольно для каждого символа этой строки, программа проверяет её вхождение в множество больших или маленьких символов русского алфавита. Если вхождение действительно то программа добавляет к строке str2 соответствующие символы из словаря перевода.
Листинг 20. «Перевод кириллица -> транслит»
procedure TMainForm.acCyrToLatExecute(Sender: TObject);
var
i1,j1,i3 :integer;
str,str1,str2,st2 :string;
ch,ch2 :char;
ok1 :boolean;
begin
MainForm.MemCyr.Clear;//чистим то, куда будем писать переведенный текст
for i1:= 0 to MainForm.MemCyr.Lines.Count-1 do //проходим по всем строкам в первом окошке
begin
str:= MainForm.MemCyr.Lines[i1]; //считываем данные и обнуляем переменные
str2:= '';
for j1:= 1 to length(str) do //проходим по всем символам в строке
begin
ch:= str[j1];
if ch in al_set then //если ch - заглавная русская буква
begin
if UpCase_R(ch) = 'Ё' then str1:= b_jo //Ё проверяем отдельно
else str1:= alph[UpCase_R(ch)]; //А все остальные берем из alph
if str1 <> '' then //Этот блок делает заглавным то,
begin //что должно быть заглавным.
if (length(str)> j1)and(str[j1+1] in al_set)or
(j1 > 1)and(str[j1-1] in al_set)then
for i3:= 1 to length(str1) do //тут либо поднимается вся буква
(несколько символов, например SH)
begin
str1[i3]:= UpCase_R(str1[i3]);
end
else //либо только первый символ в букве (Sh)
str1[1]:= UpCase_R(str1[1]);
end;
str2:= str2+str1;
end
else if ch in small_al then //если маленькая русская буква
begin
if UpCase_R(ch) = 'Ё' then str1:= b_jo
else str1:= alph[UpCase_R(ch)];
str2:= str2+str1;
end
else //если не является символом русского алфавита
str2:= str2+ch;
end;
MainForm.MemLat.Lines.Add(str2); //добавляем переведенную строку в окошко
с переводом
end; //и все с начала (след. строка)
end;
В приложении №1 приводится блок-схема этого алгоритма.
Обратный перевод осуществляется аналогично прямому за исключением того, что из строки с транслитом сначала выбирается подстрока с длинной равной наибольшей длинне буквы в словаре транслита (для правильной обработки символов типа «ъ» - «’ ’» и «ь» - «’ ’»):
procedure TMainForm.acLatTuCyrExecute(Sender: TObject);
const
lat_small : set of char = ['a'..'z',''''];
lat_up : set of char = ['A'..'Z'];
var
i1,j1,i3,max_l,tek_l,len :integer;
str,str1,st2 :string;
ch :char;
ok1,f_ok :boolean;
function find(var st_in:string):boolean; //Эта функция ищет в alph['А'..'Я'] заданную строку
var //т.е. пытается определить какой букве русского алфавита соответствует введенная строка
i2 :char;
j2,i3 :integer;
st_mod :string;
ok :boolean;
begin
st_mod:= st_in; //Будем работать с локальной переменной, чтоб не испортить исходную строку
for j2:= 1 to length(st_mod) do //уменьшаем регистр у символов в строке
st_mod[j2]:= downcase(st_mod[j2]);
find:= false; //Присваиваем начальное значение результату функции
if b_jo = st_mod then //буква определяется Ё отдельно
begin
st_mod:= 'Ё';
if st_in[1] in lat_small then st_mod:= 'ё'; //проверяем должна ли буква быть маленькой
st_in:= st_mod; //меняем исходную на переведенную
find:= true; //да, мы нашли соответствие возвращаем true
exit; //досрочный выход.
end;
for i2:= 'А' to 'Я' do //а если не Ё, то проверяем все буквы по алгоритму приведенному выше
begin
if alph[i2] = st_mod then
begin
st_mod:= i2;
if (st_in[1] in lat_up) then st_in:= st_mod;
else st_in:= DownCase(st_mod);
find:= true;
exit;
end;
end;
end;
begin
MainForm.MemCyr.Clear; //очищаем поле для результата
max_l:= length(b_jo); //запоминаем длинну самой длинной буквы в алфавите
for ch:= 'А' to 'Я' do //цикл по всем буквам
begin
tek_l:= length(alph[ch]);
if tek_l > max_l then max_l:= tek_l;
end;
for i1:= 0 to MainForm.MemLat.Lines.Count-1 do //цикл построчно
begin
str:= MainForm.MemLat.Lines[i1];
st2:= '';
str1:= '';
while str <> '' do //пока строка не пустая (обработанные символы будем удалять)
begin
f_ok:= false;
for j1:= max_l downto 1 do //пытаемся собрать букву разной длины
begin
st2:= '';
for i3:= 1 to j1 do
begin
if (str[i3] in lat_small)or(str[i3] in lat_up)then
st2:= st2+str[i3] //если латинская буква тогда заносим её в st2!
else if j1 = 1 then
begin
st2:= str[i3]; //это символ не кириллицы, заносим в строку с результатом (st2)
delete(str,1,1); //удаляем из исходной
f_ok:= true; //обработали
break;
end
else break;
end;