Недавно добавленные исходники

•  TDictionary Custom Sort  3 223

•  Fast Watermark Sources  2 988

•  3D Designer  4 750

•  Sik Screen Capture  3 259

•  Patch Maker  3 466

•  Айболит (remote control)  3 526

•  ListBox Drag & Drop  2 903

•  Доска для игры Реверси  80 753

•  Графические эффекты  3 842

•  Рисование по маске  3 171

•  Перетаскивание изображений  2 544

•  Canvas Drawing  2 671

•  Рисование Луны  2 500

•  Поворот изображения  2 089

•  Рисование стержней  2 119

•  Paint on Shape  1 522

•  Генератор кроссвордов  2 180

•  Головоломка Paletto  1 730

•  Теорема Монжа об окружностях  2 156

•  Пазл Numbrix  1 649

•  Заборы и коммивояжеры  2 016

•  Игра HIP  1 261

•  Игра Go (Го)  1 200

•  Симулятор лифта  1 421

•  Программа укладки плитки  1 176

•  Генератор лабиринта  1 510

•  Проверка числового ввода  1 295

•  HEX View  1 465

•  Физический маятник  1 322

•  Задача коммивояжера  1 356

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Распознавание кодировки. Перекодировка.



Приходит программист к окулисту. Тот его усаживает напротив таблицы, берет указку:
- Читайте!
- "БНОПНЯ"... Доктор, у вас что-то не то с кодировкой!

Алгоритм распознавания кодировки нужен для автоматического декодирования текста. Этот алгоритм основан на том, что некоторые буквы русского алфавита встречается очень часто, а некоторые редко. Поскольку этот способ статистический, то лучше всего он работает с большими текстами.


type
  TCode = (win, koi, iso, dos);

const
  CodeStrings: array [TCode] of string = ('win','koi','iso','dos');

procedure TForm1.Button1Click(Sender: TObject);
var
  str: array [TCode] of string;
  norm: array ['А'..'я'] of single;
  code1, code2: TCode;
  min1, min2: TCode;
  count: array [char] of integer;
  d, min: single;
  s, so: string;
  chars: array [char] of char;
  c: char;
  i: integer;
begin
  so := Memo1.Text;

  norm['А'] := 0.001;
  norm['Б'] := 0;
  norm['В'] := 0.002;
  norm['Г'] := 0;
  norm['Д'] := 0.001;
  norm['Е'] := 0.001;
  norm['Ж'] := 0;
  norm['З'] := 0;
  norm['И'] := 0.001;
  norm['Й'] := 0;
  norm['К'] := 0.001;
  norm['Л'] := 0;
  norm['М'] := 0.001;
  norm['Н'] := 0.001;
  norm['О'] := 0.001;
  norm['П'] := 0.002;
  norm['Р'] := 0.002;
  norm['С'] := 0.001;
  norm['Т'] := 0.001;
  norm['У'] := 0;
  norm['Ф'] := 0;
  norm['Х'] := 0;
  norm['Ц'] := 0;
  norm['Ч'] := 0.001;
  norm['Ш'] := 0.001;
  norm['Щ'] := 0;
  norm['Ъ'] := 0;
  norm['Ы'] := 0;
  norm['Ь'] := 0;
  norm['Э'] := 0.001;
  norm['Ю'] := 0;
  norm['Я'] := 0;
  norm['а'] := 0.057;
  norm['б'] := 0.01;
  norm['в'] := 0.031;
  norm['г'] := 0.011;
  norm['д'] := 0.021;
  norm['е'] := 0.067;
  norm['ж'] := 0.007;
  norm['з'] := 0.013;
  norm['и'] := 0.052;
  norm['й'] := 0.011;
  norm['к'] := 0.023;
  norm['л'] := 0.03;
  norm['м'] := 0.024;
  norm['н'] := 0.043;
  norm['о'] := 0.075;
  norm['п'] := 0.026;
  norm['р'] := 0.038;
  norm['с'] := 0.034;
  norm['т'] := 0.046;
  norm['у'] := 0.016;
  norm['ф'] := 0.001;
  norm['х'] := 0.006;
  norm['ц'] := 0.002;
  norm['ч'] := 0.011;
  norm['ш'] := 0.004;
  norm['щ'] := 0.004;
  norm['ъ'] := 0;
  norm['ы'] := 0.012;
  norm['ь'] := 0.012;
  norm['э'] := 0.003;
  norm['ю'] := 0.005;
  norm['я'] := 0.015;

  Str[win] := 'АаБбВвГгДдЕеЖжЗзИиЙйКкЛлМмНнОоПпРрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯя';
  Str[koi] := 'юЮаАбБцЦдДеЕфФгГхХиИйЙкКлЛмМнНоОпПяЯрРсСтТуУжЖвВьЬыЫзЗшШэЭщЩчЧъЪ';
  Str[iso] := 'РрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯяа№бёвђгѓдєеѕжізїијйљкњлћмќн§оўпџ';
  Str[dos] := 'Ђ ЃЎ‚ўѓЈ"¤…Ґ†¦‡§€Ё‰©ЉЄ‹"ЊЌЋ®ЏЇђа'б'в"г"дoе-ж-зи™йљк›лњмќнћоџпз?и™йљк›лњмќнћоџп';
  for c := #0 to #255 do
    Chars[c] := c;

  min1 := win;
  min2 := win;
  min := 0;
  s := so;
  fillchar(count, sizeof(count), 0);
  for i := 1 to Length(s) do
    inc(count[s[i]]);
  for c := 'А' to 'я' do
    min := min + sqr(count[c] / Length(s) - norm[c]);
  for code1 := low(TCode) to high(TCode) do
  begin
    for code2 := low(TCode) to high(TCode) do
    begin
      if code1 = code2 then
        continue;

      s := so;
      for i := 1 to Length(Str[win]) do
        Chars[Str[code2][i]] := Str[code1][i];
      for i := 1 to Length(s) do
        s[i] := Chars[s[i]];
      fillchar(count, sizeof(count), 0);
      for i := 1 to Length(s) do
        inc(count[s[i]]);
      d := 0;
      for c := 'А' to 'я' do
        d := d + sqr(count[c] / Length(s) - norm[c]);
      if d < min then
      begin
        min1 := code1;
        min2 := code2;
        min := d;
      end;
    end;
  end;

  s := Memo1.Text;
  if min1 <> min2 then
  begin
    for c := #0 to #255 do
      Chars[c] := c;
    for i := 1 to Length(Str[win]) do
      Chars[Str[min2][i]] := Str[min1][i];
    for i := 1 to Length(s) do
      s[i] := Chars[s[i]];
  end;
  Form1.Caption := CodeStrings[min2] + ' ' + CodeStrings[min1];

  Memo2.Text := s;
end;





Похожие по теме исходники

PDL (распознавание номеров)




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте