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

Last updated at 2025-05-05Posted at 2025-05-01

TEffect

FireMonkey は VCL と比べて表現力が桁違いです。
その最たるものが「TEffect」派生クラス達です。

例えば、下記の通常の画像に

TGaussianBlurEffect をかけると、下記の様にぼやけた画像になります。

※画像は DocWiki から拝借

他にも色々な効果がデフォルトで用意されているので、興味のある方は下記のページを観てください。

FireMonkey の画像効果

設計時に Effect をかける方法

設計時にエフェクトをかけるのは非常に簡単で、エフェクトの親にエフェクトがかかります。

ここでは、Image1 の子供として TGaussianBlurEffect を設定することで、Image1 に Gaussian Blur エフェクトがかかっています。

実行時に Effect をかける方法

さて、では実行時にエフェクトをかける方法ですが、一々 TImage と TEffect を生成して、Parent を設定するしかないのでしょうか？

…もちろん、違います！

TEffect とは一体何者なのか？

そもそも TEffect とは何なんでしょうか？
最初に説明したように「コントロールに効果を付与できるもの」ですが、実は TEffect は単なるラッパーです。
実際にエフェクトをかけているのは、TFilter です。

TFilter

TEffect は TFilter をコンポーネント化するためのラッパーです。

TEffect は基底クラスで、そこから派生した、例えば TGaussianBlurEffect などが実際に使われるクラスです。

これらのクラスは実行時にフィルタを探します。
探す方法は名前探索で、直接文字列を指定したり、先頭の T と最後の Effect を取り払った文字列を使います。

フィルターの名前を直接指定

function TBlurEffect.CreateFilter: TFilter;
begin
  Result := TFilterManager.FilterByName('GaussianBlur');
end;

クラス名からフィルターの名前を生成

function TImageFXEffect.CreateFilter: TFilter;
var
  FilterName: string;
begin
  FEffectStyle := [TEffectStyle.DisablePaint];
  FilterName := ClassName.Substring(1, 100);
  Result := TFilterManager.FilterByName(FilterName.Substring(0, FilterName.Length - 6));
end;

どちらの場合も、TFilterManager.FilterByName を使って Filter のインスタンスを受取ります。

TFilter の使い方

Filter はその種類によって、プロパティが異なります。
例えば、TGaussianBlurFilter は、BlurAmount という Single 型のプロパティがあります。
これらプロパティの名前は Filter によって異なるため、次に示す ValueAs*** という仕組みを使って値をセットします。

var Filter = TFilterManager.FilterByName('GaussianBlur');
// BlurAmount プロパティに 0.5 を代入
Filter.ValueAsFloat['BlurAmount'] := 0.5;

上記コードは float 値を指定するものですが、指定できる型は下記の５種類です。

プロパティ名	型
ValuesAsBitmap	TBitmap
ValuesAsColor	TAlphaColor
ValuesAsFloat	Single
ValuesAsPoint	TPointF
ValuesAsTexture	TTexture

特殊なパラメータ

ValueAsBitmap には特殊なパラメータがあります。
それが、Input と Output, Target です。

名前	役割
Input	エフェクトの対象となる Bitmap を指定
Target	トランジション用の２つめの Bitmap を指定
Output	エフェクトがかかった Bitmap を取得

このパラメータの使い方は次の実使用例のコードを見た方が早いです。

実使用例

GaussianBlur フィルターをかける例です。

procedure TForm1.Button1Click(Sender: TObject);
begin
  var Filter := TFilterManager.FilterByName('GaussianBlur');
  if Filter <> nil then
  try
    // Input に効果をかける対象の Bitmap を代入
    Filter.ValuesAsBitmap['Input'] := Image1.Bitmap;

    // 必要であればパラメータを指定
    Filter.ValueAsFloat['BlurAmount'] := 0.5; 

    // 必要であれば Target を指定（今回は不要）
    // Filter.ValueAsFloat['Target'] := Image2.Bitmap; 
    
    // Output を使って取り出すと、効果が付与された Bitmap を取得できる
    var FilteredBmp := Filter.ValuesAsBitmap['Output'];
    
    Image1.Bitmap.Assign(FilteredBmp);
  finally
    Filter.Free;
  end;
end;

Input に Bitmap を入れて、Output で取り出す、ただこれだけで効果の付いた Bitmap を取得できます。
使用するのはとても簡単ですね。

ただ、この書き方を使うと内部に Output 用の Bitmap が生成されます。
そのため非常に大きな Bitmap の場合、大きくメモリを消費します。
実際に欲しいのは効果であって、TBitmap のインスタンスが欲しいわけではありません。

そこで、次のように書くと Output 用の Bitmap を使わずに効果が得られます。

procedure TForm1.Button1Click(Sender: TObject);
begin
  var Filter := TFilterManager.FilterByName('GaussianBlur');
  if Filter <> nil then
  try
    // この２つは上と同じ
    Filter.ValuesAsBitmap['Input'] := Image1.Bitmap;
    Filter.ValueAsFloat['BlurAmount'] := 0.5; 

    // 効果を設定、ただし Output Bitmap は生成しない
    Filter.ApplyWithoutCopyToOutput;

    // 引数の Bitmap に効果を付与
    Filter.FilterContext.CopyToBitmap(Image1.Bitmap, Image1.Bitmap.Bounds);
  finally
    Filter.Free;
  end;
end;

ちなみに、Filter はシェーダーで書かれているため、動作は非常に高速です。

Filter には Apply というメソッドがありますが、これを呼んではなりません。
ValueAsBitmap['Output'] が内部で自動的に呼びだします。
これを呼んでしまうと ValueAsBitmap['Output'] をした時にサイズが 0 の Bitmap しか取れなくなってしまうため注意が必要です。

ライブラリ化

一行で簡単にエフェクトをかけられるようにライブラリ化しました。

PK.Graphic.FilterUtils.pas

(*
 * 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
  Result := False;

  var Filter := TFilterManager.FilterByName(AFilterName);
  if Filter <> nil then
  begin
    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);

      Result := True;
    finally
      FIlter.Free;
    end;
  end;
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.

使用方法

PK.Graphic.FilterUtils に定義されている TFilterUtils.ApplyFilter メソッドを使います。

第１引数：効果をかけたい Bitmap
第２引数：Effect の名前か TxxxEffect クラスそのもの
第３引数(省略可)：プロパティの配列。
TFilterProperty.CreateWithXXX を使って指定 (ValueAsXXX と同じ種類あり)
第４引数(省略可)：Transition など Target が必要な場合に指定する Bitmap

最もシンプルな例（文字列を渡す版）

TFilterUtils.ApplyFilter(Image1.Bitmap, 'Ripple');

最もシンプルな例（クラスを渡す版）

TFilterUtils.ApplyFilter(Image1.Bitmap, TRippleEffect);

引数を渡す例

TFilterUtils.ApplyFilter(
  Image1.Bitmap, 
  'Ripple',
  [
    TFilterProperty.CreateWithFloat('Amplitude', 0.7),
    TFilterProperty.CreateWithFloat('AspectRatio', 1.0),
    TFilterProperty.CreateWithFloat('Frequency', 144)
  ]
);

Transition の例

TFilterUtils.ApplyFilter(
  Image1.Bitmap,
  TWaterTransitionEffect,
  [TFilterProperty.CreateWithFloat('Progress', 50)],
  Image2.Bitmap);

まとめ

実行時は TFilter を使えば、無駄に TEffect を生成する必要はありません！

実行時にエフェクトをかける手順です。

FMX.Filter を uses に追加
TFilterManager.FilterByName を使って Filter を取得 (破棄が必要)
ValueAsBitmap['Input'] に効果対象の Bitmap を指定
必要であれば Target や、ValueAs*** を使ってプロパティを指定
ValueAsBitmap[Output] で効果付きの Bitmap を取得
または ApplyWithoutCopyToOutput と CopyToBitmap を使う

面倒であれば、上記の PK.Graphic.FilterUtils をご利用ください！

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up