盒子论坛 v2.1

unit uView.FormMain;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Memo.Types,
  FMX.Controls.Presentation,
  FMX.ScrollBox,
  FMX.Memo,
  FMX.Ani,
  FMX.Objects,
  FMX.StdCtrls,
  FMX.Layouts,
  FMX.ListBox;

type
  TForm1 = class(TForm)
    CcShip: TCircle;
    PathAnimation1: TPathAnimation;
    Btn_Start_Animation: TButton;
    Btn_Stop_Animation: TButton;
    RctgShipWingCenter: TRectangle;
    LstBxInterpolation: TListBox;
    LbInterpolation: TLabel;
    PnlUniverse: TPanel;
    Btn_Clear_Points: TButton;
    Memo1: TMemo;
    ChkBxAnimationAutoReverse: TCheckBox;
    ChkBxAnimationLoop: TCheckBox;
    ChkBxAnimationInverse: TCheckBox;
    ChkBxAnimationRotate: TCheckBox;
    LstBxAnimationType: TListBox;
    RctgShipWingDown: TRectangle;
    RctgShipWingUp: TRectangle;
    Image1: TImage;
    TrcBrAnimationDuration: TTrackBar;
    LbAnimationDuration: TLabel;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Btn_Start_AnimationClick(Sender: TObject);
    procedure Btn_Stop_AnimationClick(Sender: TObject);
    procedure PnlUniverseMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure PnlUniverseMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure Btn_Clear_PointsClick(Sender: TObject);
    procedure PathAnimation1Process(Sender: TObject);
    procedure PathAnimation1Finish(Sender: TObject);
    procedure TrcBrAnimationDurationChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

const
  MyBackgroundImagePath: string = '..\..\pictures\vialactea.jpg';

var
  MyPathData          : TPathData;
  MyPathDataToPaint   : TPathData;
  MyMouseDownPoint    : TPointF;
  MyPointTargetTopLeft: TPointF;
  MyPointTargetCenter : TPointF;
  MyStrokeBrush       : TStrokeBrush;
  MyAnimationRunning  : boolean = false;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyPathData          := TPathData.Create;
  MyPathDataToPaint       := TPathData.Create;
  MyStrokeBrush          := TStrokeBrush.Create(TBrushKind.Solid, TAlphaColorRec.Yellow);
  MyStrokeBrush.Thickness := 2;
  MyStrokeBrush.Cap       := TStrokeCap.Round;
  MyStrokeBrush.Dash      := TStrokeDash.Solid;
  MyStrokeBrush.Kind      := TBrushKind.Solid;
  //
  MyPointTargetTopLeft := PnlUniverse.BoundsRect.TopLeft;
  MyPointTargetCenter  := PnlUniverse.BoundsRect.CenterPoint - PointF(PnlUniverse.Position.X, PnlUniverse.Position.Y);
  //
  LstBxInterpolation.ItemIndex := 0;
  LstBxAnimationType.ItemIndex := 0;
  //
  LbAnimationDuration.Text := Format('Duration: +/- %.3f ms', [TrcBrAnimationDuration.Value]);
  //
  try
    Image1.MultiResBitmap.Add.Bitmap.LoadFromFile(MyBackgroundImagePath);
  except
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyStrokeBrush.Free;
  MyPathDataToPaint.Free;
  MyPathData.Free;
end;

procedure TForm1.PathAnimation1Finish(Sender: TObject);
begin
  MyAnimationRunning    := false;
  CcShip.Position.Point := MyMouseDownPoint;
  PathAnimation1.Path.MoveTo(PointF(0, 0));
  //
  Btn_Stop_AnimationClick(Self);
end;

procedure TForm1.PathAnimation1Process(Sender: TObject);
begin
  MyAnimationRunning := true;
end;

procedure TForm1.PnlUniverseMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  PathAnimation1.Stop;
  //
  MyPathData.Clear;
  MyPathDataToPaint.Clear;
  PnlUniverse.Repaint;
  //
  MyPointTargetTopLeft := PnlUniverse.BoundsRect.TopLeft;
  MyPointTargetCenter  := PnlUniverse.BoundsRect.CenterPoint - PointF(PnlUniverse.Position.X, PnlUniverse.Position.Y);
  //
  MyMouseDownPoint := PointF(X, Y);
  //
  CcShip.Position.Point := MyMouseDownPoint;
  PathAnimation1.Path.MoveTo(PointF(0, 0));
end;

procedure TForm1.PnlUniverseMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
var
  P1, P2: TPointF;
begin
  //
  // WARNING: this event is called all time that mouse move on screen... non-stop!
  //
  Caption := Format('X: %.2f, Y: %.2f', [X, Y]);
  //
  if (Shift = [ssCtrl, ssLeft]) and not(MyAnimationRunning) then
  begin
    MyPathDataToPaint.LineTo((PointF(X, Y) + MyPointTargetTopLeft)); // add points to Canvas Paint...
    //
    MyPathData.LineTo((PointF(X, Y) - MyMouseDownPoint)); // add points to PathAnimation...
    //
    if PnlUniverse.Canvas.BeginScene then
      try
        P1 := MyPointTargetTopLeft + MyMouseDownPoint;
        //
        for var i: integer := 1 to (MyPathDataToPaint.Count - 1) do
        begin
          P2 := MyPathDataToPaint.Points[i].Point;
          //
          PnlUniverse.Canvas.DrawLine(P1, P2, 1, MyStrokeBrush);
          //
          P1 := P2;
        end;
      finally
        PnlUniverse.Canvas.EndScene;
      end;
  end;
end;

procedure TForm1.TrcBrAnimationDurationChange(Sender: TObject);
begin
  LbAnimationDuration.Text := Format('Duration: +/- %.3f ms', [TrcBrAnimationDuration.Value]);
end;

procedure TForm1.Btn_Clear_PointsClick(Sender: TObject);
begin
  PathAnimation1.Stop;
  //
  CcShip.Position.Point := MyPointTargetCenter;
  //
  MyPathData.Clear;
  MyPathDataToPaint.Clear;
  Self.Invalidate;
end;

procedure TForm1.Btn_Start_AnimationClick(Sender: TObject);
begin
  PathAnimation1.Path.Data := MyPathData.Data;
  //
  if (PathAnimation1.Path.Count = 0) then
  begin
    ShowMessage('No points to start animation...');
    //
    exit;
  end;
  //
  PathAnimation1.AutoReverse   := ChkBxAnimationAutoReverse.IsChecked;
  PathAnimation1.Inverse       := ChkBxAnimationInverse.IsChecked;
  PathAnimation1.Rotate        := ChkBxAnimationRotate.IsChecked;
  PathAnimation1.Loop          := ChkBxAnimationLoop.IsChecked;
  PathAnimation1.Duration      := TrcBrAnimationDuration.Value;
  PathAnimation1.AnimationType := TAnimationType(LstBxAnimationType.ItemIndex);
  PathAnimation1.Interpolation := TInterpolationType(LstBxInterpolation.ItemIndex);
  //
  Btn_Start_Animation.Enabled := false;
  Btn_Stop_Animation.Enabled  := true;
  Btn_Clear_Points.Enabled    := false;
  //
  PnlUniverse.Repaint;
  //
  PathAnimation1.Start;
end;

procedure TForm1.Btn_Stop_AnimationClick(Sender: TObject);
begin
  PathAnimation1.Stop;
  //
  CcShip.Position.Point := MyMouseDownPoint;
  //
  Btn_Start_Animation.Enabled := true;
  Btn_Stop_Animation.Enabled  := false;
  Btn_Clear_Points.Enabled    := true;
end;

end.
----------------------------------------------
The higher the degree, the greater the respect given to the humblest!RAD 11.3

作者：

luckyso999 (luckyso)	★☆☆☆☆	-
	盒子活跃会员

2022/1/14 17:45:33

6楼：

cool!
----------------------------------------------
-

信息

登陆以后才能回复