fourier/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, FMX.Graphics,
  10   FMX.TabControl, FMX.StdCtrls, System.Actions, FMX.ActnList, FMX.StdActns,
  11   FMX.MediaLibrary.Actions, FMX.Objects, FMX.Controls.Presentation, FMX.Edit,
  12   FMX.Media, Unit2, Math, FMX.ListBox;
  13
  14 type
  15   TForm1 = class(TForm)
  16     StyleBook1: TStyleBook;
  17     ToolbarHolder: TLayout;
  18     ToolbarPopup: TPopup;
  19     ToolbarPopupAnimation: TFloatAnimation;
  20     ToolBar1: TToolBar;
  21     ToolbarApplyButton: TButton;
  22     ToolbarCloseButton: TButton;
  23     ToolbarAddButton: TButton;
  24     TabControl1: TTabControl;
  25     TabItem1: TTabItem;
  26     TabItem2: TTabItem;
  27     TabItem3: TTabItem;
  28     Label1: TLabel;
  29     Label2: TLabel;
  30     Edit1: TEdit;
  31     Edit2: TEdit;
  32     Label3: TLabel;
  33     Edit3: TEdit;
  34     Image1: TImage;
  35     Label4: TLabel;
  36     Edit4: TEdit;
  37     Label5: TLabel;
  38     Button3: TButton;
  39     Label6: TLabel;
  40     Edit5: TEdit;
  41     RadioButton1: TRadioButton;
  42     RadioButton2: TRadioButton;
  43     CameraComponent1: TCameraComponent;
  44     Panel1: TPanel;
  45     SpinEditButton1: TSpinEditButton;
  46     SpinEditButton2: TSpinEditButton;
  47     SpinEditButton3: TSpinEditButton;
  48     GroupBox1: TGroupBox;
  49     Button1: TButton;
  50     Button2: TButton;
  51     Button4: TButton;
  52     Label7: TLabel;
  53     Image2: TImage;
  54     Image3: TImage;
  55     ListBox1: TListBox;
  56     Image4: TImage;
  57     Button5: TButton;
  58     TabItem4: TTabItem;
  59     Button6: TButton;
  60     Button7: TButton;
  61     ListBox2: TListBox;
  62     procedure ToolbarCloseButtonClick(Sender: TObject);
  63     procedure FormGesture(Sender: TObject; const EventInfo: TGestureEventInfo;
  64       var Handled: Boolean);
  65     procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
  66       Shift: TShiftState);
  67     procedure Button1Click(Sender: TObject);
  68     procedure Button2Click(Sender: TObject);
  69     procedure Button4Click(Sender: TObject);
  70     procedure FormCreate(Sender: TObject);
  71     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  72       Shift: TShiftState; X, Y: Single);
  73     procedure FormDestroy(Sender: TObject);
  74     procedure CameraComponent1SampleBufferReady(Sender: TObject;
  75       const ATime: Int64);
  76     procedure Button3Click(Sender: TObject);
  77     procedure Button5Click(Sender: TObject);
  78     procedure Button6Click(Sender: TObject);
  79     procedure Button7Click(Sender: TObject);
  80   private
  81     FGestureOrigin: TPointF;
  82     FGestureInProgress: Boolean;
  83     bmp: TBitmap;
  84     buf, back: TBitmap;
  85     cap: Boolean;
  86     Fourier, recg: TFourier;
  87     thBinary: integer;
  88     { private \90é\8c¾ }
  89     procedure ShowToolbar(AShow: Boolean);
  90     procedure detectImage;
  91     procedure recognition;
  92     function SingleSortS(item1, item2: TFmxObject): integer;
  93     function SingleSortL(item1, item2: TFmxObject): integer;
  94   public
  95     { public \90é\8c¾ }
  96   end;
  97
  98 var
  99   Form1: TForm1;
 100
 101 implementation
 102
 103 {$R *.fmx}
 104
 105 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
 106   Shift: TShiftState);
 107 begin
 108   if Key = vkEscape then
 109     ShowToolbar(not ToolbarPopup.IsOpen);
 110 end;
 111
 112 procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
 113   Shift: TShiftState; X, Y: Single);
 114 begin
 115   if Sender = Image1 then
 116   begin
 117     Fourier.select(X, Y);
 118     Edit4.SetFocus
 119   end
 120   else
 121   begin
 122     recg.select(X, Y);
 123     recognition;
 124   end;
 125 end;
 126
 127 procedure TForm1.recognition;
 128 var
 129   dist: Single;
 130   i: integer;
 131   a, b: array of Single;
 132   estima: array of Single;
 133   n, cnt: integer;
 134   j: integer;
 135 begin
 136   recg.recognition;
 137   SetLength(a, 4 * recg.numDescriptor);
 138   SetLength(b, 4 * recg.numDescriptor);
 139   SetLength(estima, recg.numEntry);
 140   Image3.Canvas.BeginScene;
 141   Image3.Canvas.FillRect(Image3.BoundsRect, 0, 0, [], 1);
 142   Image3.Canvas.DrawRect(Image3.BoundsRect, 0, 0, [], 1);
 143   with recg.bnd do
 144     for i := 0 to Count - 1 do
 145       Image3.Canvas.DrawLine(PointF(X[i - 1], Y[i - 1]), PointF(X[i], Y[i]), 1);
 146   Image3.Canvas.EndScene;
 147   cnt := 0;
 148   for i := 0 to recg.numDescriptor - 1 do
 149     with recg.model[recg.rIndex] do
 150     begin
 151       a[cnt] := coReal1[i];
 152       a[recg.numDescriptor + cnt] := coImag1[i];
 153       a[2 * recg.numDescriptor + cnt] := coReal2[i];
 154       a[3 * recg.numDescriptor + cnt] := coImag2[i];
 155       inc(cnt);
 156     end;
 157   for n := 0 to Fourier.numEntry - 1 do
 158   begin
 159     cnt := 0;
 160     for i := 0 to Fourier.numDescriptor - 1 do
 161     begin
 162       b[cnt] := Fourier.model[n].coImag1[i];
 163       b[recg.numDescriptor + cnt] := Fourier.model[n].coImag1[i];
 164       b[2 * recg.numDescriptor + cnt] := Fourier.model[n].coReal2[i];
 165       b[3 * recg.numDescriptor + cnt] := Fourier.model[n].coImag2[i];
 166       inc(cnt);
 167     end;
 168     if RadioButton1.IsChecked = true then
 169     begin
 170       dist := 0;
 171       for i := 0 to 4 * recg.numDescriptor - 1 do
 172         dist := dist + (a[i] - b[i]) * (a[i] - b[i]);
 173       estima[n] := Sqrt(dist);
 174     end
 175     else
 176       estima[n] := recg.Correlation(a, b, 4 * recg.numDescriptor);
 177   end;
 178   ListBox1.Items.Clear;
 179   for i := 0 to recg.numEntry - 1 do
 180   begin
 181     j := ListBox1.Items.Add('(' + Fourier.model[i].name + ')' +
 182       estima[i].ToString);
 183     ListBox1.ListItems[j].TagFloat := estima[i];
 184   end;
 185   if RadioButton1.IsChecked = true then
 186     ListBox1.Sort(SingleSortS)
 187   else
 188     ListBox1.Sort(SingleSortL);
 189   for i := ListBox1.Items.Count - 1 downto 5 do
 190     ListBox1.Items.Delete(i);
 191   Finalize(a);
 192   Finalize(b);
 193   Finalize(estima);
 194 end;
 195
 196 procedure TForm1.ToolbarCloseButtonClick(Sender: TObject);
 197 begin
 198   Application.Terminate;
 199 end;
 200
 201 procedure TForm1.Button1Click(Sender: TObject);
 202 begin
 203   CameraComponent1.Active := true;
 204   cap := true;
 205 end;
 206
 207 procedure TForm1.Button2Click(Sender: TObject);
 208 begin
 209   CameraComponent1.Active := false;
 210   detectImage;
 211   TabControl1.TabIndex := 0;
 212 end;
 213
 214 procedure TForm1.Button3Click(Sender: TObject);
 215 begin
 216   Fourier.model[Fourier.rIndex].name := Edit4.Text;
 217   Edit4.Text := '';
 218 end;
 219
 220 procedure TForm1.Button4Click(Sender: TObject);
 221 begin
 222   Fourier.numDescriptor := Edit5.Text.ToInteger;
 223   if Fourier.numDescriptor > 50 then
 224   begin
 225     Fourier.numDescriptor := 50;
 226     Edit5.Text := '50';
 227   end;
 228   Fourier.preProcess;
 229   thBinary := Edit3.Text.ToInteger;
 230   recg.minWidth := Edit1.Text.ToInteger;
 231   recg.minHeight := Edit2.Text.ToInteger;
 232   Image4.Bitmap.Assign(back);
 233   recg.BinaryGray(Image4.Bitmap, thBinary, true);
 234   recg.DetectArea(Image4.Bitmap);
 235   recg.numDescriptor := Fourier.numDescriptor;
 236   TabControl1.TabIndex := 2;
 237 end;
 238
 239 procedure TForm1.Button5Click(Sender: TObject);
 240 var
 241   i: integer;
 242 begin
 243   ListBox2.Items.Clear;
 244   for i := 0 to Fourier.numEntry - 1 do
 245     ListBox2.Items.Add(Fourier.model[i].name + ' / ' + i.ToString);
 246 end;
 247
 248 procedure TForm1.Button6Click(Sender: TObject);
 249 begin
 250   Fourier.saveModels('default.fo');
 251 end;
 252
 253 procedure TForm1.Button7Click(Sender: TObject);
 254 begin
 255   Fourier.loadModels('default.fo');
 256   Button5Click(Sender);
 257 end;
 258
 259 procedure TForm1.CameraComponent1SampleBufferReady(Sender: TObject;
 260   const ATime: Int64);
 261 begin
 262   CameraComponent1.SampleBufferToBitmap(Image1.Bitmap, true);
 263 end;
 264
 265 procedure TForm1.detectImage;
 266 begin
 267   if cap = true then
 268   begin
 269     bmp.Assign(Image1.Bitmap);
 270     buf.Assign(bmp);
 271   end
 272   else
 273     bmp.Assign(buf);
 274   cap := false;
 275   buf.Assign(bmp);
 276   thBinary := Edit3.Text.ToInteger;
 277   Fourier.clearModels;
 278   Fourier.minWidth := Edit1.Text.ToInteger;
 279   Fourier.minHeight := Edit2.Text.ToInteger;
 280   Fourier.BinaryGray(bmp, thBinary, true);
 281   Fourier.DetectArea(bmp);
 282   Image1.Bitmap.Assign(bmp);
 283 end;
 284
 285 function TForm1.SingleSortL(item1, item2: TFmxObject): integer;
 286 var
 287   s: Single;
 288 begin
 289   s := TListBoxItem(item1).TagFloat - TListBoxItem(item2).TagFloat;
 290   if s < 0 then
 291     result := 1
 292   else if s > 0 then
 293     result := -1
 294   else
 295     result := 0;
 296 end;
 297
 298 function TForm1.SingleSortS(item1, item2: TFmxObject): integer;
 299 var
 300   s: Single;
 301 begin
 302   s := TListBoxItem(item1).TagFloat - TListBoxItem(item2).TagFloat;
 303   if s > 0 then
 304     result := 1
 305   else if s < 0 then
 306     result := -1
 307   else
 308     result := 0;
 309 end;
 310
 311 procedure TForm1.FormCreate(Sender: TObject);
 312 begin
 313   bmp := TBitmap.Create;
 314   buf := TBitmap.Create;
 315   back := TBitmap.Create;
 316   cap := not Image1.Bitmap.IsEmpty;
 317   Fourier := TFourier.Create;
 318   Fourier.color := TAlphaColors.Blue;
 319   recg := TFourier.Create;
 320   recg.color := TAlphaColors.Red;
 321   back.Assign(Image4.Bitmap);
 322 end;
 323
 324 procedure TForm1.FormDestroy(Sender: TObject);
 325 begin
 326   bmp.Free;
 327   buf.Free;
 328   back.Free;
 329   Fourier.Free;
 330   recg.Free;
 331 end;
 332
 333 procedure TForm1.FormGesture(Sender: TObject;
 334   const EventInfo: TGestureEventInfo; var Handled: Boolean);
 335 var
 336   DX, DY: Single;
 337 begin
 338   if EventInfo.GestureID = igiPan then
 339   begin
 340     if (TInteractiveGestureFlag.gfBegin in EventInfo.Flags) and
 341       ((Sender = ToolbarPopup) or (EventInfo.Location.Y > (ClientHeight - 70)))
 342     then
 343     begin
 344       FGestureOrigin := EventInfo.Location;
 345       FGestureInProgress := true;
 346     end;
 347
 348     if FGestureInProgress and (TInteractiveGestureFlag.gfEnd in EventInfo.Flags)
 349     then
 350     begin
 351       FGestureInProgress := false;
 352       DX := EventInfo.Location.X - FGestureOrigin.X;
 353       DY := EventInfo.Location.Y - FGestureOrigin.Y;
 354       if (Abs(DY) > Abs(DX)) then
 355         ShowToolbar(DY < 0);
 356     end;
 357   end
 358 end;
 359
 360 procedure TForm1.ShowToolbar(AShow: Boolean);
 361 begin
 362   ToolbarPopup.Width := ClientWidth;
 363   ToolbarPopup.PlacementRectangle.Rect :=
 364     TRectF.Create(0, ClientHeight - ToolbarPopup.Height, ClientWidth - 1,
 365     ClientHeight - 1);
 366   ToolbarPopupAnimation.StartValue := ToolbarPopup.Height;
 367   ToolbarPopupAnimation.StopValue := 0;
 368
 369   ToolbarPopup.IsOpen := AShow;
 370 end;
 371
 372 end.