Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms icon

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms


Скачать 17.84 Kb.
НазваниеWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms
Размер17.84 Kb.
ТипДокументы

unit UnDemo;


interface


uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Spin;


type

TFormDemo = class(TForm)

PanPaint: TPanel;

PBPaint: TPaintBox;

Label1: TLabel;

SEWidth: TSpinEdit;

Label2: TLabel;

BClear: TButton;

GroupBox1: TGroupBox;

BChars: TButton;

BNumeric: TButton;

BFont: TButton;

LFont: TLabel;

FD: TFontDialog;

Panel1: TPanel;

PB16x16: TPaintBox;

LBResult: TListBox;

BAnalyze: TButton;

Label3: TLabel;

Label4: TLabel;

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure PBPaintPaint(Sender: TObject);

procedure PBPaintMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

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

Y: Integer);

procedure PBPaintMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure BClearClick(Sender: TObject);

procedure BCharsClick(Sender: TObject);

procedure BFontClick(Sender: TObject);

procedure BNumericClick(Sender: TObject);

procedure BAnalyzeClick(Sender: TObject);

private

Img : TBitmap; // Битмап для рисования и анализа

public

end;


var

FormDemo: TFormDemo;


implementation


{$R *.dfm}


uses Math;


type

TMas16x16 = array [0..15] of array [0..15] of byte; // приведенная матрица распознания 16x16


var

MasSimple16 : array of TMas16x16; // массив шаблонов


//========== процедура генерации приведенной матрицы ===========================

function Create_16x16(Img : TBitmap) : TMas16x16;

type

MasX = PByteArray;

var

MasY : array of MasX; // битмап в памяти как массив (Y x X)

j, i : integer;

xLeft, xRight, yTop, yBottom : integer; // абс. Коорд. образа

ki, kj : integer;

nSymbol : integer; // кол-во значимых пикселей

Percent : double; // процент заполнения

XY : array [0..16] of record x, y : integer end; // относительные координаты анализируемых ячеек

W, H : integer; // ширина и высота образа


begin

SetLength(MasY, Img.Height); // выделяем память под битмап

for j := 0 to Img.Height - 1 do // получаем отображение битмапа в массиве

MasY[j] := Img.ScanLine[j]; // MasY[y - координата][x - координата] = знач пикселя (x,y)


//-------- получение координат границ образа---------------------------------

// здесь и далее предполагается что значение MasY[y][x] = 0 соответствует черному значению пикселя


xLeft := -1; // инициализация

xRight := -1;

yTop := -1;

yBottom := -1;


for j := 0 to Img.Height - 1 do // Top

begin

for i := 0 to Img.Width - 1 do

if MasY[j][i] = 0 then

begin yTop := j; break; end;

if yTop = j then break;

end;


for j := Img.Height - 1 downto 0 do // Bottom

begin

for i := 0 to Img.Width - 1 do

if MasY[j][i] = 0 then

begin yBottom := j + 1; break; end;

if yBottom = j + 1 then break;

end;


for i := 0 to Img.Width - 1 do // Left

begin

for j := 0 to Img.Height - 1 do

if MasY[j][i] = 0 then begin xLeft := i; break; end;

if xLeft = i then break;

end;


for i := Img.Width - 1 downto 0 do // Right

begin

for j := 0 to Img.Height - 1 do

if MasY[j][i] = 0 then begin xRight := i + 1; break; end;

if xRight = i + 1 then break;

end;


//----------------------------------------------------------------------------


if ((yBottom - yTop)*(xRight - xLeft)) = 0 then // если ничего не нарисовано

begin

exit;

end;


//----------------------------------------------------------------------------

// получаем процент заполнения как отношения кол-ва значимых пикселей к общему

// кол-ву пикселей в границах образа

// Percent будет необходим при анализе каждой ячейки а разбитом на 16х16 образе

nSymbol := 0;

for j := yTop to yBottom do

for i := xLeft to xRight do

if MasY[j][i] = 0 then inc(nSymbol);

Percent := nSymbol / ((yBottom - yTop)*(xRight - xLeft));

Percent := 0.99*Percent; //коэф-нт влияет на формирование матрицы 16х16

// > 1 – учитывается меньше значимых пикселей

// < 1 – учитывается больше значимых пикселей

//----------------------------------------------------------------------------


//----------------------------------------------------------------------------

// разбиваем прямоугольник образа на 16 равных частей путем деления сторон на 2

// и получаем относительные координаты каждой ячейки


W := xRight - xLeft;;

XY[0].x := 0;

XY[16].x := W;

XY[8].x := XY[16].x div 2;

XY[4].x := XY[8].x div 2;

XY[2].x := XY[4].x div 2;

XY[1].x := XY[2].x div 2;

XY[3].x := (XY[4].x + XY[2].x) div 2;

XY[6].x := (XY[8].x + XY[4].x) div 2;

XY[5].x := (XY[6].x + XY[4].x) div 2;

XY[7].x := (XY[8].x + XY[6].x) div 2;

XY[12].x := (XY[16].x + XY[8].x) div 2;

XY[10].x := (XY[12].x + XY[8].x) div 2;

XY[14].x := (XY[16].x + XY[12].x) div 2;

XY[9].x := (XY[10].x + XY[8].x) div 2;

XY[11].x := (XY[12].x + XY[10].x) div 2;

XY[13].x := (XY[14].x + XY[12].x) div 2;

XY[15].x := (XY[16].x + XY[14].x) div 2;

H := yBottom - yTop;

XY[0].y := 0;

XY[16].y := H;

XY[8].y := XY[16].y div 2;

XY[4].y := XY[8].y div 2;

XY[2].y := XY[4].y div 2;

XY[1].y := XY[2].y div 2;

XY[3].y := (XY[4].y + XY[2].y) div 2;

XY[6].y := (XY[8].y + XY[4].y) div 2;

XY[5].y := (XY[6].y + XY[4].y) div 2;

XY[7].y := (XY[8].y + XY[6].y) div 2;

XY[12].y := (XY[16].y + XY[8].y) div 2;

XY[10].y := (XY[12].y + XY[8].y) div 2;

XY[14].y := (XY[16].y + XY[12].y) div 2;

XY[9].y := (XY[10].y + XY[8].y) div 2;

XY[11].y := (XY[12].y + XY[10].y) div 2;

XY[13].y := (XY[14].y + XY[12].y) div 2;

XY[15].y := (XY[16].y + XY[14].y) div 2;

//----------------------------------------------------------------------------


//----------------------------------------------------------------------------

//анализируем каждую полученную ячейку а разбитом прямоугольнике образа

// и создаем приведенную матрицу 16x16


for kj := 0 to 15 do

for ki := 0 to 15 do

begin

nSymbol := 0;

for j := yTop + XY[kj].y to yTop + XY[kj+1].y do // пробегаемся по ячейкам

for i := xLeft + XY[ki].x to xLeft + XY[ki+1].x do // в абсолютных координатах

if MasY[j][i] = 0 then inc(nSymbol); // считаем кол-во значимых пикселей

if nSymbol / MAX(1, ((XY[ki+1].x - XY[ki].x) * (XY[kj+1].y - XY[kj].y))) > Percent

then Result[kj][ki] := 1 else Result[kj][ki] := 0; // результат – приведенная матрица 16х16

end;

SetLength(MasY, 0);

end;


//==============================================================================


procedure TFormDemo.FormCreate(Sender: TObject);

begin

Img := TBitmap.Create; // создаем битмап

Img.PixelFormat := pf8bit; // для простоты работы - 1 байт на пиксель

Img.Width := 200; // произвольно

Img.Height := 200; // - // -

PanPaint.DoubleBuffered := true; //

LFont.Caption := 'Name: ' + FD.Font.Name + #13#10 + // инфа о шрифте шаблона

'Size: ' + inttostr(FD.Font.Size);

end;


procedure TFormDemo.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Img.Free; // за собой нужно убрать...

SetLength(MasSimple16, 0); // то же

end;


procedure TFormDemo.PBPaintPaint(Sender: TObject);

begin

PBPaint.Canvas.Draw(0, 0, Img); // рисуем битмап

end;


var

msX, msY : integer; // локальные переменные для рисования

msDown : boolean; // то же


procedure TFormDemo.PBPaintMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

msDown := true; // фиксируем нажатие кнопки

msX := X; // ... и стартовые координаты

msY := Y; //

Img.Canvas.Pen.Width := SEWidth.Value; // устанавливаем толщину линии

end;


procedure TFormDemo.PBPaintMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

begin

if msDown then // если кнопка нажата то ...

with Img.Canvas do

begin

MoveTo(msX, msY); // курсор в начало

LineTo(X, Y); //рисуем

msX := X; // новые координаты

msY := Y; //

end;

PBPaint.Repaint; //обновляем

end;


procedure TFormDemo.PBPaintMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

msDown := false; // фиксируем отжатие клавиши

end;


procedure TFormDemo.BClearClick(Sender: TObject);

begin

with Img.Canvas do // закрашиваем белым прямоугольником

begin

Brush.Color := clWhite;

Pen.Color := Brush.Color;

Rectangle(0,0,Img.Width,Img.Height);

Pen.Color := clBlack; // восстанавливаем карандаш

end;

PBPaint.Repaint;

end;


procedure TFormDemo.BFontClick(Sender: TObject);

begin

if FD.Execute then LFont.Caption := 'Name: ' + FD.Font.Name + #13#10 +

'Size: ' + inttostr(FD.Font.Size);

end;


var

iSymbol : integer; // вспомогательная переменная

// типа шаблонов 1 – буквы 2 – цифры


procedure TFormDemo.BCharsClick(Sender: TObject);

var

i : integer;

begin

iSymbol := 1;

SetLength(MasSimple16, 32*SizeOf(TMas16x16)); // выделяем буквы под память от А до Я

for i := 0 to 31 do

with Img.Canvas do

begin

Brush.Color := clWhite; // очищаем…

Pen.Color := clWhite;

Rectangle(0,0,Img.Width,Img.Height);

Pen.Color := clBlack;

Font.Color := clBlack;

Font.Size := FD.Font.Size;

Font.Style := FD.Font.Style;

Font.Name := FD.Font.Name;

Img.Canvas.TextOut(10, 10, CHR(ORD('À')+i)); // рисуем

MasSimple16[i] := Create_16x16(Img); // создаем шаблон для i-го символа

end;

BClear.Click; // очищаем

MessageBox(handle, 'Ìàòðèöà øàáëîíîâ ñîçäàíà. Íàðèñóéòå îáðàç äëÿ ðàñïîçíàâàíèÿ è íàæìèòå "Àíàëèç".', 'ÎÊ!', MB_OK or MB_ICONInformation);

end;


procedure TFormDemo.BNumericClick(Sender: TObject);

var

i : integer;

begin

iSymbol := 2;

SetLength(MasSimple16, 10*SizeOf(TMas16x16)); // выделяем память под цифры 0-9

for i := 0 to 9 do

with Img.Canvas do

begin

Brush.Color := clWhite;

Pen.Color := clWhite;

Rectangle(0,0,Img.Width,Img.Height);

Pen.Color := clBlack;

Font.Color := clBlack;

Font.Size := FD.Font.Size;

Font.Style := FD.Font.Style;

Font.Name := FD.Font.Name;

Img.Canvas.TextOut(10, 10, CHR(ORD('0')+i));

MasSimple16[i] := Create_16x16(Img);

end;

BClear.Click;

MessageBox(handle, 'Ìàòðèöà øàáëîíîâ ñîçäàíà. Íàðèñóéòå îáðàç äëÿ ðàñïîçíàâàíèÿ è íàæìèòå "Àíàëèç".', 'ÎÊ!', MB_OK or MB_ICONInformation);

end;


procedure TFormDemo.BAnalyzeClick(Sender: TObject);

var

k,i,j, ki, kj : integer;

Mas, // 16х16 итоговая приведенная матрица

MasChar : TMas16x16; // 16х16 приведенная матрица рисованного образа

Res : array [0..31] of byte; // массив «весов» для каждого символа

nMax : integer;

iMin : integer;

begin

if Length(MasSimple16) = 0 then begin

MessageBox(handle, 'Ñíà÷àëà íóæíî ñîçäàòü ìàòðèöó øàáëîíîâ!', 'Îøèáêà!', MB_OK or MB_ICONWARNING);

exit;

end;


MasChar := Create_16x16(Img); // получаем 16х16 приведенную матрицу рисованного образа

PB16x16.Repaint; // типа очистка


with PB16x16.Canvas do

for kj := 0 to 15 do

for ki := 0 to 15 do

begin

Brush.Color := clRed;

if MasChar[kj][ki] = 1 then Brush.Style := bsSolid else Brush.Style := bsClear;

Rectangle(ki * 7, kj * 7, ki * 7 + 7, kj * 7 + 7);

end;

for k := 0 to 31 do // получаем 16х16 итоговую приведенную матрицу для каждого символа

begin // xor – перемножением шаблона с рисованным образом

for j := 0 to 15 do

for i := 0 to 15 do

Mas[j][i] := MasChar[j][i] xor MasSimple16[k][j][i];

Res[k] := 0;

for j := 0 to 15 do

for i := 0 to 15 do

Res[k] := Res[k] + Mas[j][i]; // вычисляем кол-во несовпадений для каждого символа

end;

LBResult.Clear;

if iSymbol = 1 then // производим сортировку для букв

for i := 0 to 31 do

begin

nMax := 255;

iMin := 0;

for k := 0 to 31 do

if Res[k] < nMax then

begin

iMin := k;

nMax := Res[k];

end;

// результат выводим в виде процента совпадений

LBResult.Items.Add(CHR(ORD('À') + iMin) + ' ' + inttostr(round(100*(1 - Res[iMin] / 256)))+'%');

Res[iMin] := 255;

end

else

if iSymbol = 2 then // так же для цифр

for i := 0 to 9 do

begin

nMax := 255;

iMin := 0;

for k := 0 to 9 do

if Res[k] < nMax then

begin

iMin := k;

nMax := Res[k];

end;

LBResult.Items.Add(CHR(ORD('0') + iMin) + ' ' + inttostr(round(100*(1 - Res[iMin] / 256)))+'%');

Res[iMin] := 255;

end;


end;


end.

Похожие:

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconОперационные системы WINDOWS 95 и WINDOWS 98
Концепция, заложенная в основу Windows 95, полностью сохранена в Windows 98. Графический интерфейс также изменился незначительно....
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconWindows 7 Windows 7
Сервер коллегой Windows 7,Windows Server 2008 R2, была выпущена в то же время. Windows 7 сменяется Windows 8, которая была выпущена...
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconУказатель на структуру типа wsadata, в которую будут записаны сведения о конкретной реализации интерфейса Windows Sockets. В случае успеха функция
В процессе инициализации приложение должно зарегистрировать себя в библиотеке wsock32. Dll, которая предоставляет приложениям интерфейс...
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconПримерный перечень вопросов для зачета по Операционным системам
Основы работы в Windows; работа с мышью; клавиатура; элементы интерфейса; Windows; завершение работы с Windows; перетаскивание и...
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconУстановка Windows 7 на нетбуке с помощью флэш-накопителя usb при наличии установочного диска Windows 7
...
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconAvon predstavitel в списке найденных контактов выберите: Полное имя
Если Вы устанавливаете Skype для Windows, то для работы Skype на Вашем компьютере должна быть установлена операционная система Windows...
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms iconИнструкция пПрошивка телефона, с помощью Flashtool
Драйвера (пользователям Windows 7 x64 нужно перед установкой драйверов выставить в свойствах файла совместимость с Windows Vista...
Вы можете разместить ссылку на наш сайт:
Документы


При копировании материала укажите ссылку ©ignorik.ru 2015

контакты
Документы