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: Single;
  31     dot1, dot2, pan: TPointF;
  32     state: integer;
  33   public
  34     { public \90é\8c¾ }
  35   end;
  36
  37 var
  38   Form1: TForm1;
  39
  40 implementation
  41
  42 {$R *.fmx}
  43
  44 procedure TForm1.Image1Gesture(Sender: TObject;
  45   const EventInfo: TGestureEventInfo; var Handled: Boolean);
  46 var
  47   i, j: Single;
  48   procedure resize_x;
  49   begin
  50     if dot1.X < dot2.X then
  51     begin
  52       dot1.X := dot1.X - i;
  53       dot2.X := dot2.X + i;
  54     end
  55     else
  56     begin
  57       dot1.X := dot1.X + i;
  58       dot2.X := dot2.X - i;
  59     end;
  60   end;
  61   procedure resize_y;
  62   begin
  63     if dot1.Y < dot2.Y then
  64     begin
  65       dot1.Y := dot1.Y - j;
  66       dot2.Y := dot2.Y + j;
  67     end
  68     else
  69     begin
  70       dot1.Y := dot1.Y + i;
  71       dot2.Y := dot2.Y - i;
  72     end;
  73   end;
  74
  75 begin
  76   case EventInfo.GestureID of
  77     igiDoubleTap:
  78       begin
  79         SpeedButton1Click(Sender);
  80         tap := 0;
  81       end;
  82     igiRotate:
  83       with EventInfo do
  84       begin
  85         ang := ang - Angle;
  86         if ang < 0 then
  87           ang := ang + pi;
  88         if ang < pi / 6 then
  89           state := 1
  90         else if ang < pi / 3 then
  91           state := 2
  92         else if ang < 2 * pi / 3 then
  93           state := 3
  94         else if ang < 5 * pi / 6 then
  95           state := 2
  96         else
  97           state := 1
  98       end;
  99     igiZoom:
 100       if tap = 2 then
 101       begin
 102         with EventInfo do
 103         begin
 104           i := (Distance - dis) * cos(Angle) / 2;
 105           j := (Distance - dis) * sin(Angle) / 2;
 106           dis := Distance;
 107         end;
 108         case state of
 109           0:
 110             begin
 111               ang := EventInfo.Angle;
 112               state := 1;
 113             end;
 114           1:
 115             resize_x;
 116           2:
 117             begin
 118               resize_x;
 119               resize_y;
 120             end;
 121           3:
 122             resize_y;
 123         end;
 124         Image1.Repaint;
 125       end;
 126     igiPan:
 127       begin
 128         i := EventInfo.Location.X - pan.X;
 129         j := EventInfo.Location.Y - pan.Y;
 130         pan := EventInfo.Location;
 131         if TInteractiveGestureFlag.gfBegin in EventInfo.Flags then
 132           Exit;
 133         dot1.X := dot1.X + i;
 134         dot2.X := dot2.X + i;
 135         dot1.Y := dot1.Y + j;
 136         dot2.Y := dot2.Y + j;
 137         Image1.Repaint;
 138       end;
 139   end;
 140 end;
 141
 142 procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
 143   Shift: TShiftState; X, Y: Single);
 144 begin
 145 {$IFDEF MSWINDOWS}
 146   Image1Tap(Sender, PointF(X, Y));
 147 {$ENDIF}
 148 end;
 149
 150 procedure TForm1.Image1Paint(Sender: TObject; Canvas: TCanvas;
 151   const ARect: TRectF);
 152 var
 153   s: Single;
 154 begin
 155   case tap of
 156     1:
 157       with Image1.Canvas do
 158       begin
 159         Fill.Color := TAlphaColors.Red;
 160         FillEllipse(RectF(dot1.X - 5, dot1.Y - 5, dot1.X + 5, dot1.Y + 5), 1);
 161         Fill.Color := TAlphaColors.White;
 162         FillEllipse(RectF(dot1.X - 4, dot1.Y - 4, dot1.X + 4, dot1.Y + 4), 1);
 163       end;
 164     2:
 165       with Image1.Canvas do
 166       begin
 167         DrawLine(dot1, dot2, 1);
 168         DrawLine(PointF(dot2.X, dot1.Y), PointF(dot1.X, dot2.Y), 1);
 169         Fill.Color := TAlphaColors.White;
 170         FillRect(RectF(dot1.X, dot1.Y, dot2.X, dot2.Y), 0, 0, [], 0.5);
 171         Fill.Color := TAlphaColors.Green;
 172         FillRect(RectF(dot1.X - 2, dot1.Y - 2, dot1.X + 2, dot1.Y + 2), 0,
 173           0, [], 1);
 174         FillRect(RectF(dot2.X - 2, dot1.Y - 2, dot2.X + 2, dot1.Y + 2), 0,
 175           0, [], 1);
 176         FillRect(RectF(dot1.X - 2, dot2.Y - 2, dot1.X + 2, dot2.Y + 2), 0,
 177           0, [], 1);
 178         FillRect(RectF(dot2.X - 2, dot2.Y - 2, dot2.X + 2, dot2.Y + 2), 0,
 179           0, [], 1);
 180         s := (dot1.X + dot2.X) / 2;
 181         FillRect(RectF(s - 2, dot1.Y - 2, s + 2, dot1.Y + 2), 0, 0, [], 1);
 182         FillRect(RectF(s - 2, dot2.Y - 2, s + 2, dot2.Y + 2), 0, 0, [], 1);
 183         s := (dot1.Y + dot2.Y) / 2;
 184         FillRect(RectF(dot1.X - 2, s - 2, dot1.X + 2, s + 2), 0, 0, [], 1);
 185         FillRect(RectF(dot2.X - 2, s - 2, dot2.X + 2, s + 2), 0, 0, [], 1);
 186         Fill.Color := TAlphaColors.Yellow;
 187         case state of
 188           1:
 189             begin
 190               s := (dot1.Y + dot2.Y) / 2;
 191               FillRect(RectF(dot1.X - 2, s - 2, dot1.X + 2, s + 2), 0,
 192                 0, [], 1);
 193               FillRect(RectF(dot2.X - 2, s - 2, dot2.X + 2, s + 2), 0,
 194                 0, [], 1);
 195             end;
 196           2:
 197             begin
 198               FillRect(RectF(dot1.X - 2, dot1.Y - 2, dot1.X + 2, dot1.Y + 2), 0,
 199                 0, [], 1);
 200               FillRect(RectF(dot1.X - 2, dot2.Y - 2, dot1.X + 2, dot2.Y + 2), 0,
 201                 0, [], 1);
 202               FillRect(RectF(dot2.X - 2, dot1.Y - 2, dot2.X + 2, dot1.Y + 2), 0,
 203                 0, [], 1);
 204               FillRect(RectF(dot2.X - 2, dot2.Y - 2, dot2.X + 2, dot2.Y + 2), 0,
 205                 0, [], 1);
 206             end;
 207           3:
 208             begin
 209               s := (dot1.X + dot2.X) / 2;
 210               FillRect(RectF(s - 2, dot1.Y - 2, s + 2, dot1.Y + 2), 0,
 211                 0, [], 1);
 212               FillRect(RectF(s - 2, dot2.Y - 2, s + 2, dot2.Y + 2), 0,
 213                 0, [], 1);
 214             end;
 215         end;
 216       end;
 217   end;
 218 end;
 219
 220 procedure TForm1.Image1Tap(Sender: TObject; const Point: TPointF);
 221 var
 222   i, j: Single;
 223 begin
 224   case tap of
 225     0:
 226       dot1 := Point;
 227     1:
 228       begin
 229         state := 0;
 230         dot2 := Point;
 231         i := dot1.X - dot2.X;
 232         j := dot1.Y - dot2.Y;
 233         if (i < 20) and (i > -20) and (j < 20) and (j > -20) then
 234         begin
 235           tap := 0;
 236           dot1 := dot2;
 237         end
 238         else
 239           SpeedButton2.Enabled := true;
 240       end
 241   else
 242     tap := 0;
 243     SpeedButton2.Enabled := false;
 244     dot1 := Point;
 245   end;
 246   inc(tap);
 247   Image1.Repaint;
 248 end;
 249
 250 procedure TForm1.SpeedButton1Click(Sender: TObject);
 251 begin;
 252
 253   ;
 254 end;
 255
 256 end.