Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=508550 Thu, 11 Nov 2004 15:36:00 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=508550 taya Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=508110 Thu, 11 Nov 2004 10:40:54 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=508110 Азат, а где у тебя копируются в res все не русско-буквенные сибволы? ;) (привет Vesper'у)
Кстати, а зачем его филлчарить?

(V. hehe :))]]> KiRiK Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=508015 Thu, 11 Nov 2004 09:40:43 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=508015
Добавлено
ну вот я немного подредактировал свою функцию. Там надо было зафилчарить массив res]]> Азат Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507952 Thu, 11 Nov 2004 08:38:48 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507952 Romtek, SansSerifFont по дефолту отсутствует в ТМТ 3.90 :( там есть только SmallFont, MediumFont, LargeFont :ph34r:

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

Добавлено
Romtek, кстати все три нерусские :(]]> Vesper Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507910 Thu, 11 Nov 2004 08:09:42 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507910 taya Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507391 Wed, 10 Nov 2004 15:12:15 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507391 Для графического режима в любом компиляторе

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


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

Поправка: не для всех компиляторов. Также не все шрифты - русские.]]> Romtek Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507355 Wed, 10 Nov 2004 14:30:19 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507355 taya Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507217 Wed, 10 Nov 2004 12:29:28 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507217 Азат, она должна быть универсальной :) у тебя похоже вин2000, и свободная память заполнена нулями, а вот у меня есть вин98, из-за чего в моём тетрисе пришлось воткнуть пару cleardevice'ов. А еще она СОВЕРШЕННО не обрабатывает остальные символы :D :ph34r: из-за чего и наехал, только поздновато сообразил.]]> Vesper Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507185 Wed, 10 Nov 2004 12:03:41 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507185 Азат Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507159 Wed, 10 Nov 2004 11:30:40 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507159 KiRiK, ай-яй-яй, нельзя писать чего-нибудь в ФАК, если оно не работает :ph34r:
кстати к Азату это тоже относится (ф-я ANSI_to_OEM)
]]> Vesper Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507093 Wed, 10 Nov 2004 10:23:31 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507093
    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, уже исправил. :whistle:
Только не проверял правильность перевода символов, верю Азату.

Или нагляднее:
    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 Pascal https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507058 Wed, 10 Nov 2004 09:51:50 +0000 Русские шрифты https://forum.sources.ru/index.php?showtopic=72150&view=findpost&p=507058
Часть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(F,@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]]> Азат Pascal