【Delphi】疑似パレットアニメーションを行う (FireMonkey)

Last updated at 2026-04-30Posted at 2026-04-30

はじめに

VCL で疑似パレットアニメーションをやってみたのですが、これを FireMonkey でもやってみたいと思います。

See also:

【Delphi】疑似パレットアニメーションを行う (Qiita)

疑似パレットアニメーションを行う

FireMonkey ならアホ程簡単です。

ですが、本当にパレット変更してアニメーションさせるのではなく、前回やったアニメーションパレットと同じ視覚効果を得る事を目的としています。

ソースコード

適当にマルチデバイスアプリケーションを新規作成してください。

フォームに、サイズ 480x320 の Rectangle を貼ります。

Fill.Color プロパティで TColorAnimation を作成します。

TColorAnimation のプロパティを設定します。

プロパティ	値	説明
AutoReverse	True	アニメーションを往復させます
Duration	1.0	アニメーションを行う時間です
Enabled	True	アニメーションを有効にします
PropertyName	Fill.Color	このプロパティの値をアニメーションします
StartValue	RGB(64, 0, 0)	開始色です
StopValue	RGB(255, 0, 0)	終了色です

サイズ 480x320 の Image を貼ります。実際にはぴったり重ねてください。

フォームをテキストで表示させるとこんな感じになります。

frmuMain.dfm

object frmMain: TfrmMain
  Left = 0
  Top = 0
  Caption = 'Animation Palette Test'
  ClientHeight = 480
  ClientWidth = 640
  Position = ScreenCenter
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnCreate = FormCreate
  DesignerMasterStyle = 0
  object Rectangle1: TRectangle
    Position.X = 80.000000000000000000
    Position.Y = 88.000000000000000000
    Size.Width = 480.000000000000000000
    Size.Height = 320.000000000000000000
    Size.PlatformDefault = False
    object ColorAnimation1: TColorAnimation
      AutoReverse = True
      Enabled = True
      Duration = 1.000000000000000000
      Loop = True
      PropertyName = 'Fill.Color'
      StartValue = xFF400000
      StopValue = claRed
    end
  end
  object Image1: TImage
    MultiResBitmap = <
      item
      end>
    Position.X = 80.000000000000000000
    Position.Y = 88.000000000000000000
    Size.Width = 480.000000000000000000
    Size.Height = 320.000000000000000000
    Size.PlatformDefault = False
  end
end

ソースコードです。

frmuMain.pas

unit frmuMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Ani,
  FMX.Objects, System.IOUtils;

type
  TfrmMain = class(TForm)
    Rectangle1: TRectangle;
    ColorAnimation1: TColorAnimation;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.fmx}

procedure TfrmMain.FormCreate(Sender: TObject);
const
  PNGIMGNAME = 'test.png';

begin
  var HasFile := TFile.Exists(PNGIMGNAME);
  if HasFile then
    Image1.Bitmap.LoadFromFile(PNGIMGNAME);
end;

end.