pz (Программная система обработки и анализа изображений), страница 2

Приложение

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

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

Эталонная строка - строка, содержащая в себе все 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) then Pixels[x,y+200] := clRed;}

if (Qx > { DetectRectX}80) and (Qx 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];