unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls ,fann,mamfann; type TForm1 = class(TForm) Image1: TImage; Label1: TLabel; Button1: TButton; Button2: TButton; Memo1: TMemo; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private 宣言 } procedure resetBmp(); procedure createInputs( bm:TBitmap; var inp:array of TFann_type); public { Public 宣言 } md:boolean; pt:TPoint; bmp,bmp2:TBitmap; MamFann: TMamFann; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin resetBmp; end; procedure TForm1.Button2Click(Sender: TObject); type trgb=record b,g,r:byte; end; prgb=^trgb; var mbmp:TBitmap; x,y:integer; xmax,ymax,xmin,ymin:integer; ww,hh:integer; l,t:integer; rgb:prgb; inputs:array[0..31] of TFann_type; outputs:array[0..9] of TFann_type; i:integer; bigbmp:TBitmap; smax:single; num:integer; begin bigbmp:=TBitmap.Create; bigbmp.PixelFormat:=pf24bit; bigbmp.Width:=bmp.Width*3; bigbmp.Height:=bmp.Height*3; bigbmp.Canvas.Brush.Color:=$ffffff; bigbmp.Canvas.Brush.Style:=bsSolid; bigbmp.Canvas.FillRect( Rect(0,0,bigbmp.Width,bigbmp.Height) ); bigbmp.Canvas.CopyMode:=cmSrcCopy; bigbmp.Canvas.Draw(bmp.Width,bmp.Height,bmp); xmax:=-1; ymax:=-1; xmin:=bigbmp.Width-1; ymin:=bigbmp.Height-1; for y := 0 to bigbmp.Height-1 do begin rgb:=bigbmp.ScanLine[y]; for x := 0 to bigbmp.Width-1 do begin if rgb.b<>255 then begin if xmax<x then xmax:=x; if xmin>x then xmin:=x; if ymax<y then ymax:=y; if ymin>y then ymin:=y; end; inc(rgb); end; end; if(xmax=-1) then begin bigbmp.Free; exit;//何も描画していない end; ww:=xmax-xmin+1; hh:=ymax-ymin+1; if ww>hh then hh:=ww else ww:=hh; l:=(xmin+xmax - ww) div 2; t:=(ymin+ymax - hh) div 2; mbmp:=TBitmap.Create; mbmp.PixelFormat:=pf24bit; mbmp.Width:=16; mbmp.Height:=16; mbmp.Canvas.Brush.Color:=$ffffff; mbmp.Canvas.FillRect( Rect(0,0,mbmp.Width,mbmp.Height) ); SetStretchBltMode(mbmp.Canvas.Handle,HALFTONE); StretchBlt( mbmp.Canvas.Handle,0,0,mbmp.Width,mbmp.Height, bigbmp.Canvas.Handle,l,t,ww,hh, SRCCOPY ); createInputs(mbmp,inputs); mbmp.Free; MamFann.Run(inputs,outputs); Memo1.Lines.Clear; smax:=0; num:=0; for i := 0 to length(outputs)-1 do begin Memo1.Lines.Add(Format('%1.1d : %5.3f',[i,outputs[i]])); if outputs[i]>smax then begin smax:=outputs[i]; num:=i; end; end; Label1.Caption:=IntToStr(num)+'を描きましたよね?'; end; procedure TForm1.createInputs(bm: TBitmap; var inp: array of TFann_type); var x,y:integer; sxy:integer; begin for x := 0 to bm.Width-1 do begin sxy:=0; for y := 0 to bm.Height-1 do sxy:=sxy+(bm.Canvas.Pixels[x,y] and $ff); inp[x]:=sxy/(255*bm.Height); end; for y := 0 to bm.Height-1 do begin sxy:=0; for x := 0 to bm.Width-1 do sxy:=sxy+(bm.Canvas.Pixels[x,y] and $ff); inp[y+16]:=sxy/(255*bm.Width); end; end; procedure TForm1.FormCreate(Sender: TObject); var NeuronNumInLayer:array of Cardinal; begin Image1.Width:=256; Image1.Height:=256; md:=False; bmp:=TBitmap.Create; bmp2:=TBitmap.Create; resetBmp; //TMamFannクラスのインスタンス化 if Assigned(MamFann) then FreeAndNil(MamFann); setlength(NeuronNumInLayer,4);//レイヤー(層)の数 NeuronNumInLayer[0]:=32; //入力層のニューロン数 NeuronNumInLayer[1]:=25; //中間層のニューロン数 NeuronNumInLayer[2]:=20; //中間層のニューロン数 NeuronNumInLayer[3]:=10; //出力層のニューロン数 MamFann:=TMamFann.Create(NeuronNumInLayer); MamFann.LoadFromFile('number_train.net'); end; procedure TForm1.FormDestroy(Sender: TObject); begin bmp.Free; bmp2.Free; MamFann.Free; end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if md=False then begin pt.X:=X; pt.Y:=Y; md:=True; end; end; procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if md=True then begin bmp.Canvas.MoveTo(pt.X,pt.Y); bmp.Canvas.LineTo(X,Y); bmp2.Canvas.MoveTo(pt.X,pt.Y); bmp2.Canvas.LineTo(X,Y); Image1.Picture.Bitmap.Assign(bmp2); pt.X:=X; pt.Y:=Y; end; end; procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if md=True then begin bmp.Canvas.MoveTo(pt.X,pt.Y); bmp.Canvas.LineTo(X,Y); bmp2.Canvas.MoveTo(pt.X,pt.Y); bmp2.Canvas.LineTo(X,Y); Image1.Picture.Bitmap.Assign(bmp2); pt.X:=X; pt.Y:=Y; md:=False; end; end; procedure TForm1.resetBmp; begin bmp.Width:=Image1.Width; bmp.Height:=Image1.Height; bmp.PixelFormat:=pf24bit; bmp.Canvas.Brush.Style:=bsSolid; bmp.Canvas.Brush.Color:=$FFFFFF; bmp.Canvas.FillRect(Rect(0,0,bmp.Width,bmp.Height)); bmp.Canvas.Pen.Width:=16; bmp.Canvas.Pen.Style:=psSolid; bmp.Canvas.Pen.Color:=$000000; bmp2.Width:=Image1.Width; bmp2.Height:=Image1.Height; bmp2.PixelFormat:=pf24bit; bmp2.Canvas.Brush.Style:=bsSolid; bmp2.Canvas.Brush.Color:=$FFFFFF; bmp2.Canvas.FillRect(Rect(0,0,bmp2.Width,bmp2.Height)); bmp2.Canvas.Pen.Width:=1; bmp2.Canvas.Pen.Style:=psSolid; bmp2.Canvas.Pen.Color:=$777777; bmp2.Canvas.MoveTo(0,bmp.Height div 2); bmp2.Canvas.LineTo(bmp.Width,bmp.Height div 2); bmp2.Canvas.MoveTo(bmp.Width div 2,0); bmp2.Canvas.LineTo(bmp.Width div 2,bmp.Height); bmp2.Canvas.Pen.Width:=16; bmp2.Canvas.Pen.Style:=psSolid; bmp2.Canvas.Pen.Color:=$000000; Image1.Picture.Bitmap.Assign(bmp2); end; end.