Структура базы для хранения эталонных символов

Код символа	Эталонная строка

 

Код символа - однозначно идентифицирует хранимый символ. Так как в базе хранятся эталоны иероглифов, для которых в русском алфавите нет примера начертания, то для замены распознанного символа нужно еще хранить и его эталонное изображение. Но так как целью данной работы является не замена распознанных символов на эталонные, а только соотнесение с эталоном, то для экономии дискового пространства решено хранить не эталонное изображение символа, а только его уникальный код, с помощью которого можно однозначно идентифицировать символ.

Эталонная строка - строка, содержащая в себе все 9 плотностей выделенной области.

 

 

Текст программы

 

{$I CdBase.inc}

{$I CdComp.inc}

unit Main;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, Reg_imag, Menus, Options, CmplSign, DBTables, DB;

 

type

TMainForm = class(TForm)

MainMenu: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

Image: TMultiImage;

N3: TMenuItem;

NFileOpen: TMenuItem;

OpenDialog: TOpenDialog;

NSelect: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

Onemore1: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

DataTable: TTable;

N10: TMenuItem;

DataTableOpis: TStringField;

DataTableID: TFloatField;

procedure N2Click(Sender: TObject);

procedure NFileOpenClick(Sender: TObject);

procedure NSelectClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure N4Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure Onemore1Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure N9Click(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure N10Click(Sender: TObject);

private

DetectRectX, DetectRectY: real; { Угол, под которым выделять линии }

xStart, xEnd, yStart, yEnd: word;

BegSelect: boolean;

procedure DefGradient(var Gx, Gy: real; x,y: word);

procedure SetRect;

procedure DefPlotn;

procedure AfinConvert;

procedure OneMore;

procedure Mandel;

procedure Paporotnik;

function GetDensity: string;

public

{ Public declarations }

end;

 

var

MainForm: TMainForm;

 

implementation

{$R *.DFM}

 

procedure TMainForm.N2Click(Sender: TObject);

begin

Application.Terminate;

end;

 

procedure TMainForm.NFileOpenClick(Sender: TObject);

begin

if OpenDialog.Execute then begin

Image.ImageName:= OpenDialog.FileName;

NSelect.Enabled:= True;

end

else NSelect.Enabled:= False;

end;

 

procedure TMainForm.NSelectClick(Sender: TObject);

var

Result: word;

begin

OptionForm:= nil;

try

OptionForm:= TOptionForm.Create(Self);

with OptionForm do begin

RectXEdit.Text:= FloatToStr(DetectRectX);

RectYEdit.Text:= FloatToStr(DetectRectY);

X1Edit.Text:= IntToStr(xStart);

X2Edit.Text:= IntToStr(xEnd);

Y1Edit.Text:= IntToStr(yStart);

Y2Edit.Text:= IntToStr(yEnd);

Result:= ShowModal;

DetectRectX:= StrToInt(RectXEdit.Text);

DetectRectY:= StrToInt(RectYEdit.Text);

xStart:= StrToInt(X1Edit.Text);

xEnd:= StrToInt(X2Edit.Text);

yStart:= StrToInt(Y1Edit.Text);

yEnd:= StrToInt(Y2Edit.Text);

end; { with }

finally

OptionForm.Free;

end; { try }

if Result = mrOK then SetRect;

end;

 

{ Определение градиентов Gx и Gy в точке [x,y] }

procedure TMainForm.DefGradient(var Gx, Gy: real; x,y: word);

var

a, b, c, d, e, g, h, i: byte;

begin

with Image.Canvas do begin

if Pixels[x-1,y-1] = clBlack then a:= 0

else a:= 1;

if Pixels[x,y-1] = clBlack then b:= 0

else b:= 1;

if Pixels[x+1,y-1] = clBlack then c:= 0

else c:= 1;

if Pixels[x-1,y] = clBlack then d:= 0

else d:= 1;

if Pixels[x+1,y] = clBlack then e:= 0

else e:= 1;

if Pixels[x-1,y+1] = clBlack then g:= 0

else g:= 1;

if Pixels[x,y+1] = clBlack then h:= 0

else h:= 1;

if Pixels[x+1,y+1] = clBlack then i:= 0

else i:= 1;

{ Градиент по X }

Gx:= g + 2*h + i - a - 2*b - c;

if Gx < 0 then Gx:= 0;

if Gx = 0 then Gx:= 0.000001;

{ Градиент по Y }

Gy:= c + 2*e + i - a - 2*d - g;

if Gy < 0 then Gy:= 0;

end; { with Image }

end;

 

procedure TMainForm.SetRect;

var

x, y: word;

Gx, Gy, Qx, Qy: real;

OutF: TextFile;

S1,S2: string;

begin

AssignFile(OutF, 'tangs.000');

Rewrite(OutF);

{ Сканируем все изображение }

with Image.Canvas do begin

for y:= yStart+1 to yEnd-1 do begin

for x:= xStart+1 to xEnd-1 do begin

   DefGradient(Gx,Gy,x,y); { Определить градиент в точке [x,y] }

   {if Gx+Gy > 0 then Pixels[x,y+200]:= clRed;}

 

   Qx:= ArcTan(Gy/Gx);

   Qx:= Round(Qx*180/Pi);

{ Qx:= Round(90*Gx/4);

   Qy:= Round(90*Gy/4);}

   Str(Qx:2:0, S1);

{   Str(Qy:2:0, S2); }

   Write(OutF, S1+{' '+S2+}' | ');

{ if (Q <= -Pi/3) or (Q >= Pi/3) then Pixels[x,y+200]:= clRed;}

   if (Qx > { DetectRectX}80) and (Qx < 100){ and (Q > DetectRect*Pi/180) }then

     Pixels[x,y+200]:= clRed;

end; { for x }

WriteLn(OutF, 'End Line');

end; { for y }

end; { with Image.Canvas }

CloseFile(OutF);

end;

 

 

procedure TMainForm.DefPlotn;

var

i, j, x, y, dx, dy, Range, x1, y1: word;

Count: word;

begin

x:= xStart; y:= yStart;

dx:= Round((xEnd-xStart+1) div 3);

dy:= Round((yEnd-yStart+1) div 3);

x1:= x; y1:= y;

{ Три квадрата по вертикали }

for i:= 1 to 3 do begin

if i = 2 then Range:= (yEnd-yStart+1) - 2*dy

else Range:= dy;

{ Три квадрата по горизонтали }

for j:= 1 to 3 do begin

if j = 2 then Range:= (xEnd-xStart+1) - 2*dx

else Range:= dx;

{ Сканируем внутри квадрата по y }

    for y:= y1 to y1+Range do begin

   { Сканируем внутри квадрата по x }

   for x:= x1 to x1+Range do begin

     { Подсчитываем число не белых пикселов }

     if Image.Canvas.Pixels[x,y] <> clWhite then Inc(Count);

   end; { for x }

end; { for y }

x1:= x1+dx;          { Следующий квадрат по горизонтали }

end; { for j }

y1:= y1+dy;              { Следующий квадрат по вертикали }

end; { for i }

end;

 

procedure TMainForm.FormCreate(Sender: TObject);

begin

OpenDialog.FileName:= 'c:\delphi\mydir\diplom\pict\pict1.bmp';

Image.ImageName:= OpenDialog.FileName;

end;

 

procedure TMainForm.ImageMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

if Button = mbRight then begin

Image.ImageName:= OpenDialog.FileName;

Exit;

end;

BegSelect:= True;

with Image.Canvas do begin

Pen.Mode:= pmXor;

Pen.Color:= clGreen;

Pen.Style:= psDot;

Brush.Style:= bsClear;

xStart:= X; yStart:= Y;

xEnd:= X; yEnd:= Y;

end; { with }

end;

 

procedure TMainForm.ImageMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

BegSelect:= False;

with Image.Canvas do begin

Pen.Mode:= pmCopy;

Pen.Color:= clBlack;

Pen.Style:= psSolid;

Brush.Style:= bsSolid;

end; { with }

end;

 

procedure TMainForm.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if not BegSelect then Exit;

with Image.Canvas do begin

Rectangle(xStart, yStart, xEnd, yEnd);

xEnd:= X; yEnd:= Y;

Rectangle(xStart, yStart, xEnd, yEnd);

end; { with }

end;

 

procedure TMainForm.N4Click(Sender: TObject);

begin

Image.ImageName:= OpenDialog.FileName;

end;

 

 

{ Афинное преобразование }

procedure TMainForm.AfinConvert;

var

dx, dy, Rand: word;

A, B, C, D, E, F: real;

x, y: word;

i: longint;

begin

A:= 0.5; B:= 0.5; E:= 0;

C:= 0.3; D:= 0; F:= 1;

 

dx:= (xEnd-xStart+1) div 2; xEnd:= xStart +2*dx - 1;

dy:= (yEnd-yStart+1) div 2; yEnd:= yStart +2*dy - 1;

 

x:= xStart+dx; y:= yStart+dy;

Randomize;

for i:= 1 to 50000 do begin

Rand:= Random(10);

Case Rand of

0..3: begin

         x:= xStart + 1 + (x-xStart+1) div 2;

      y:= yStart + 1 + (y-yStart+1) div 2;

    end;

4: begin

      x:= xStart + dx + (x-xStart+1) div 2;

      y:= yStart + 1 + (y-yStart+1) div 2;

    end;

5: begin

        x:= xStart + 1 + (x-xStart+1) div 2;

      y:= yStart + dy + (y-yStart+1) div 2;

    end;

6..9: begin

      x:= xStart + dx + (x-xStart+1) div 2;

      y:= yStart + dy + (y-yStart+1) div 2;

    end;

end; { Case }

 

Image.Canvas.Pixels[x,y]:= clBlue;

end; { for i }

end;

 

 

procedure TMainForm.N7Click(Sender: TObject);

begin

AfinConvert;

end;

 

 

procedure TMainForm.OneMore;

var

dx, dy, Rand, Kx, Ky: word;

A, B, C, D, E, F: real;

x, y, K: real;

i: longint;

begin

Kx:= 4; Ky:= 4;

dx:= (xEnd-xStart+1) div Kx; xEnd:= xStart +Kx*dx - 1;

dy:= (yEnd-yStart+1) div Ky; yEnd:= yStart +Ky*dy - 1;

x:= xStart; y:= yStart;

for i:= 1 to 100000 do begin

Rand:= Random(Kx*Ky);

if (Rand = 0) or (Rand = 3) or (Rand = 12) or (Rand = 15) then

Continue;

 

K:= (Rand - Kx*(Rand div Kx)) *dx;

x:= K + xStart + 1 + (x-xStart+1) / Kx;

K:= (Rand div Kx)*dy;

y:= K + yStart + 1 + (y-yStart+1) / Ky;

 

Image.Canvas.Pixels[Round(x),Round(y)]:= clBlue;

end; { for i }

end;

 

 

procedure TMainForm.Onemore1Click(Sender: TObject);

begin

OneMore;

end;

 

 

procedure TMainForm.Mandel;

var

Z, Z0, C: TComplex;

i, x, y: word;

begin

Z0:= TComplex.Create(0,0);

Z:= TComplex.Create(0,0);

C:= TComplex.Create(0,0);

for y:= yStart to yEnd do begin

for x:= xStart to xEnd do begin

C.Assign(x,y);

Z.Mul(Z0);

Z.Plus(C);

if (Z.Re < 2) and (Z.Im < 2) then

   Image.Canvas.Pixels[Z.Re,Z.Im]:= clBlue;

Z.Assign(0,0);

end; { for x }

end; { for y }

C.Free;

Z.Free;

Z0.Free;

end;

 

 

procedure TMainForm.N8Click(Sender: TObject);

begin

Mandel;

end;

 

procedure TMainForm.Paporotnik;

const

A: array[0..3, 0..2, 0..3] of integer =

                           (((0,0,0,0),(0,20,0,0),(0,0,0,0)),

                            ((85,0,0,0),(0,85,11,70),(0,-10,85,0)),

                            ((31,-41,0,0),(10,21,0,21),(0,0,30,0)),

                            ((-29,40,0,0),(10,19,0,56),(0,0,30,0)));

var

b: array[1..15000] of word;

k, n, i: word;

newX, newY, z, x, y: real;

Color: longint;

begin

x:= 0; y:= 0; z:= 0;

Randomize;

for k:= 1 to 15000 do begin

b[k]:= Random(10);

if b[k] > 3 then b[k]:= 1;

end; { for k }

 

i:= 1;

{ b[i]:= 1;}

for i:= 1 to 10000 do begin

newX:= (a[b[i],0,0]*x + a[b[i],0,1]*y + a[b[i],0,2]*z) / 100+

        a[b[i],0,3];

newY:= (a[b[i],1,0]*x + a[b[i],1,1]*y + a[b[i],1,2]*z) / 100+

        a[b[i],1,3];

z:= (a[b[i],2,0]*x + a[b[i],2,1]*y + a[b[i],2,2]*z) / 100+

        a[b[i],2,3];

x:= newX; y:= newY;

Color:= Random(65535);

Color:= Color*100;

Image.Canvas.Pixels[Round(300-x+z), Round(350-y)]:= clGreen;

end; { for k }

end;

 

 

procedure TMainForm.N9Click(Sender: TObject);

begin

Paporotnik;

end;

 

function TMainForm.GetDensity: string;

var

i, j: byte;

LenX, LenY, x, y, xOld, yOld, dx, dy: word;

BlackCnt, TotCnt: word;

P: real;                      { Плотность пикселов в квадранте }

S, S1: string;

begin

{ Определяем плотность в 9 квадрантах }

{ выделенного диапазона }

S:= '';

LenX:= xEnd-xStart+1;

LenY:= yEnd-yStart+1;

xOld:= xStart; yOld:= yStart;

for j:= 1 to 3 do begin

if j = 2 then dy:= LenY-2*Round(LenY/3)

else dy:= Round(LenY/3);

for i:= 1 to 3 do begin

if i = 2 then dx:= LenX-2*Round(LenX/3)

else dx:= Round(LenX/3);

{------------------------------------------------------------------}

BlackCnt:= 0;     { Кол-во черных пикселов в квадранте }

for y:= yOld to yOld+dy-1 do begin

   for x:= xOld to xOld+dx-1 do begin

     if Image.Canvas.Pixels[x,y] <> clWhite then Inc(BlackCnt);

   end; { for x }

end; { for y }

{------------------------------------------------------------------}

TotCnt:= dx*dy;

P:= BlackCnt/TotCnt;  { Плотность пикселов в квадранте }

Str(P:1:3, S1);

S:= S+S1+' ';

xOld:= xOld+dx;

end; { for i }

yOld:= yOld+dy;

end; { for j }

Result:= S;

end; { TMainForm.GetDensity }

 

procedure TMainForm.N5Click(Sender: TObject);

var

S: string;

ID: word;

begin

S:= GetDensity;

ID:= DataTable.RecordCount;

DataTable.AppendRecord([ID+1, S]);

end;

 

procedure TMainForm.N10Click(Sender: TObject);

var

SValue: string[5];

S, DStr1, DStr2, OldS: string;

Value, NewValue: real;

i: byte;

ID: word;

begin

S:= GetDensity;

OldS:= S;

DataTable.First;

Value:= 100;

ID:= 0;

while not DataTable.EOF do begin

NewValue:= 0;

{-----------------------------------------------------------}

for i:= 1 to 9 do begin

  DStr1:= Copy(S, (i-1)*6+1, 5);

  DStr2:= Copy(DataTableOpis.Value, (i-1)*6+1, 5);

  NewValue:= NewValue + Abs(StrToFloat(DStr2)-StrToFloat(DStr1));

end; { for i }

{-----------------------------------------------------------}

if NewValue < Value then begin

Value:= NewValue;

ID:= DataTableID.AsInteger;

end;

DataTable.Next;

end; { while }

ShowMessage(IntToStr(ID));

end;

end.

[1] Известно, что при создании обычными средствами (”руками”) интерфейса пользователя для программ, работающих в графических средах, на это уходит более 80% времени разработки приложения.