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

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

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

Похожие: