var
Driver, {код драйвера графического устройства}
Mode, {код графического режима}
TestDriver, {внутренний номер драйвера в таблице BGI}
ErrCode: Integer; {код ошибки}
function TestDetect: Integer; far;
{функция определения параметров графического режима драйвера}
{полный адрес точки входа в функцию, т.е. = сегмент+смещение}
begin
TestDetect := 3; {разрешение экрана 800*600 точек}
end;
begin
TestDriver := InstallUserDriver('svga256', @TestDetect);
{устанавливает новый драйвер в таблицу BGI}
if GraphResult <> grOk then
begin
Writeln('Ошибка при установке драйвера:',
GraphErrorMSG(ErrCode));
Halt(1);
end;
Driver := Detect;{автоматическое определение драйвера-SVGA}
InitGraph(Driver, Mode, '');
{инициализация графического режима;}
{драйвер - в текущем каталоге}
ErrCode := GraphResult;
if ErrCode <> grOk then
begin
Writeln('Ошибка графического режима:',
GraphErrorMSG(ErrCode));
Halt(1);
end;
SetTextStyle(DefaultFont, HorizDir, 1); {текущий шрифт}
OutTextXY(120,20,'Идет инициализация графического режима...');
for x := 0 to 255 do {инициализация палитры grayscale}
SetRGBPalette(x,x,x,x);
OutTextXY(450,20,'Ok.');
end;
Procedure showlist(xn,yn:integer);
{---отображение картинки c масштабированием в 9 раз---}
{xn,yn-начало координат при отображении}
begin
x := 1; {текущие координаты-в начало}
y := 1;
repeat {внешний цикл-по высоте}
for i := -1 to 1 do
for j := -1 to 1 do {текущий пиксель - окном 3*3}
PutPixel((3*x+i)+xn,(3*BiH-3*y+j)+yn,f[x,y]);
x := x + 1; {приращение по x}
if x = BiW then {если с краю...}
begin
x := 1; {...то переходим в следующий ряд}
y := y + 1
end;
until y = BiH; {пока не окажемся в последней строке}
end;
procedure Init_Data; {-----заполнение массивов данных-----}
var t:byte;
begin
assign(file0,path0);
reset(file0);
seek(file0,$436);
for y:=1 to BiH do
for x:=1 to BiW do
begin
read(file0,t); {заполняем массив шаблонов}
f0[x,y]:=t;
end;
for x := 1 to BiW do{заполняем массив для внесения помех}
for y := 1 to BiH do
f[x,y]:=f0[x,y];
end;
Procedure Deranges; {-----------внесение помех-----------}
const u=20; {---уровень помех в % от общего веса символов---}
var count, {количество внесенных помех}
w : integer; {суммарный вес символов}
begin
count := 0;
w:=0;
randomize; {инициализация генератора случайных чисел}
for x := 1 to BiW do {подсчитываем суммарный вес}
for y := 1 to BiH do
if f[x,y] = 0 then w:= w+1;
repeat {------вносим помехи...------}
x := random(BiW); {случайные координаты}
y := random(BiH);
if (x in [3..BiW-2]) and (y in [3..BiH-2]) then
begin
if (f[x,y] = 255) then {если на белом фоне...}
f[x,y] := 1; {...то черная точка}
if (f[x,y] = 0) then {если на черном фоне...}
f[x,y] := 255 {...то белая точка}
end;
count := count + 1; {ув. счетчик помех}
until 100*count >= u * w; {пока не получим данный уровень}
for x := 1 to BiW do {перекрашиваем в 0-й цвет}
for y := 1 to BiH do
if f[x,y] = 1 then
f[x,y] := 0
end;
Procedure Filter; {-----фильтрация изображения от помех-----}
{специальные маски для удаления помех;}
{если при наложении маска совпала с фрагментом изображения,}
{то изменяем соответствующие пиксели}
const mask1:array[1..4,-1..1,-1..1] of byte =
(((1,1,0),(1,0,0),(1,1,0)),
((1,1,1),(1,0,1),(0,0,0)),
((0,1,1),(0,0,1),(0,1,1)),
((0,0,0),(1,0,1),(1,1,1)));
{для удаления помех, "залезших" на символ}
mask2:array[5..12,-2..2,-2..2] of byte =
(((0,0,0,0,0),(0,0,0,0,0),(0,0,1,0,0),(0,1,0,0,0),(0,0,0,0,0)),
((0,0,0,0,0),(0,0,0,0,0),(0,1,1,0,0),(0,0,0,0,0),(0,0,0,0,0)),
((0,0,0,0,0),(0,1,0,0,0),(0,0,1,0,0),(0,0,0,0,0),(0,0,0,0,0)),
((0,0,0,0,0),(0,0,1,0,0),(0,0,1,0,0),(0,0,0,0,0),(0,0,0,0,0)),
((0,0,0,0,0),(0,0,0,1,0),(0,0,1,0,0),(0,0,0,0,0),(0,0,0,0,0)),
((0,0,0,0,0),(0,0,0,0,0),(0,0,1,1,0),(0,0,0,0,0),(0,0,0,0,0)),
((0,0,0,0,0),(0,0,0,0,0),(0,0,1,0,0),(0,0,0,1,0),(0,0,0,0,0)),
((0,0,0,0,0),(0,0,0,0,0),(0,0,1,0,0),(0,0,1,0,0),(0,0,0,0,0)));
{для удаления групп одиночных помех}
mask3:array[13..14,-2..2,-1..1] of byte =
(((1,0,0),(1,0,0),(1,1,0),(1,0,0),(1,0,0)),
((0,0,1),(0,0,1),(0,1,1),(0,0,1),(0,0,1)));
mask4:array[15..16,-1..1,-2..2] of byte =
(((1,1,1,1,1),(0,0,1,0,0),(0,0,0,0,0)),
((0,0,0,0,0),(0,0,1,0,0),(1,1,1,1,1)));
{для удаления помех, "пристроившихся" к символу}
var m,n,l : integer; {вспомогательные счетчики}
flg : boolean; {признак выхода из цикла}
su : array[1..16] of longint; {массив сумм для масок}
begin
for i := 3 to BiW-2 do {внешний цикл по изображению}
for j := 3 to BiH-2 do
begin
l := 0; {если белая точка окружена черными...}
for m:=-1 to 1 do
for n:= -1 to 1 do
l := l + f[i+m,j+n];
if (l = 255) and (f[i,j] = 255) then
f[i,j] := 0; {...то делаем и её черной}
{если черная точуа окружена белыми...}
if (l >= 255*8) and (f[i,j] = 0) then
f[i,j] := 255; {...то делаем и её белой}
{обнуляем суммы для масок}
for l := 1 to 16 do
su[l] := 0;
{суммируем по всем видам масок}
for l := 1 to 4 do
for m:=-1 to 1 do
for n:= -1 to 1 do
su[l] := su[l] + ((not f[i+m,j+n]) xor mask1[l,m,n]) and 1;
for l := 5 to 12 do
for m:=-2 to 2 do
for n:=-2 to 2 do
su[l] := su[l] + ((not f[i+m,j+n]) xor mask2[l,m,n]) and 1;
for l := 13 to 14 do
for m:=-2 to 2 do
for n:=-1 to 1 do
su[l] := su[l] + ((not f[i+m,j+n]) xor mask3[l,m,n]) and 1;
for l := 15 to 16 do
for m:=-1 to 1 do
for n:=-2 to 2 do
su[l] := su[l] + ((not f[i+m,j+n]) xor mask4[l,m,n]) and 1;
{---проверяем по очереди каждый вид масок---}
{для первого вида - зачерняем центральную точку}
l := 0;
flg := false;
repeat
l := l + 1;
if su[l] = 0 then
flg := true;
until (flg) or (l = 4);
if flg then
f[i,j] := 0;
{для второго - делаем белым окно 3*3}
l := 4;
flg := false;
repeat
l := l + 1;
if su[l] = 0 then
flg := true;
until (flg) or (l = 12);
if flg then
for m := -2 to 2 do
for n := -2 to 2 do
f[i+m,j+n] := 255;
{для третьего и четвертого - делаем белой центральную точку}
l := 12;
flg := false;
repeat
l := l + 1;
if su[l] = 0 then
flg := true;
until (flg) or (l = 16);
if flg then
f[i,j] := 255;
end
end;
{-----------минимально описанный прямоугольник----------}
procedure ramka(zx:arr;flagx:boolean);
var
c : integer; {счетчик черных точек}
begin
xmin:=BiW;xmax:=0;ymin:=BiH;ymax:=0;
{начальные значения координат м.о.п.}
c:=0; {начальное значение счетчика}
xt := xt + 1; {сдвигаем текущую координату}
repeat {цикл увеличения xt по картинке...}
xt := xt + 1;
for y := 3 to BiH-2 do {просмотр по высоте}
if zx[xt,y] = 0 then
c:= c+1;
until (c <> 0) or (xt > BiW - 6);
{...пока не встретим черную точку}
c:= 0; {начальное значение счетчика}
repeat {цикл по символу...}
c := 0;
for y := 3 to BiH - 2 do {просмотр по высоте}
if zx[xt,y] = 0 then {если черная точка...}
begin
c:=c+1; {...то ув. счетчик}
if xt < xmin then xmin := xt; {изм.коорд.м.о.п.}
if xt > xmax then xmax := xt;
if y < ymin then ymin := y;
if y > ymax then ymax := y
end;
if xt <> 0 then xt := xt + 1; {ув. текущий x}
until (c=0) or (xt > BiW - 2);{...пока не дойдем до белого}
if flagx then {если признак...}
begin {...то рисуем рамку;100-цвет}
for x:=xmin-1 to xmax+1 do f[x,ymin-1]:=100;
for x:=xmin-1 to xmax+1 do f[x,ymax+1]:=100;
for y:=ymin-1 to ymax+1 do f[xmin-1,y]:=100;
for y:=ymin-1 to ymax+1 do f[xmax+1,y]:=100
end
end;
{=====================ОСНОВНОЙ БЛОК=======================}
BEGIN
Init_Graph_Mode;
OutTextXY(120,30,'Идет инициализация данных... ');
Init_Data;
OutTextXY(345,30,'Ok.');
flag := false;
smin:=BiH*BiH; {max возможная площадь символа}
For counter := 1 to 10 do {цикл по шаблонам}
begin {определяем min возможную площадь символа}
Ramka(f0,flag);
if (xmax-xmin)*(ymax-ymin) <= smin then
smin:= (xmax-xmin)*(ymax-ymin)
end;
OutTextXY(300,50,'Исходная строка символов : ');
Deranges;
ShowList(170,70);
Filter;
OutTextXY(270,260,'Строка символов после фильтрации : ');
xt := 2;
ShowList(170,280);
OutTextXY(120,500,'Идет распознавание строки символов : ');
SetTextStyle(DefaultFont, HorizDir, 4);
flag := true; {рисовать рамку}
counter := 0;
Repeat {---цикл по картинке с помехами---}
counter := counter + 1;{текущий символ}
Ramka(f,flag);
{---------Распознавание по корреляции---------}
kfmax:=0; {min возможное значение Kf}
xsav:=xt; {сохраняем текущий x в картинке с помехами}
xm:=xmin; {сохраняем текущие координаты м.о.п.}
xk:=xmax;
ym:=ymin;
yk:=ymax;
xt:=2; {текущий x - в начало картинки с шаблонами}
for k := 1 to 10 do {---цикл по шаблонам---}
begin
Ramka(f0,not flag);
di:=0; {смещение шаблона и символа по x}
dj:=0; {смещение шаблона и символа по y}
max:=0; {min возможное значение текущей Kf}
if (xk-xm >= xmax-xmin) and (yk-ym >= ymax-ymin)
{если шаблон <= текущего символа...}
then {...тогда сравниваем с текущим шаблоном}
repeat
kf:=0; {min возможное значение temp - Kf}
{---цикл по текущему шаблону---}
for i:=xmin to xmax do
for j:=ymin to ymax do
kf := kf +
(f0[i+di,j+dj] * f[i-xmin+xm,j-ymin+ym]) and 1;
if kf > max then max := kf; {локальный max}
di:=di+1; {ув. смещение по x}
if xmax-xmin+di>=xk-xm {если сместили по x}
then {...то смещаем по y}
begin
di:=0;
dj:=dj+1
end;
until (ymax-ymin+dj>=yk-ym);
{...пока не сместим по y}
if max > kfmax {ищем глобальный max...}
then
begin
kfmax:=max;
rasp:=k {...и его номер}
end
end;
xt:=xsav; {восстанавливаем текущий x}
ShowList(170,280);
if (xk-xm)*(yk-ym) >= smin{если допустимая площадь}
then {...то выводим распознанный символ}
OutTextXY(190 + 35*counter,520,stroka[rasp]);
Until xt >= BiW - 15;
ShowList(170,280);
ReadLn;
CloseGraph; {сбрасываем графичесий режим}
END.