[Delphi][FMX] 実行時にエフェクトをかける方法 #objectpascal – Qiita

(*
 * Filter Utility
 *
 * LICENSE
 *   Copyright 2025 HOSOKAWA Jun
 *   Released under the MIT license
 *   http://opensource.org/licenses/mit-license.php
 *
 * PLATFORMS
 *   Windows / macOS / iOS / Android
 *
 * METHODS
 *   ApplyFilter  Applies an Effect, Filter, or Transition to a TBitmap.
 *
 * HOW TO USE
 *   uses PK.Graphic.FilterUtils;
 *
 *   * Simple Filter
 *     TFilterUtils.ApplyFilter(
 *       Image1.Bitmap, // Source and Result
 *       'Ripple');     // Effect class or string
 *
 *   * Full
 *     TFilterUtils.ApplyFilter(
 *       Image1.Bitmap, // Source and Result
 *       TWaterTransitionEffect, // Effect class or string
 *       [TFilterProperty.CreateWithFloat('Progress', 50)], // properties
 *       Image2.Bitmap) // Target bitmap for transition
 *
 * HISTORY
 *   2025-05-01  Version 1.0  Release
 *
 * Programmed by HOSOKAWA Jun (freeonterminate@gmail.com)
 *)

unit PK.Graphic.FilterUtils;

interface

uses
  System.SysUtils
  , System.UITypes
  , System.Types
  , FMX.Types3D
  , FMX.Graphics
  , FMX.Effects
  , FMX.Filter
  ;

type
  TValueKind = (Bitmap, Color, Float, Point, Texture);
  TFilterProperty = record
  private var
    FName: String;
    FKind: TValueKind;
  private
    procedure Init(const AName: String; const AKind: TValueKind);
  public
    constructor CreateWithBitmap(
      const AName: String;
      const AValue: TBitmap);
    constructor CreateWithFloat(
      const AName: String;
      const AValue: Single);
    constructor CreateWithColor(
      const AName: String;
      const AValue: TAlphaColor);
    constructor CreateWithPoint(
      const AName: String;
      const AValue: TPointF);
    constructor CreateWithTexture(
      const AName: String;
      const AValue: TTexture);
    property Name: String read FName;
    property Kind: TValueKind read FKind;
  private
    case TValueKind of
      Bitmap: (FBitmap: TBitmap);
      Color: (FColor: TAlphaColor);
      Float: (FFloat: Single);
      Point: (FPoint: TPointF);
      Texture: (FTexture: TTexture);
  end;

  TFilterUtils = class
  public type
    TEffectClass = class of TEffect;
    TFilterProperties = array of TFilterProperty;
  public
    class function ApplyFilter(
      const AImage: TBitmap;
      const AEffect: TEffectClass;
      const AProperties: TFilterProperties = [];
      const ATarget: TBitmap = nil): Boolean; overload; static;
    class function ApplyFilter(
      const AImage: TBitmap;
      const AFilterName: String;
      const AProperties: TFilterProperties = [];
      const ATarget: TBitmap = nil): Boolean; overload; static;
  end;

implementation

{ TFilterProperty }

constructor TFilterProperty.CreateWithBitmap(
  const AName: String;
  const AValue: TBitmap);
begin
  Init(AName, TValueKind.Bitmap);
  FBitmap := AValue;
end;

constructor TFilterProperty.CreateWithColor(
  const AName: String;
  const AValue: TAlphaColor);
begin
  Init(AName, TValueKind.Color);
  FColor := AValue;
end;

constructor TFilterProperty.CreateWithFloat(
  const AName: String;
  const AValue: Single);
begin
  Init(AName, TValueKind.Float);
  FFloat := AValue;
end;

constructor TFilterProperty.CreateWithPoint(
  const AName: String;
  const AValue: TPointF);
begin
  Init(AName, TValueKind.Point);
  FPoint := AValue;
end;

constructor TFilterProperty.CreateWithTexture(
  const AName: String;
  const AValue: TTexture);
begin
  Init(AName, TValueKind.Texture);
  FTexture := AValue;
end;

procedure TFilterProperty.Init(
  const AName: String;
  const AKind: TValueKind);
begin
  FillChar(Self, SizeOf(Self), 0);

  FName := AName;
  FKind := AKind;
end;

{ TFilterUtils }

class function TFilterUtils.ApplyFilter(
  const AImage: TBitmap;
  const AFilterName: String;
  const AProperties: TFilterProperties;
  const ATarget: TBitmap): Boolean;
begin
  var Filter := TFilterManager.FilterByName(AFilterName);
  try
    Filter.ValuesAsBitmap['Input'] := AImage;

    if ATarget  nil then
      Filter.ValuesAsBitmap['Target'] := ATarget;

    for var P in AProperties do
    begin
      case P.FKind of
        Bitmap:
          Filter.ValuesAsBitmap[P.FName] := P.FBitmap;
        Color:
          Filter.ValuesAsColor[P.FName] := P.FColor;
        Float:
          Filter.ValuesAsFloat[P.FName] := P.FFloat;
        Point:
          Filter.ValuesAsPoint[P.FName] := P.FPoint;
        Texture:
          Filter.ValuesAsTexture[P.FName] := P.FTexture;
      end;
    end;

    Filter.ApplyWithoutCopyToOutput;
    Filter.FilterContext.CopyToBitmap(AImage, AImage.Bounds);
  finally
    FIlter.Free;
  end;

  Result := True;
end;

class function TFilterUtils.ApplyFilter(
  const AImage: TBitmap;
  const AEffect: TEffectClass;
  const AProperties: TFilterProperties;
  const ATarget: TBitmap): Boolean;
begin
  var Name := AEffect.ClassName;
  Name := Name.Substring(1, Name.Length - 7); // TxxxEffect xxx 以外の７文字

  Result := ApplyFilter(AImage, Name, AProperties, ATarget);
end;

end.