neural/Unit1.pas

   1 unit Unit1;
   2
   3 interface
   4
   5 uses
   6   System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
   7   FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Ani, FMX.Layouts, FMX.Gestures,
   8   FMX.StdCtrls, FMX.Media, FMX.Objects, FMX.TabControl, FMX.Graphics, Unit2;
   9
  10 type
  11   TForm1 = class(TForm)
  12     ToolbarHolder: TLayout;
  13     ToolbarPopup: TPopup;
  14     ToolbarPopupAnimation: TFloatAnimation;
  15     ToolBar1: TToolBar;
  16     ToolbarApplyButton: TButton;
  17     ToolbarCloseButton: TButton;
  18     ToolbarAddButton: TButton;
  19     TabControl1: TTabControl;
  20     Panel1: TPanel;
  21     TabItem1: TTabItem;
  22     TabItem2: TTabItem;
  23     Image1: TImage;
  24     CameraComponent1: TCameraComponent;
  25     Image2: TImage;
  26     Panel2: TPanel;
  27     Button1: TButton;
  28     Button2: TButton;
  29     SpeedButton1: TSpeedButton;
  30     OpenDialog1: TOpenDialog;
  31     Button3: TButton;
  32     procedure ToolbarCloseButtonClick(Sender: TObject);
  33     procedure FormGesture(Sender: TObject;
  34       const EventInfo: TGestureEventInfo; var Handled: Boolean);
  35     procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
  36       Shift: TShiftState);
  37     procedure CameraComponent1SampleBufferReady(Sender: TObject;
  38       const ATime: Int64);
  39     procedure SpeedButton1Click(Sender: TObject);
  40     procedure Button1Click(Sender: TObject);
  41     procedure FormCreate(Sender: TObject);
  42     procedure FormDestroy(Sender: TObject);
  43     procedure Button3Click(Sender: TObject);
  44     procedure Image1Paint(Sender: TObject; Canvas: TCanvas;
  45       const ARect: TRectF);
  46   private
  47     FGestureOrigin: TPointF;
  48     FGestureInProgress: Boolean;
  49     obj: TFourier;
  50     buf1, buf2: TBitmap;
  51     { private \90é\8c¾ }
  52     procedure ShowToolbar(AShow: Boolean);
  53   public
  54     { public \90é\8c¾ }
  55   end;
  56
  57 var
  58   Form1: TForm1;
  59
  60 implementation
  61
  62 {$R *.fmx}
  63
  64 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  65   var KeyChar: Char; Shift: TShiftState);
  66 begin
  67   if Key = vkEscape then
  68     ShowToolbar(not ToolbarPopup.IsOpen);
  69 end;
  70
  71 procedure TForm1.Image1Paint(Sender: TObject; Canvas: TCanvas;
  72   const ARect: TRectF);
  73 var
  74   i: Integer;
  75 begin
  76   for i := 0 to obj.numRect-1 do
  77     Image1.Bitmap.Canvas
  78 end;
  79
  80 procedure TForm1.ToolbarCloseButtonClick(Sender: TObject);
  81 begin
  82   Application.Terminate;
  83 end;
  84
  85 procedure TForm1.Button1Click(Sender: TObject);
  86 begin
  87   Image1.Bitmap.Assign(buf1);
  88   obj.minWidth:=2;
  89   obj.minHeight:=5;
  90   obj.color:=TAlphaColors.Red;
  91   obj.BinaryGray(Image1.Bitmap,77,true);
  92   obj.DetectArea(Image1.Bitmap);
  93   obj.sortingPos;
  94 end;
  95
  96 procedure TForm1.Button3Click(Sender: TObject);
  97 begin
  98   if OpenDialog1.Execute = true then
  99   begin
 100     buf1.LoadFromFile(OpenDialog1.FileName);
 101     Image1.Bitmap.Assign(buf1);
 102   end;
 103 end;
 104
 105 procedure TForm1.CameraComponent1SampleBufferReady(Sender: TObject;
 106   const ATime: Int64);
 107 var
 108   bmp: TBitmap;
 109 begin
 110   if TabControl1.TabIndex = 0 then
 111     bmp:=Image2.Bitmap
 112   else
 113     bmp:=Image1.Bitmap;
 114   CameraComponent1.SampleBufferToBitmap(bmp,true);
 115 end;
 116
 117 procedure TForm1.FormCreate(Sender: TObject);
 118 begin
 119   obj:=TFourier.Create;
 120   buf1:=TBitmap.Create;
 121   buf2:=TBitmap.Create;
 122   buf1.Assign(Image1.Bitmap);
 123 end;
 124
 125 procedure TForm1.FormDestroy(Sender: TObject);
 126 begin
 127   obj.Free;
 128   buf1.Free;
 129   buf2.Free;
 130 end;
 131
 132 procedure TForm1.FormGesture(Sender: TObject;
 133   const EventInfo: TGestureEventInfo; var Handled: Boolean);
 134 var
 135   DX, DY : Single;
 136 begin
 137   if EventInfo.GestureID = igiPan then
 138   begin
 139     if (TInteractiveGestureFlag.gfBegin in EventInfo.Flags)
 140       and ((Sender = ToolbarPopup)
 141         or (EventInfo.Location.Y > (ClientHeight - 70))) then
 142     begin
 143       FGestureOrigin := EventInfo.Location;
 144       FGestureInProgress := True;
 145     end;
 146
 147     if FGestureInProgress and (TInteractiveGestureFlag.gfEnd in EventInfo.Flags) then
 148     begin
 149       FGestureInProgress := False;
 150       DX := EventInfo.Location.X - FGestureOrigin.X;
 151       DY := EventInfo.Location.Y - FGestureOrigin.Y;
 152       if (Abs(DY) > Abs(DX)) then
 153         ShowToolbar(DY < 0);
 154     end;
 155   end
 156 end;
 157
 158 procedure TForm1.ShowToolbar(AShow: Boolean);
 159 begin
 160   ToolbarPopup.Width := ClientWidth;
 161   ToolbarPopup.PlacementRectangle.Rect := TRectF.Create(0, ClientHeight-ToolbarPopup.Height, ClientWidth-1, ClientHeight-1);
 162   ToolbarPopupAnimation.StartValue := ToolbarPopup.Height;
 163   ToolbarPopupAnimation.StopValue := 0;
 164
 165   ToolbarPopup.IsOpen := AShow;
 166 end;
 167
 168 procedure TForm1.SpeedButton1Click(Sender: TObject);
 169 begin
 170   CameraComponent1.Active:=SpeedButton1.IsPressed;
 171   if SpeedButton1.IsPressed = false then
 172     if TabControl1.TabIndex = 0 then
 173       buf2.Assign(Image2.Bitmap)
 174     else
 175       buf1.Assign(Image1.Bitmap);
 176 end;
 177
 178 end.