Русские шрифты , Проблемы и решения

Я тут подумал, и решил собрать в единое, то, что было в теме "Сделайте мне русский в паскале!!!" и длбавить кое-что своего...

Часть1. TMT Pascal 3.90. Текстовый режим.

Дело в том, что при наборе программы используется ANSI(Windows) кодировка русского языка, а DOS использует OEM кодировку, и поэтому при запуске программы

 
begin
  WriteLn('Привет!');
end.

она выведет иероглифы вроде §к╩Ї}Ї!

Решение проблемы. Пишем функцию, для преобразования ANSI в OEM:

 
function ANSI_to_OEM(s:string):string;
var
  i:integer;
  res:string;
begin
  fillchar(res,sizeof(res),0);
  res[0] := s[0];
  for i := 1 to byte(s[0]) do
    begin
      if s[i] in['А'..'п'] then
        byte(res[i]) := byte(s[i]) - 64;
      if s[i] in['р'..'я'] then
        byte(res[i]) := byte(s[i]) - 16;
      if s[i] = 'Ё' then byte(res[i]) := 240;
      if s[i] = 'ё' then byte(res[i]) := 241;
    end;
  result := res;
end;

…и исправляем нашу программу

 
begin
  WriteLn(ANSI_to_OEM('Привет');
end.

Все заработало…


Часть 2. Turbo(Borland) Pascal. Текстовый режим.

Если вдруг у вас не переключается раскладка клавиатуры, то следует сделать вот то:
1. Жмем «Пуск» -> Выполнить
2. Пишем regedit, жмем Enter
3. Открываем ключ HKLM\SYSTEM\CurrentControlSet\Control\Keyboard Layout\DosKeybCodes
4. Заменяем значение строковой переменной 00000409 с "us" на "ru".
5. Открываем файл C:\Windows\SYSTEM32\autoexec.nt
6. Пишем в нем строчку lh %SystemRoot%\System32\kb16 ru, 866
7. При необходимости можем перезагрузить комп.


Часть 3. Turbo(Borland) Pascal. Графический режим.

В Windows XP нет шрифтов для графического режима. Поэтому их придется взять из Windows 98.
Для начала необходимо достать файл EGA3.cpi. Он входит в состав Windows 98 поэтому найти его не составит проблем. Затем берем из него 1024 байт начиная с адреса FileSize-1024-48. Где FileSize – размер файла. Для этого напишем следующую программу:

 
var
  f:file;
  p:pointer;
begin
  assign(f,'ega3.cpi');
  reset(f,1);
  Seek(f,FileSize(f)-1024-48);
  GetMem(p,1024);
  BlockRead(f,p^,1024);
  close(f);
  assign(f,'font.8x8');
  rewrite(f,1);
  BlockWrite(f,p^,1024);
  close(f);
  FreeMem(p,1024);
end.

В результате у нас на диске появился файл font.8x8. Этим файлом надо перекрыть вектор прерывания 1F. Чтобы это сделать, запускаем программу BinOBJ.exe со следующими параметрами

 
Binobj font.8x8 font font

Теперь у вас на диске появился файл font.obj - это русский шрифт. Для его использования вот небольшой примерчик:

 
uses graph,dos;
 
procedure font; external;
{$L font.obj}
 
var
  gd,gm:integer;
  x,y,i:integer;
 
begin
  gd := VGA;
  gm := VGAHi;
  SetIntVec($1F,@font);
  InitGraph(gd,gm,'E:\BP\BGI');
  x := 0;
  y := 0;
  for i := 1 to 255 do
    begin
      OutTExtXY(x,y,chr(i));
      inc(x,8);
      if x >= GetMaxX-8 then
        begin
          x := 0;
          inc(y,8);
        end;
    end;
  ReadLn;
  CloseGraph;
end.

Заметим, что процедуру SetIntVec надо писать ДО процедуры InitGraph

Часть 4. TMT Pascal. Графический режим.

Ну вот мы и подошли к самому сложному. Да… Для этого я не нашел ни каких изощрений и поэтому решил делать все «в лоб».
Делаем следующее. Пишем редактор шрифтов, который сохраняет их в виде битов. Для работы с битами надо написать две процедуры:

 
function ReadBit(a,n:byte):boolean;
var
  c:byte;
begin
  c := a shl (n-1);             //оставляем бит с номером N
  ReadBit := boolean(c shr 7);  //Передвигоем этот бит в начало и смотрим 0 он или 1
end;
 
procedure WriteBit(var a:byte; n:byte; b:boolean);
var
  c:byte;
begin
  if b then       //Если надо записать 1, то
    begin
      c := 1 shl (8-n);  //Записываем 1 в бит под номером n
      a := a or c;       //Добавляем его к числу
    end
  else           //Если надо записать 0, то
    begin
      c := 255-(1 shl (8-n));  //Записываем 1 во все биты, кроме n
      a := a and c;            //Добавляем все к числу.
    end;
end;

Для начала выводим стандартный шрифт на экран, сканируем его, записываем в файл (в виде битов) открываем файл в редакторе, добавляем русские буквы, затем пишем модуль, для работы с вашими же шрифтами. ВСЕ!!!

Вот я выложил редактор, но он для ТМТ мультитаргет 4. В принципе его легко переделать под 3.90

Сообщение отредактировано: Азат - 11.11.04, 09:43

Прикреплённый файлfont.zip (3.22 Кбайт, скачиваний: 253)

Перепишем чуток функцию:

function ANSI_to_OEM(s:string):string;
var
  i:Byte;
begin
  result[0] := s[0];
  if result[0] <> #0
    Then
      for i := 1 to byte(s[0]) do
      begin
        if s[i] in['А'..'п']
          then
            byte(result[i]) := byte(s[i]) - 64
          else
            if s[i] in['р'..'я']
              then
                byte(result[i]) := byte(s[i]) - 16
              else
                if s[i] = 'Ё'
                  then
                    byte(result[i]) := 240
                  else
                    if s[i] = 'ё'
                      then
                        byte(result[i]) := 241
                      else
                        result[i] := s[i]
      end
end;

Думаю, вполне очевидно, зачем нужны else. Еще добавлена проверка на пустую строку.

To Vesper, уже исправил.
Только не проверял правильность перевода символов, верю Азату.

Или нагляднее:

function ANSI_to_OEM(s:string):string;
var
  i:Byte;
begin
  result[0] := s[0];
  if result[0] <> #0
    Then
      for i := 1 to byte(s[0]) do
        case s[i] of
          'А'..'п':
            byte(result[i]) := byte(s[i]) - 64;
          'р'..'я':
            byte(result[i]) := byte(s[i]) - 16;
          'Ё':
            result[i] := #240;
          'ё':
            result[i] := #241;
          else
            result[i] := s[i]
        end;
end;

Сообщение отредактировано: KiRiK - 11.11.04, 16:24

KiRiK, ай-яй-яй, нельзя писать чего-нибудь в ФАК, если оно не работает
кстати к Азату это тоже относится (ф-я ANSI_to_OEM)

Эта функция у меня прекрасно работает

Азат, она должна быть универсальной у тебя похоже вин2000, и свободная память заполнена нулями, а вот у меня есть вин98, из-за чего в моём тетрисе пришлось воткнуть пару cleardevice'ов. А еще она СОВЕРШЕННО не обрабатывает остальные символы из-за чего и наехал, только поздновато сообразил.

Азат, я скачала твой редактор и хотела попробовать разобраться, но он не компилируется. Нужен модуль Mouse. Я что-то не поняла правильно ?

Для графического режима в любом компиляторе

     SetTextStyle(TriplexFont, HorizDir, 2);
     OutTextXY(GetMaxX div 2, GetMaxY div 2, ANSI_to_OEM('Русский шрифт показывает!'));

Нужны кириллические шрифты, которые можно скачать по ссылке http://pascal.sources.ru/graph/bgirfont.zip (~37 кб)

Поправка: не для всех компиляторов. Также не все шрифты - русские.

Сообщение отредактировано: Romtek - 11.11.04, 08:52

windows XP Professional v.2002 service Pack 1 функция не работает.Есть другой способ решения? Например через пользовательские шрифты? Это обсуждалось где-то на форуме? если да , то отправьте меня туда ... , я не обижусь

Romtek, SansSerifFont по дефолту отсутствует в ТМТ 3.90 там есть только SmallFont, MediumFont, LargeFont

taya, какой паскаль и какая ф-я?
А вообще недавно в ФАКе появилась тема про русские шрифты FAQ

Добавлено 11.11.04, 08:43
Romtek, кстати все три нерусские

taya! Этот Исходник ТОЛЬКО для TMT Pascal Multitarget 4 и без переделки больше нигде не пойдет!

Добавлено 11.11.04, 09:44
ну вот я немного подредактировал свою функцию. Там надо было зафилчарить массив res

Азат, а где у тебя копируются в res все не русско-буквенные сибволы? (привет Vesper'у)
Кстати, а зачем его филлчарить?

(V. hehe )

Сообщение отредактировано: Vesper - 11.11.04, 14:45

У меня tp 7.0. Брожу в форуме, пока не могу найти ответы.Буду стараться , спасибо.