📄 geteighteightarray.~pas
字号:
unit GetEightEightArray;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,CharFeatureValue;
type
TEightmap = array [1..8, 1..8] of integer;
type
//得到特征矩阵8*8
TGetEightEightArray = class
private
NotePicture: Tbitmap;
function GetNumberofBlackPoint(const rect: Trect):integer; //计算子区域黑色点的个数
public
procedure SetNotePictureFile(const filename: string); // 从文件中调入图片到手写区域
function GetDoubleEightArray: TDoubleEightArray; // 获得8*8矩阵特征
end;
implementation
{ GetEightEightArray }
// 获得8x8矩阵特征
function TGetEightEightArray.GetDoubleEightArray: TDoubleEightArray;
var // 获得8x8矩阵'0'或'1'特征值
w,h,i,j,MaxBlackNum:integer;
DoubleEight: array [1..8, 1..8] of integer;
Rect: TRect;
begin
if NotePicture <> nil then
begin //使图像区域为8的整数倍
w := NotePicture.Width mod 8;
NotePicture.Width := NotePicture.Width + 8 - w;
w := NotePicture.Width div 8;
h := NotePicture.Height mod 8;
NotePicture.Height := NotePicture.Height + 8 - h;
h := NotePicture.Height div 8;
MaxBlackNum:= 0;
for i := 1 to 8 do //求每个子区域的黑色点并选一最大值
for j := 1 to 8 do
begin//计算每个子区域所占的矩形
Rect.Left := w * (i - 1);
Rect.Top:= h * (j - 1);
Rect.Right := Rect.Left + w - 1;
Rect.Bottom := Rect.Top + h - 1;//调用计算每个子区域的黑色点的个数程序
DoubleEight[i, j] := GetNumberofBlackPoint(Rect);
if DoubleEight[i, j] > MaxBlackNum then
MaxBlackNum := DoubleEight[i, j];
end;
for i := 1 to 8 do
for j := 1 to 8 do
begin //某个子区域的黑色点数与8*8个区域中黑色点最大值之比大20%
if DoubleEight[i, j] /MaxBlackNum > 0.2 then//该点取特征值‘1’
Result[i, j] := 1
else//否则该点取特征值‘0’
Result[i, j] := 0;
end;
end;
end;
// 由文件调图到手写区域
procedure TGetEightEightArray.SetNotePictureFile(const filename: string);
begin
if FileExists(filename) then
begin
if NotePicture = Nil then
NotePicture := Tbitmap.Create;
NotePicture.LoadFromFile(Filename);
end;
end;
///////////////////////////////////////////////////////////////////////////////
function TGetEightEightArray.GetNumberofBlackPoint(const Rect: TRect): integer;
var// 计算每个子区域的黑色点的个数
x, y: integer;
begin
Result := 0;
for x := Rect.Left to Rect.Right do
for y := Rect.Top to Rect.Bottom do
if NotePicture.Canvas.Pixels[x, y] <> clWhite then
Inc(Result);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -