neural/Unit1.pas

   1 unit Unit1;
   2
   3 interface
   4
   5 uses
   6   System.SysUtils, System.Types, System.UITypes, System.Classes,
   7   System.Variants,
   8   FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Ani, FMX.Layouts,
   9   FMX.Gestures,
  10   FMX.StdCtrls, FMX.Media, FMX.Objects, FMX.TabControl, FMX.Graphics, Unit2,
  11   FMX.TextLayout, FMX.ListBox;
  12
  13 type
  14   TForm1 = class(TForm)
  15     ToolbarHolder: TLayout;
  16     ToolbarPopup: TPopup;
  17     ToolbarPopupAnimation: TFloatAnimation;
  18     ToolBar1: TToolBar;
  19     ToolbarApplyButton: TButton;
  20     ToolbarCloseButton: TButton;
  21     ToolbarAddButton: TButton;
  22     TabControl1: TTabControl;
  23     Panel1: TPanel;
  24     TabItem1: TTabItem;
  25     TabItem2: TTabItem;
  26     Image1: TImage;
  27     CameraComponent1: TCameraComponent;
  28     Image2: TImage;
  29     Panel2: TPanel;
  30     Button1: TButton;
  31     Button2: TButton;
  32     SpeedButton1: TSpeedButton;
  33     OpenDialog1: TOpenDialog;
  34     Button3: TButton;
  35     Panel3: TPanel;
  36     Button4: TButton;
  37     ListBox1: TListBox;
  38     ProgressBar1: TProgressBar;
  39     Button5: TButton;
  40     procedure ToolbarCloseButtonClick(Sender: TObject);
  41     procedure FormGesture(Sender: TObject; const EventInfo: TGestureEventInfo;
  42       var Handled: Boolean);
  43     procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
  44       Shift: TShiftState);
  45     procedure CameraComponent1SampleBufferReady(Sender: TObject;
  46       const ATime: Int64);
  47     procedure SpeedButton1Click(Sender: TObject);
  48     procedure Button1Click(Sender: TObject);
  49     procedure FormCreate(Sender: TObject);
  50     procedure FormDestroy(Sender: TObject);
  51     procedure Button3Click(Sender: TObject);
  52     procedure Image1Paint(Sender: TObject; Canvas: TCanvas;
  53       const ARect: TRectF);
  54     procedure Button2Click(Sender: TObject);
  55     procedure Button4Click(Sender: TObject);
  56     procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
  57       Shift: TShiftState; X, Y: Single);
  58     procedure Button5Click(Sender: TObject);
  59   private
  60     FGestureOrigin: TPointF;
  61     FGestureInProgress: Boolean;
  62     obj, recg: TFourier;
  63     buf1, buf2: TBitmap;
  64     { private \90é\8c¾ }
  65     procedure ShowToolbar(AShow: Boolean);
  66   public
  67     { public \90é\8c¾ }
  68   end;
  69
  70 var
  71   Form1: TForm1;
  72
  73 implementation
  74
  75 {$R *.fmx}
  76
  77 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
  78   Shift: TShiftState);
  79 begin
  80   if Key = vkEscape then
  81     ShowToolbar(not ToolbarPopup.IsOpen);
  82 end;
  83
  84 procedure TForm1.Image1Paint(Sender: TObject; Canvas: TCanvas;
  85   const ARect: TRectF);
  86 var
  87   i, j: Integer;
  88   s: TTextLayout;
  89 begin
  90   j := 0;
  91   s := TTextLayoutManager.DefaultTextLayout.Create;
  92   try
  93     for i := 0 to obj.numRect - 1 do
  94     begin
  95       if j > 9 then
  96         dec(j, 10);
  97       s.BeginUpdate;
  98       s.Font.Size := 20;
  99       s.Color := TAlphaColors.Blue;
 100       s.Text := j.ToString;
 101       s.TopLeft := PointF(obj.ar[i].Left, obj.ar[i].Top);
 102       s.EndUpdate;
 103       s.RenderLayout(Canvas);
 104       inc(j);
 105     end;
 106   finally
 107     s.Free;
 108   end;
 109 end;
 110
 111 procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
 112   Shift: TShiftState; X, Y: Single);
 113 begin
 114   recg.select(X,Y);
 115   obj.nn.cadidate:=ListBox1.Items;
 116   obj.nrecg(recg.model[recg.rIndex],recg.boundary[recg.rIndex]);
 117 end;
 118
 119 procedure TForm1.ToolbarCloseButtonClick(Sender: TObject);
 120 begin
 121   Application.Terminate;
 122 end;
 123
 124 procedure TForm1.Button1Click(Sender: TObject);
 125 begin
 126   Image1.Bitmap.Assign(buf1);
 127   obj.minWidth := 2;
 128   obj.minHeight := 5;
 129   obj.Color := TAlphaColors.Red;
 130   obj.BinaryGray(Image1.Bitmap, 77, true);
 131   obj.DetectArea(Image1.Bitmap);
 132   obj.sortingPos;
 133 end;
 134
 135 procedure TForm1.Button2Click(Sender: TObject);
 136 begin
 137   obj.preProcess;
 138   obj.numbers;
 139   obj.nn.learnBP3(5000);
 140 end;
 141
 142 procedure TForm1.Button3Click(Sender: TObject);
 143 begin
 144   if OpenDialog1.Execute = true then
 145   begin
 146     buf1.LoadFromFile(OpenDialog1.FileName);
 147     Image1.Bitmap.Assign(buf1);
 148   end;
 149 end;
 150
 151 procedure TForm1.Button4Click(Sender: TObject);
 152 begin
 153   recg.BinaryGray(Image2.Bitmap,77,true);
 154   recg.DetectArea(Image2.Bitmap);
 155 end;
 156
 157 procedure TForm1.Button5Click(Sender: TObject);
 158 begin
 159   if OpenDialog1.Execute = true then
 160     obj.loadModels(OpenDialog1.FileName);
 161 end;
 162
 163 procedure TForm1.CameraComponent1SampleBufferReady(Sender: TObject;
 164   const ATime: Int64);
 165 var
 166   bmp: TBitmap;
 167 begin
 168   if TabControl1.TabIndex = 0 then
 169     bmp := Image2.Bitmap
 170   else
 171     bmp := Image1.Bitmap;
 172   CameraComponent1.SampleBufferToBitmap(bmp, true);
 173 end;
 174
 175 procedure TForm1.FormCreate(Sender: TObject);
 176 begin
 177   obj := TFourier.Create;
 178   recg := TFourier.Create;
 179   buf1 := TBitmap.Create;
 180   buf2 := TBitmap.Create;
 181   buf1.Assign(Image1.Bitmap);
 182 end;
 183
 184 procedure TForm1.FormDestroy(Sender: TObject);
 185 begin
 186   obj.Free;
 187   recg.Free;
 188   buf1.Free;
 189   buf2.Free;
 190 end;
 191
 192 procedure TForm1.FormGesture(Sender: TObject;
 193   const EventInfo: TGestureEventInfo; var Handled: Boolean);
 194 var
 195   DX, DY: Single;
 196 begin
 197   if EventInfo.GestureID = igiPan then
 198   begin
 199     if (TInteractiveGestureFlag.gfBegin in EventInfo.Flags) and
 200       ((Sender = ToolbarPopup) or (EventInfo.Location.Y > (ClientHeight - 70)))
 201     then
 202     begin
 203       FGestureOrigin := EventInfo.Location;
 204       FGestureInProgress := true;
 205     end;
 206
 207     if FGestureInProgress and (TInteractiveGestureFlag.gfEnd in EventInfo.Flags)
 208     then
 209     begin
 210       FGestureInProgress := False;
 211       DX := EventInfo.Location.X - FGestureOrigin.X;
 212       DY := EventInfo.Location.Y - FGestureOrigin.Y;
 213       if (Abs(DY) > Abs(DX)) then
 214         ShowToolbar(DY < 0);
 215     end;
 216   end
 217 end;
 218
 219 procedure TForm1.ShowToolbar(AShow: Boolean);
 220 begin
 221   ToolbarPopup.Width := ClientWidth;
 222   ToolbarPopup.PlacementRectangle.Rect :=
 223     TRectF.Create(0, ClientHeight - ToolbarPopup.Height, ClientWidth - 1,
 224     ClientHeight - 1);
 225   ToolbarPopupAnimation.StartValue := ToolbarPopup.Height;
 226   ToolbarPopupAnimation.StopValue := 0;
 227
 228   ToolbarPopup.IsOpen := AShow;
 229 end;
 230
 231 procedure TForm1.SpeedButton1Click(Sender: TObject);
 232 begin
 233   CameraComponent1.Active := SpeedButton1.IsPressed;
 234   if SpeedButton1.IsPressed = False then
 235     if TabControl1.TabIndex = 0 then
 236       buf2.Assign(Image2.Bitmap)
 237     else
 238       buf1.Assign(Image1.Bitmap);
 239 end;
 240
 241 end.