📄 main.~pas
字号:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, EightArrayFeature, CharFeatureValue, FeatureManage, StdCtrls, ExtDlgs,
ImgList, ComCtrls, ToolWin, Menus, Mask,comobj,activex;
var
Pattern:array [0..9] of NumCharPattern;
pathstring:string;
l:integer=0 ;
EightCode: TDoubleEightArray;
type
TRecogForm = class(TForm)
MouseUpTimer: TTimer;
Panel1: TPanel;
StretchImage: TImage;
InputNumberLabel: TLabel;
FeatureImage: TImage;
FeatureImageLabel: TLabel;
Label2: TLabel;
NumberInputOpenPictureDialog: TOpenPictureDialog;
MainMenu1: TMainMenu;
SaveDialog1: TSaveDialog;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ImageList1: TImageList;
ToolButton4: TToolButton;
Button1: TButton;
Button2: TButton;
NumberIndexEdit: TEdit;
Panel2: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
Panel8: TPanel;
Panel9: TPanel;
Panel10: TPanel;
Panel11: TPanel;
PatternDisplayImage1: TImage;
PatternDisplayImage2: TImage;
PatternDisplayImage3: TImage;
PatternDisplayImage4: TImage;
PatternDisplayImage5: TImage;
PatternDisplayImage6: TImage;
PatternDisplayImage7: TImage;
PatternDisplayImage8: TImage;
PatternDisplayImage9: TImage;
PatternDisplayImage10: TImage;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;
CheckBox8: TCheckBox;
CheckBox9: TCheckBox;
CheckBox10: TCheckBox;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
NumberEdit: TEdit;
Label1: TLabel;
OpenDialog1: TOpenDialog;
SaveCurrentPatternButton: TButton;
help: TMenuItem;
FileMenuItem: TMenuItem;
StudyToolButton: TToolButton;
GroupBox1: TGroupBox;
NumberIndexLabel: TLabel;
GroupBox2: TGroupBox;
RecogToolButton: TToolButton;
GroupBox3: TGroupBox;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
N9: TMenuItem;
N10: TMenuItem;
now1: TMenuItem;
All1: TMenuItem;
N11: TMenuItem;
SaveAllPatternToolButton: TToolButton;
S1: TMenuItem;
L1: TMenuItem;
R1: TMenuItem;
Button3: TButton;
GroupBox4: TGroupBox;
Label3: TLabel;
Label4: TLabel;
Edit1: TEdit;
NumberResultEdit: TEdit;
NumberIndexResultEdit: TEdit;
NumberLabel: TLabel;
ToWordCheckBox: TCheckBox;
Label5: TLabel;
StartIndexDisplayEdit: TEdit;
ReplaceButton: TButton;
IndexDisplayEdit2: TEdit;
IndexDisplayEdit6: TEdit;
IndexDisplayEdit7: TEdit;
IndexDisplayEdit1: TEdit;
IndexDisplayEdit3: TEdit;
IndexDisplayEdit4: TEdit;
IndexDisplayEdit5: TEdit;
IndexDisplayEdit8: TEdit;
IndexDisplayEdit9: TEdit;
IndexDisplayEdit10: TEdit;
IndexDisplayButton: TButton;
procedure StretchImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StretchImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure StretchImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure MouseUpTimerTimer(Sender: TObject); // 对用户输入的数字进行识别
procedure FormDestroy(Sender: TObject);
procedure chuangNum(x:Integer);
procedure setmap( eight: TDoubleEightArray);
procedure showeight(eightmap: TDoubleEightArray);
procedure GetFeatureAndRecog(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ButtonClick(Sender: TObject);
procedure CheckBox5Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure CheckBox4Click(Sender: TObject);
procedure CheckBox3Click(Sender: TObject);
procedure CheckBox10Click(Sender: TObject);
procedure CheckBox9Click(Sender: TObject);
procedure CheckBox8Click(Sender: TObject);
procedure CheckBox7Click(Sender: TObject);
procedure CheckBox6Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure SaveAllPatternButtonClick(Sender: TObject);
procedure SaveCurrentPatternButtonClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure StudyToolButtonClick(Sender: TObject);
procedure RecogToolButtonClick(Sender: TObject);
procedure now1Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure SaveAllPatternToolButtonClick(Sender: TObject);
procedure L1Click(Sender: TObject);
procedure R1Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure IndexDisplayButtonClick(Sender: TObject);
procedure ReplaceButtonClick(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private declarations }
drow: boolean; // 判断鼠标是否处于写字状态
eight: array[1..8, 1..8] of TLabel;
function Get_Most_LRTB: Trect;
public
writetype:boolean;
function GetSubStr(var aString:String;SepChar:String):String;
function GetSubStrNum(aString:String;SepChar:String):integer;
{ Public declarations }
end;
var
RecogForm: TRecogForm;
EightArrayFeature:TEightArrayFeature;
//analysepic: Tanalysepic;
ImageInputStyle:Boolean;
RecogOrStudy:Integer;
FWord,FDoc: Variant;
ClassID:TGUID;
Unknown:IUnknown;
result: idispatch;
implementation
uses about;
{$R *.dfm}
procedure TRecogForm.StretchImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ImageInputStyle=false then
begin
// 鼠标按下，处于写字状态
drow := true;
StretchImage.Canvas.MoveTo(x, y);
MouseUpTimer.Enabled := false;
end;
end;
procedure TRecogForm.StretchImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ImageInputStyle=false then
begin
// 鼠标抬起，写字完成，并打开计时器，准备识别
drow := false;
MouseUpTimer.Enabled := true;
end;
end;
procedure TRecogForm.MouseUpTimerTimer(Sender:Tobject); ///定时的可以不要
Var Wordstr:string;
begin
GetFeatureAndRecog(Sender);
if RecogOrStudy=0 then //系统为数字识别状态
begin //将输入图像进行特征比较和分类
FeatureManage.TFeature.FeatureCompare();
if ToWordCheckBox.Checked=True then
begin //将识别的字符输入到Word开关打开
Classid:=ProgIdToClassid('Word.Application');
//如Word已启动，获得Word服务器对象
IF Succeeded(GetActiveobject(classid,nil,unknown))
then FWord:=GetActiveOleObject('Word.Application')
else //如无Word已启动，就启动Word
begin
FWord:=CreateOleObject('Word.Application');
FWord.visible:= True;//显示Word窗口
FDoc:= FWord.Documents.Add;//打开一个Word新文件
end;
try //在已打开的Word文件中加入一行识别结果
Wordstr:=RecogForm.NumberResultEdit.Text;
FWord.Selection.TypeText(Text :=WordStr);//插入识别数字
FWord.Selection.TypeParagraph;//每一识别结果分行显示
except
on e: Exception do
ShowMessage(e.Message);
end;
end;
end;
end;
////////////////////////////////////////////////
procedure TRecogForm.FormCreate(Sender: TObject);
var
i, j: integer;
begin
RecogOrStudy:=1;//RecogOrStudy=0识别状态 ，RecogOrStudy=1学习状态
drow := false;
self.DoubleBuffered := true;
ImageInputStyle:=false;
FeatureManage.TFeature.Openfile(); //打开模板库文件
//显示8*8特征块图像
for i := 1 to 8 do
for j := 1 to 8 do
begin
eight[i][j] := TLabel.Create(self);
eight[i][j].Parent := self;
eight[i][j].Width := 20;
eight[i][j].Height := 20;
eight[i][j].Left := (i - 1) * 20 + 200;
eight[i][j].Top := j * 20 + 420;
eight[i][j].Color := clRed;
end;
end;
procedure TRecogForm.chuangNum(x:Integer);
begin
NumberEdit.Text:= inttostr(x);
end;
procedure TRecogForm.StretchImageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ImageInputStyle=false then
begin
// 鼠标移动，用画直线的方法画随着鼠标画出数字
if drow then
begin
StretchImage.Canvas.Pen.Width := 6;
StretchImage.Canvas.LineTo(x, y);
end;
end;
end;
////////////////////////////////////////////////////////////////
function TRecogForm.Get_Most_LRTB: TRect;
var //得到图片上的最左、最右、最上、最下的点
i, j: integer;
label FindMostRight, FindMostTop,FindMostBottom, FindInMiddle;
begin
//FindMostLeft： 获得最左边的点
for i := 1 to StretchImage.Width - 1 do
for j := 1 to StretchImage.Height - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Left := i;
goto FindMostRight;
end;
FindMostRight: //获得最右边的点
for i := StretchImage.Width - 1 downto 1 do
for j := 1 to StretchImage.Height - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Right := i;goto FindMostTop;
end;
FindMostTop: // 获得最上面的点
for j := 1 to StretchImage.Height - 1 do
for i := 1 to StretchImage.Width - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Top := j;goto FindMostBottom;
end;
FindMostBottom: //获得最下面的点
for j := StretchImage.Height - 1 downto 1 do
for i := 1 to StretchImage.Width - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Bottom := j;goto FindInMiddle;
end;
FindInMiddle:
i := Result.Right - Result.Left;//得到区域宽度
j := Result.Bottom - Result.Top;//得到区域高度
i := i mod 8; i := i div 2;
if i > 0 then //将边缘对称于矩形的左右部分
begin
Dec(Result.Left, i); Inc(Result.Right, i);
end;
j := j mod 8; j := j div 2;
if j > 0 then //将边缘对称于矩形的上下部分
begin
Dec(Result.Top, i);Inc(Result.Bottom, j);
end;
//对左右部分过小的图片进行加宽处理
i := Result.Right - Result.Left;
if i < 80 then//细长的黑色的字最小宽为80
begin
i := (80 - i) div 2;
Dec(Result.Left, i); Inc(Result.Right, i);
end;
end;
/////////////////////////////////////////
procedure TRecogForm.GetFeatureAndRecog(Sender: TObject);
var
rect_s, rect_d: TRect;
SaveImage: Tbitmap;
Eight: TDoubleEightArray;
x,i: integer;
begin
SaveImage := Tbitmap.Create;
MouseUpTimer.Enabled := False;
// 取得数字图片的位置 rest_d;
Rect_s := Get_Most_LRTB;
Rect_d.Top := 0;
Rect_d.Left := 0;
Rect_d.Right := rect_s.Right - rect_s.Left;
Rect_d.Bottom:= rect_s.Bottom - rect_s.Top;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -