FMX.UIToast.pas

unit FMX.UIToast;

{
  * ===========================================================================
  * FMX.UIToast - Displaying Customizable Toast Messages for Delphi/FMX
  * Copyright (c) 2025 - MEStackCodes
  * https://github.com/MEStackCodes
  * ---------------------------------------------------------------------------
  * Distributed under the MIT software license.
  * ===========================================================================
}

interface

uses
  FMX.Forms,
  System.Classes, System.Types, System.UITypes, FMX.Types, FMX.Controls, FMX.Controls.Presentation,
  FMX.Presentation.Messages, FMX.Presentation.Factory, FMX.Presentation.Style, FMX.Objects, FMX.Ani,
  FMX.Graphics, FMX.Layouts;

type

  TToastColorRec = record
    Color: TAlphaColor;
    Text: TAlphaColor;
  end;

  TToastType = record
  const
    Success: TToastColorRec = (Color: TAlphaColor($FF16A715); Text: TAlphaColor($FFFFFFFF));
    Warning: TToastColorRec = (Color: TAlphaColor($FFFF8F00); Text: TAlphaColor($FF000000));
    Danger: TToastColorRec = (Color: TAlphaColor($FFFF0505); Text: TAlphaColor($FFFFFFFF));
    Dark: TToastColorRec = (Color: TAlphaColor($FF0C0C0C); Text: TAlphaColor($FFFFFFFF));
    Light: TToastColorRec = (Color: TAlphaColor($FFF7F7F7); Text: TAlphaColor($FF000000));
  end;

  TToastAnimation = (taFade, taSlide, taNone);
  TToastPosition = (tpTop, tpBottom, tpCenter);

  TUIToast = class(TComponent)
  private
    FText: string;
    FFontColor: TAlphaColor;
    FBackColor: TAlphaColor;
    FToastColorType: TToastColorRec;
    FFontSize: Single;
    FOpacity: Single;
    FCornerRadius: Single;
    FBorderColor: TAlphaColor;
    FBorderWidth: Single;
    FAnimation: TToastAnimation;
    FDuration: Single;
    FTransition: Single;
    FPosition: TToastPosition;
    FMargin: TBounds;
    FHeight: Single;
    FWidth: Single;
    FTextAlign: TTextAlign;
    FControlType: TControlType;
    FToastParentControl: TFMXObject;
    procedure SetControlType(const Value: TControlType);
    procedure SetText(const Value: string);
    procedure SetFontColor(const Value: TAlphaColor);
    procedure SetBackColor(const Value: TAlphaColor);
    procedure SetFontSize(const Value: Single);
    procedure SetOpacity(const Value: Single);
    procedure SetCornerRadius(const Value: Single);
    procedure SetBorderColor(const Value: TAlphaColor);
    procedure SetBorderWidth(const Value: Single);
    procedure SetAnimation(const Value: TToastAnimation);
    procedure SetDuration(const Value: Single);
    procedure SetTransition(const Value: Single);
    procedure SetPosition(const Value: TToastPosition);
    procedure SetMargin(const Value: TBounds);
    procedure SetHeight(const Value: Single);
    procedure SetTextAlign(const Value: TTextAlign);
    procedure SetToastColorType(const Value: TToastColorRec);
    procedure CreateToastVisual;
    procedure DestroyToastVisual(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Show(AParent: TFMXObject);
    property ControlType: TControlType read FControlType write SetControlType;
    property Text: string read FText write SetText;
    property FontColor: TAlphaColor read FFontColor write SetFontColor default TAlphaColors.White;
    property BackColor: TAlphaColor read FBackColor write SetBackColor default TAlphaColors.Black;
    property FontSize: Single read FFontSize write SetFontSize;
    property Opacity: Single read FOpacity write SetOpacity;
    property CornerRadius: Single read FCornerRadius write SetCornerRadius;
    property BorderColor: TAlphaColor read FBorderColor write SetBorderColor default TAlphaColors.Null;
    property BorderWidth: Single read FBorderWidth write SetBorderWidth;
    property Animation: TToastAnimation read FAnimation write SetAnimation default taFade;
    property Duration: Single read FDuration write SetDuration;
    property Transition: Single read FTransition write SetTransition;
    property Position: TToastPosition read FPosition write SetPosition default tpBottom;
    property Margin: TBounds read FMargin write SetMargin;
    property ToastHeight: Single read FHeight write SetHeight;
    property TextAlign: TTextAlign read FTextAlign write SetTextAlign default TTextAlign.Center;
    property ToastColorType: TToastColorRec read FToastColorType write SetToastColorType;
  end;

implementation

uses
  SysUtils;

type

  TVisualToastAnimation = class(TFloatAnimation)
  private
    FOnFinishCallback: TProc<TObject>;
  protected
    procedure DoFinish; override;
  public
    property OnFinishCallback: TProc<TObject> read FOnFinishCallback write FOnFinishCallback;
  end;

  TVisualToast = class(TLayout)
  private
    FToastControl: TPresentedControl;
    FToastRect: TRectangle;
    FToastText: TText;
    FToastBlockContainer: TLayout;
    FAnimator: TVisualToastAnimation;
    FUIToastControl: TUIToast;
  public
    constructor Create(AOwner: TComponent); override;
    procedure StartToastAnimation;
    property UIToastControl: TUIToast read FUIToastControl write FUIToastControl;
    property ToastBlockContainer: TLayout read FToastBlockContainer write FToastBlockContainer;
    property ToastControl: TPresentedControl read FToastControl write FToastControl;
    property ToastRect: TRectangle read FToastRect write FToastRect;
    property ToastText: TText read FToastText write FToastText;

  end;

procedure TVisualToastAnimation.DoFinish;
begin
  inherited;

  if (Assigned(FOnFinishCallback)) then
  begin
    FOnFinishCallback(Self);
  end;
end;

constructor TVisualToast.Create(AOwner: TComponent);
begin
  inherited;

  Self.Align := TAlignLayout.Contents;
  Self.Visible := True;
  Self.HitTest := False;

  FToastBlockContainer := TLayout.Create(Self);
  FToastBlockContainer.Align := TAlignLayout.None;
  FToastBlockContainer.Parent := Self;
  FToastBlockContainer.Visible := True;

  FToastControl := TPresentedControl.Create(FToastBlockContainer);
  FToastControl.Align := TAlignLayout.Client;
  FToastControl.Parent := FToastBlockContainer;
  FToastControl.Visible := True;

  FToastRect := TRectangle.Create(FToastControl);
  FToastRect.Parent := FToastControl;
  FToastRect.Padding := TBounds.Create(RectF(8, 2, 8, 2));
  FToastRect.Align := TAlignLayout.Contents;
  FToastRect.Visible := True;

  FToastText := TText.Create(FToastRect);
  FToastText.Parent := FToastRect;
  FToastText.Align := TAlignLayout.Client;
  FToastText.Visible := True;

  FUIToastControl := nil;

end;

procedure TVisualToast.StartToastAnimation;
var
  StartVerticalPosition: Single;
  StopVerticalPosition: Single;

begin

  StartVerticalPosition := 0;
  StopVerticalPosition := 0;

  case FUIToastControl.Animation of

    taFade:
      begin

        Self.Opacity := 0;
        FAnimator := TVisualToastAnimation.Create(Self);
        FAnimator.Parent := Self;
        FAnimator.Inverse := False;
        FAnimator.Delay := 0;
        FAnimator.PropertyName := 'Opacity';
        FAnimator.StartValue := 0;
        FAnimator.StopValue := 1;
        FAnimator.Duration := FUIToastControl.Transition;
        FAnimator.OnFinishCallback := procedure(Sender: TObject)
          begin
            if (not TVisualToastAnimation(Sender).Inverse) then
            begin
              TVisualToastAnimation(Sender).Inverse := True;
              TVisualToastAnimation(Sender).Delay := FUIToastControl.Duration;
              TVisualToastAnimation(Sender).Start;
            end
            else
            begin
              FUIToastControl.DestroyToastVisual(Sender);
            end;
          end;

        FAnimator.Start;
      end;

    taSlide:
      begin

        case FUIToastControl.Position of
          tpTop:
            begin
              FToastBlockContainer.Position.Y := (Self.Top - FToastBlockContainer.Height);
              StartVerticalPosition := (Self.Top - FToastBlockContainer.Height);
              StopVerticalPosition := Self.Top + FUIToastControl.Margin.Top;
            end;
          tpBottom:
            begin
              FToastBlockContainer.Position.Y := Self.Height;
              StartVerticalPosition := Self.Height;
              StopVerticalPosition := (Self.Height - FToastBlockContainer.Height) - FUIToastControl.Margin.Bottom;
            end;
          tpCenter:
            begin
              FToastControl.Position.Y := FToastBlockContainer.Position.Y + FToastBlockContainer.Height;
              StartVerticalPosition := FToastBlockContainer.Position.Y + FToastBlockContainer.Height;
              StopVerticalPosition := FToastBlockContainer.Position.Y - FToastBlockContainer.Height;
            end;
        end;

        FAnimator := TVisualToastAnimation.Create(FToastBlockContainer);
        FAnimator.Parent := FToastBlockContainer;
        FAnimator.Inverse := False;
        FAnimator.Delay := 0;
        FAnimator.PropertyName := 'Position.Y';
        FAnimator.StartValue := StartVerticalPosition;
        FAnimator.StopValue := StopVerticalPosition;
        FAnimator.Duration := FUIToastControl.Transition;
        FAnimator.OnFinishCallback := procedure(Sender: TObject)
          begin
            if (not TVisualToastAnimation(Sender).Inverse) then
            begin
              TVisualToastAnimation(Sender).Inverse := True;
              TVisualToastAnimation(Sender).Delay := FUIToastControl.Duration;
              TVisualToastAnimation(Sender).Start;
            end
            else
            begin
              FUIToastControl.DestroyToastVisual(Sender);
            end;
          end;

        FAnimator.Start;
      end;
    taNone:
      begin
        Self.Opacity := 0;
        FAnimator := TVisualToastAnimation.Create(Self);
        FAnimator.Parent := Self;
        FAnimator.Inverse := False;
        FAnimator.Delay := 0;
        FAnimator.PropertyName := 'Opacity';
        FAnimator.StartValue := 0;
        FAnimator.StopValue := 1;
        FAnimator.Duration := 0.1;
        FAnimator.OnFinishCallback := procedure(Sender: TObject)
          begin
            if (not TVisualToastAnimation(Sender).Inverse) then
            begin
              TVisualToastAnimation(Sender).Inverse := True;
              TVisualToastAnimation(Sender).Delay := FUIToastControl.Duration;
              TVisualToastAnimation(Sender).Start;
            end
            else
            begin
              FUIToastControl.DestroyToastVisual(Sender);
            end;
          end;

        FAnimator.Start;
      end;

  end;
end;

{ TUIToast }

constructor TUIToast.Create(AOwner: TComponent);
begin
  inherited;
  FText := 'Hello World! with UI Toast...';
  FFontColor := TAlphaColors.White;
  FBackColor := TAlphaColors.Black;
  FFontSize := 16;
  FOpacity := 1;
  FCornerRadius := 12;
  FBorderColor := TAlphaColors.Null;
  FBorderWidth := 0;
  FAnimation := taFade;
  FDuration := 2.5;
  FTransition := 0.2;
  FPosition := tpBottom;
  FMargin := TBounds.Create(RectF(16, 16, 16, 16));
  FHeight := 48;
  FWidth := 240;
  FTextAlign := TTextAlign.Center;
  FControlType := TControlType.Styled;
end;

destructor TUIToast.Destroy;
begin
  FMargin.Free;
  inherited;
end;

procedure TUIToast.SetControlType(const Value: TControlType);
begin
  FControlType := Value;
end;

procedure TUIToast.SetText(const Value: string);
begin
  FText := Value;
end;

procedure TUIToast.SetFontColor(const Value: TAlphaColor);
begin
  FFontColor := Value;
end;

procedure TUIToast.SetBackColor(const Value: TAlphaColor);
begin
  FBackColor := Value;
end;

procedure TUIToast.SetToastColorType(const Value: TToastColorRec);
begin
  FToastColorType := Value;
  FBackColor := Value.Color;
  FFontColor := Value.Text;
end;

procedure TUIToast.SetFontSize(const Value: Single);
begin
  FFontSize := Value;
end;

procedure TUIToast.SetOpacity(const Value: Single);
begin
  FOpacity := Value;
end;

procedure TUIToast.SetCornerRadius(const Value: Single);
begin
  FCornerRadius := Value;
end;

procedure TUIToast.SetBorderColor(const Value: TAlphaColor);
begin
  FBorderColor := Value;
end;

procedure TUIToast.SetBorderWidth(const Value: Single);
begin
  FBorderWidth := Value;
end;

procedure TUIToast.SetAnimation(const Value: TToastAnimation);
begin
  FAnimation := Value;
end;

procedure TUIToast.SetDuration(const Value: Single);
begin
  FDuration := Value;
end;

procedure TUIToast.SetTransition(const Value: Single);
begin
  FTransition := Value;
end;

procedure TUIToast.SetPosition(const Value: TToastPosition);
begin
  FPosition := Value;
end;

procedure TUIToast.SetMargin(const Value: TBounds);
begin
  FMargin.Assign(Value);
end;

procedure TUIToast.SetHeight(const Value: Single);
begin
  FHeight := Value;
end;

procedure TUIToast.SetTextAlign(const Value: TTextAlign);
begin
  FTextAlign := Value;
end;

procedure TUIToast.CreateToastVisual;
var
  ParentWidth, ParentHeight: Single;
  IsLandscape: Boolean;
  ToastWidth, MarginPercent, MarginValue: Single;
  VisualToast: TVisualToast;
begin

  if (FToastParentControl.ClassType.InheritsFrom(TCustomForm)) then
  begin
    ParentWidth := TCustomForm(FToastParentControl).Width;
    ParentHeight := TCustomForm(FToastParentControl).Height;
  end
  else if (FToastParentControl.ClassType.InheritsFrom(TControl)) then
  begin
    ParentWidth := TControl(FToastParentControl).Width;
    ParentHeight := TControl(FToastParentControl).Height;
  end
  else
  begin
    exit;
  end;

  IsLandscape := ParentWidth > ParentHeight;
  if IsLandscape then
  begin
    ToastWidth := ParentWidth * 0.75;
    MarginPercent := 0.125;
  end
  else
  begin
    ToastWidth := ParentWidth * 0.9;
    MarginPercent := 0.05;
  end;

  MarginValue := ParentWidth * MarginPercent;

  VisualToast := TVisualToast.Create(nil);
  VisualToast.ToastBlockContainer.Height := FHeight;
  VisualToast.ToastBlockContainer.Width := ToastWidth;
  VisualToast.ToastBlockContainer.Margins.Left := MarginValue;
  VisualToast.ToastBlockContainer.Margins.Right := MarginValue;
  VisualToast.ToastBlockContainer.Position.X := MarginValue;

  case FPosition of
    tpTop:
      VisualToast.ToastBlockContainer.Position.Y := FMargin.Top;
    tpBottom:
      VisualToast.ToastBlockContainer.Position.Y := (ParentHeight - FHeight) - FMargin.Bottom;
    tpCenter:
      VisualToast.ToastBlockContainer.Position.Y := (ParentHeight - FHeight) / 2;
  end;

  VisualToast.ToastRect.Fill.Color := FBackColor;
  VisualToast.ToastRect.Opacity := FOpacity;
  VisualToast.ToastRect.XRadius := FCornerRadius;
  VisualToast.ToastRect.YRadius := FCornerRadius;
  VisualToast.ToastRect.Stroke.Color := FBorderColor;
  VisualToast.ToastRect.Stroke.Thickness := FBorderWidth;

  VisualToast.ToastText.Text := FText;
  VisualToast.ToastText.TextSettings.Font.Size := FFontSize;
  VisualToast.ToastText.TextSettings.FontColor := FFontColor;
  VisualToast.ToastText.TextSettings.HorzAlign := FTextAlign;
  VisualToast.ToastText.TextSettings.WordWrap := True;

  FToastParentControl.AddObject(VisualToast);
  VisualToast.ToastControl.ControlType := FControlType;

  // Blend Mode
  if (VisualToast.ToastControl.ControlType = TControlType.Platform) then
  begin
    VisualToast.ToastControl.Opacity := 0.9;
  end;

  VisualToast.UIToastControl := Self;
  VisualToast.StartToastAnimation;

end;

procedure TUIToast.DestroyToastVisual(Sender: TObject);
begin
  TThread.Queue(nil,
    procedure
    begin
      TVisualToast(Sender).Free;
    end);
end;

procedure TUIToast.Show(AParent: TFMXObject);
begin

  if (not Assigned(AParent)) then
  begin
    exit;
  end;

  FToastParentControl := AParent;
  CreateToastVisual;
end;

end.