Тот файл, который был открыт открывается снова и все линии появившиеся в процессе работы удаляются.
. Определить плотность ( учеба ) Этот пункт меню предназначен для обучения системы. В окне должен находится эталонный текст. С помощью “мышки” выделяется нужный символ и выбирается данный пункт. Вслед за этим пользователю предоставляется возможность указать уникальный код для выбранного символа. Определенная плотность и код записываются в базу данных.
. Распознать
Этот пункт противоположен предыдущему. С помощью “мышки” выделяется нужный символ и выбирается данный пункт. Происходит определение плотности выбранного символа и далее в базе осуществляется поиск записи, у которой поле с эталонной строкой более сходно с плотностью выделенного символа.
Сравнение происходит следующим образом:
Определяется и складываются между собой разности между плотностями эталонного и выделенного символами для каждого квадрата. Тот эталонный символ, у которого полученная сумма окажется наименьшей считается эквивалентом для выделенного. 1) Преобразования
Эти преобразования являются экспериментальными и не являются целью поставленной задачи. Полученные результаты при более глубоком исследовании могут быть в дальнейшем использованы для обработки изображений.
. Афинное преобразование
. Узоры
Эти два пункта строят изображение пользуясь афинными преобразованиями с различными коэффициентами. В зависимости от этих коэффициентов изображения получаются различными.
. Лист папоротника
Опять же основываясь на афинных преобразованиях строится лист папоротника. Данное преобразование имеет огромное практическое значение, так как относительно сложное изображение ( лист папоротника ) строится с помощью одной формулы. 1) Выход Выход из программы.
Приложение
Структура базы для хранения эталонных символов
|Код символа |Эталонная строка | | | |
Код символа - однозначно идентифицирует хранимый символ. Так как в базе хранятся эталоны иероглифов, для которых в русском алфавите нет примера начертания, то для замены распознанного символа нужно еще хранить и его эталонное изображение. Но так как целью данной работы является не замена распознанных символов на эталонные, а только соотнесение с эталоном, то для экономии дискового пространства решено хранить не эталонное изображение символа, а только его уникальный код, с помощью которого можно однозначно идентифицировать символ.
Эталонная строка - строка, содержащая в себе все 9 плотностей выделенной области.
[pic]
Текст программы
{$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 < 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:delphimydirdiplompictpict1.bmp'; Image.ImageName := OpenDialog.FileName; end;
procedure TMainForm.ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbRight then begin
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% времени разработки приложения.
Страницы: 1, 2
