netunit.pas

用Delphi写的车牌字符各种特征提取实验系统

unit NetUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ExtDlgs, ComCtrls, Buttons;
Type
  D1Array=array of double;
type
  D2Array=array of array of double;
type
  D2Num=array of array of integer;
  D1Num=array of integer;
type
  TNetForm = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label9: TLabel;
    Label8: TLabel;
    trainresult: TLabel;
    repeateNumEdit: TEdit;
    m_eta: TEdit;
    m_a: TEdit;
    m_ex: TEdit;
    m_hn: TEdit;
    target3edit: TEdit;
    target2edit: TEdit;
    target1edit: TEdit;
    target0edit: TEdit;
    n_out0Edit: TEdit;
    n_out1Edit: TEdit;
    n_out2Edit: TEdit;
    n_out3Edit: TEdit;
    target4edit: TEdit;
    n_out4Edit: TEdit;
    TrainButton: TButton;
    Memo3: TMemo;
    ComboBox1: TComboBox;
    GroupBox2: TGroupBox;
    Memo2: TMemo;
    Label6: TLabel;
    RecognizeEdit: TEdit;
    Memo1: TMemo;
    resultlabel: TLabel;
    NormalImage: TImage;
    Button2: TButton;
    Panel2: TPanel;
    Img: TImage;
    Panel3: TPanel;
    charimage: TImage;
    Image1: TImage;
    Button1: TButton;
    NetOpenPictureDialog: TOpenPictureDialog;
    TImage1: TImage;
    BitBtn1: TBitBtn;
    CheckBox1: TCheckBox;
    procedure Button2Click(Sender: TObject);
    procedure TrainButtonClick(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
    { Private declarations }
  public
      RecognizeCharInPicture:Boolean;
   function  Statistic(const rect:Trect;img:TImage): integer;
     //function  Drnd:double;
     function  Dpn1:double;
     function  squash(x:double):double;
     function  alloc_1d_dbl(n:integer):D1Array;
     function alloc_2d_dbl(m, n: integer): D2Array;
     function  code(Sender:Tobject;Img:TImage;num,imagewidth,imageHeight:integer):D2Array;
     function  Rcode(AImg:TImage;imagewidth,imageHeight:integer):D1Array;
     function  r_weight(var w:D2Array;n1,n2:integer;s:TStringList):boolean;
     function  r_num(var n:D1Num;s:TStringList):boolean;  { Public declarations }
      procedure bpnn_initialize{(var seed:integer)};
    procedure bpnn_randomize_weights(var w:D2Array;m,n:integer);
    procedure bpnn_zero_weights(var w:D2Array;m,n:integer);
    procedure bpnn_layerforward(var l1,l2:D1Array;var conn:D2Array;n1,n2:integer);
    procedure bpnn_output_error(var delta,target,output:D1Array;nj:integer);
    procedure bpnn_hidden_error(var delta_h:D1Array;nh:integer;var delta_o:D1Array;
                                no:integer;var who:D2Array; var hidden:D1Array);
    procedure bpnn_adjust_weights(var delta:D1Array;ndelta:integer;var ly:D1Array;
                                nly:integer;var w,oldw:D2Array;eta,momentum:double);
                                  { Public declarations }
   // procedure ShowResult();
    procedure w_weight(var w: D2Array; n1, n2: integer; name: Pchar);
    procedure w_num(n1,n2,n3:integer;name:Pchar);
    procedure BPTrain(Sender:Tobject;var Data_in,Data_out:D2Array;n_in,n_hidden:integer;
                      min_ex,momentum,eta:double;num:integer);
    procedure CodeRecognize(var Data_in:D1Array;
                           n_in,n_hidden,n_out:integer;resultlabel: TLabel);

  //  procedure SelectionSort(var a: array of integer);
    procedure GetRegion(Bmp: TBitmap);
    procedure CreateBmp(Left,Right,Top,Bottom: integer;bmp:TBitmap);
    procedure Zoom;
    procedure TenToTwo(n:integer;Tout:array of integer);
 //   procedure GuiyiHua(Sender:Tobject;bmp:Tbitmap);
  end;
    { Public declarations }
var
  NetForm: TNetForm;
  imgwidth,imgheight:integer;
  Aimgwidth,Aimgheight :integer;
  show1,show2,show3,show4:string;
  nhyschar:string;
  FixterNumber:integer;
  EachLayerNumber,WordInput,WordCenter,NumberInput,NumberCenter,EnglishInput,EnglishCenter:TStringList;
  TextInput,TextCenter:TStringList;
  Datadiv:integer;
implementation

uses MainUnit, PictureViewUnit, ChartUnit, FileListUnit, InformUnit;

{$R *.dfm}
procedure TNetForm.TenToTwo(n:integer;Tout:array of integer);
var
   i,j:Integer;
begin
   if n=32 then n:=31;
   j:=5;
   for i:=1 to 5 do
   begin
      Tout[j]:=n mod 2;
      n:=n div 2; dec(j);
   end;
end;
procedure TNetForm.GetRegion(Bmp: TBitmap);
var
  x,y,top,bottom,left,right:integer;
   p:pbytearray;
begin
  bmp.PixelFormat:=pf24bit;
  top:=bmp.Height;  bottom:=-1;
  left:=bmp.Width;  right:=-1;
  for y:=0 to bmp.Height-1 do
  begin
     p:=bmp.ScanLine[y];
    for x:=0 to bmp.Width-1 do
    begin
      if p[3*x]<>255 then
      begin
        if y<top then top:=y;
        if y>bottom then bottom:=y;
        if x<left then left:=x;
        if x>right then right:=x;
      end;
    end;
  end;
  CreateBmp(Left,Right,Top,Bottom,bmp);
  // l,r+2,t,b+2);
end;

procedure TNetForm.CreateBmp(Left,Right,Top,Bottom: integer;bmp:TBitmap);
var
p,q:pbytearray;
x,y:integer;
bitp:Tbitmap;
begin
  bitp:=TBitmap.Create;
  Image1.Picture:=NIL;
  bitp.Assign(TImage1.Picture.Bitmap);
  bitp.Width:=right-left+1;
  bitp.Height:=bottom-top+1;
  for y:=top to bottom do
  begin
    p:=bmp.ScanLine[y];
    q:=bitp.ScanLine[y-top];
    for x:=left to right do
    begin
      q[3*(x-left)]:=p[3*x];
      q[3*(x-left)+1]:=p[3*x+1];
      q[3*(x-left)+2]:=p[3*x+2];
    end;
 //   ListBox1.Items.Add('   '+IntToStr(y));
  end;
  image1.Picture.Bitmap.Assign(bitp);
  bitp.Free;
  //image1.Picture.Bitmap:=bitp;
end;

procedure TNetForm.Zoom;
var
  Mybmp: TBitmap;
begin
  self.DoubleBuffered := True;
  Mybmp := TBitmap.Create;
  Mybmp.Width := 32;
  Mybmp.Height := 32;
  NormalImage.Width := Mybmp.Width;
  NormalImage.Height := MyBmp.Height;
  SetStretchBltMode(Mybmp.Canvas.Handle, HalfTone);
  Stretchblt(Mybmp.Canvas.Handle, 0, 0, Mybmp.Width,
    Mybmp.Height, image1.Canvas.Handle, 0, 0, image1.Picture.Bitmap.Width,
    image1.Picture.Bitmap.Height,
    SRCCOPY);
  Mybmp.PixelFormat := pf24bit;
  //MyBmp.Assign(newbmp);
  NormalImage.Picture.Bitmap.Assign(MyBmp);
//  showform.ShowModal;
  MyBmp.Free;
end;
//////////////////////////////////////////////////////////////////////////////////
function TNetForm.alloc_1d_dbl(n: integer): D1Array;  //申请一维数组
var
  new1:D1Array;
begin
  setlength(new1,n);
  Result:=new1;
end;

function TNetForm.alloc_2d_dbl(m, n: integer): D2Array; //申请二维数组
var
  new1:D2Array;
  i:integer;
begin
  setlength(new1,m);
  for i:=low(new1) to High(new1) do
  Setlength(new1,n);
  Result:=new1;
end;

procedure TNetForm.bpnn_adjust_weights(var delta: D1Array; ndelta: integer;
  var ly: D1Array; nly: integer; var w, oldw: D2Array; eta, momentum: double);//调整权值
var
  k,j:integer;
  new_dw:double;
begin
  ly[0]:=1.0;
  setlength(delta,ndelta+1);
  setlength(ly,nly+1);
  setlength(oldw,nly+1,ndelta+1);
  setlength(w,nly+1,ndelta+1);
  for j:=1 to ndelta do
  begin
    for k:=0 to nly do
    begin
      new_dw:=((eta*delta[j]*ly[k])+(momentum*oldw[k,j]));
      w[k,j]:=w[k,j]+new_dw;
      oldw[k,j]:=new_dw;
    end;
  end;
end;


procedure TNetForm.bpnn_hidden_error(var delta_h: D1Array; nh: integer;
  var delta_o: D1Array; no: integer; var who: D2Array; var hidden: D1Array);//隐含层误差
var
  j,k:integer;
  h,sum:double;//,errsum:double;
begin
//  errsum:=0.0;
  setlength(delta_h,nh+1);
  setlength(delta_o,no+1);
  setlength(hidden,nh+1);
  setlength(who,nh+1,no+1);
  for j:=1 to nh do
  begin
    h:=hidden[j];
    sum:=0.0;
    for k:=1 to no do
    sum:= sum+delta_o[k]*who[j,k];
    delta_h[j]:=h*(1.0-h)*sum;
  end;

end;
procedure TNetForm.bpnn_initialize;
begin
    Randomize;
end;
procedure TNetForm.bpnn_layerforward(var l1, l2: D1Array; var conn: D2Array; n1,
  n2: integer);//前向传播
var
  sum:double;
  j,k:integer;
begin
  setlength(l1,n1+1);
  setlength(l2,n2+1);
  setlength(conn,n1+1,n2+1);
  l1[0]:=1.0;
  for j:=1 to n2 do
  begin
    sum:=0.0;