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.Graphics, FMX.Dialogs, FMX.StdCtrls,
   9   FMX.Objects, FMX.Gestures;
  10
  11 type
  12   TForm1 = class(TForm)
  13     Image1: TImage;
  14     ToolBar1: TToolBar;
  15     SpeedButton1: TSpeedButton;
  16     OpenDialog1: TOpenDialog;
  17     SpeedButton2: TSpeedButton;
  18     procedure Image1Gesture(Sender: TObject; const EventInfo: TGestureEventInfo;
  19       var Handled: Boolean);
  20     procedure Image1Paint(Sender: TObject; Canvas: TCanvas;
  21       const ARect: TRectF);
  22     procedure Image1Tap(Sender: TObject; const Point: TPointF);
  23     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  24       Shift: TShiftState; X, Y: Single);
  25     procedure SpeedButton1Click(Sender: TObject);
  26   private
  27     { private \90é\8c¾ }
  28     tap: integer;
  29     dis: integer;
  30     ang: Double;
  31     dot1, dot2, pan: TPointF;
  32   public
  33     { public \90é\8c¾ }
  34   end;
  35
  36 var
  37   Form1: TForm1;
  38
  39 implementation
  40
  41 {$R *.fmx}
  42
  43 procedure TForm1.Image1Gesture(Sender: TObject;
  44   const EventInfo: TGestureEventInfo; var Handled: Boolean);
  45 var
  46   i, j: Single;
  47 begin
  48   case EventInfo.GestureID of
  49     igiLongTap:
  50       begin
  51         SpeedButton1Click(Sender);
  52         tap := 0;
  53       end;
  54     igiZoom:
  55       if tap = 2 then
  56       begin
  57         with EventInfo do
  58         begin
  59           i := (Distance - dis) * cos(ang) / 2;
  60           j := (Distance - dis) * sin(ang) / 2;
  61           dis := Distance;
  62           if Flags = [TInteractiveGestureFlag.gfBegin] then
  63           begin
  64             ang := arctan((Location.Y - TapLocation.Y) /
  65               (Location.X - TapLocation.X));
  66             Exit;
  67           end;
  68         end;
  69         if dot1.X < dot2.X then
  70         begin
  71           dot1.X := dot1.X - i;
  72           dot2.X := dot2.X + i;
  73         end
  74         else
  75         begin
  76           dot1.X := dot1.X + i;
  77           dot2.X := dot2.X - i;
  78         end;
  79         if dot1.Y < dot2.Y then
  80         begin
  81           dot1.Y := dot1.Y - j;
  82           dot2.Y := dot2.Y + j;
  83         end
  84         else
  85         begin
  86           dot1.Y := dot1.Y + i;
  87           dot2.Y := dot2.Y - i;
  88         end;
  89         Image1.Repaint;
  90       end;
  91     igiPan:
  92       begin
  93         i := EventInfo.Location.X - pan.X;
  94         j := EventInfo.Location.Y - pan.Y;
  95         pan := EventInfo.Location;
  96         if EventInfo.Flags = [TInteractiveGestureFlag.gfBegin] then
  97           Exit;
  98         dot1.X := dot1.X + i;
  99         dot2.X := dot2.X + i;
 100         dot1.Y := dot1.Y + j;
 101         dot2.Y := dot2.Y + j;
 102         Image1.Repaint;
 103       end;
 104   end;
 105 end;
 106
 107 procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
 108   Shift: TShiftState; X, Y: Single);
 109 begin
 110   // Image1Tap(Sender, PointF(X, Y));
 111 end;
 112
 113 procedure TForm1.Image1Paint(Sender: TObject; Canvas: TCanvas;
 114   const ARect: TRectF);
 115 begin
 116   case tap of
 117     1:
 118       Image1.Canvas.FillEllipse(RectF(dot1.X - 5, dot1.Y - 5, dot1.X + 5,
 119         dot1.Y + 5), 1);
 120     2:
 121       Image1.Canvas.FillRect(RectF(dot1.X, dot1.Y, dot2.X, dot2.Y), 0,
 122         0, [], 0.5);
 123   end;
 124 end;
 125
 126 procedure TForm1.Image1Tap(Sender: TObject; const Point: TPointF);
 127 var
 128   i, j: Single;
 129 begin
 130   case tap of
 131     0:
 132       dot1 := Point;
 133     1:
 134       begin
 135         dot2 := Point;
 136         i := dot1.X - dot2.X;
 137         j := dot1.Y - dot2.Y;
 138         if (i < 20) and (i > -20) and (j < 20) and (j > -20) then
 139         begin
 140           tap := 0;
 141           dot1 := dot2;
 142         end
 143         else
 144           SpeedButton2.Enabled := true;
 145       end
 146   else
 147     tap := 0;
 148     SpeedButton2.Enabled := false;
 149     dot1 := Point;
 150   end;
 151   inc(tap);
 152   Image1.Repaint;
 153 end;
 154
 155 procedure TForm1.SpeedButton1Click(Sender: TObject);
 156 begin;
 157
 158   ;
 159 end;
 160
 161 end.