Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2017年08月01日] [更新 2017年08月06日]　GDI+ 関係サンプル
   
GDI+ 関係サンプル　
G122_ぼかし画像の作成と文字列や画像の Drop Shadow
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
G122_GDIPlus_DropShadow.zip　[2,541 KB]　2017年08月06日版 (EXE 同梱)






ぼかし画像の作成と文字列や画像の影 ( Drop Shadow ) の描画


写真等の画像全全体をぼかす，つまりぼかし画像を作成するサンプルです．
以下のページでは Delphi 2009 GDI+ Library を使用していますが，本ページでは添付のユニット内の関数類を使用しています．このユニットにはガウスぼかし (ガウシアンブラー・Gaussian Blur) とボックスぼかし (ボックスブラー・Box Blur) 用の関数類があります．



これらのぼかし用の関数を使用すると，Drop Shadow と呼ばれている影付きの文字列や画像を描画することができます．
まず，ぼかし画像を作成します．この時，画像の矩形領域よりも少し広い範囲を含めてぼかし画像を作成します．拡張した領域は何も描画されていない透明なピクセルです．この状態でぼかし画像を作井すると，画像の周辺がぼかされた画像になります．
このぼかし画像を単一の色にしたマスク画像にします．一般的には「影」の部分ですから黒にすることが多いようです．この画像に元の画像を重ね描画すると影付きの画像にすることができます．

これとは逆に，まず画像のマスク画像を作成して，それをぼかし画像にする方法もあります．
マスク画像の作成については以下にも記事があります．



本ページのサンプルでは，ビットマップのアルファチャンネルの処理とアイコン画像の拡大表示に，以下の記事に掲載している関数類を使用しています．






01_Gaussian Blur または Box Blur を使用したぼかし画像の作成


写真等の画像を Gaussian Blur または Box Blur を使用してぼかし画像にするサンプルです．



図1
設計時の画面
  • TImage.AutoSize プロパティの値は True
図2
Gaussian Blur によるぼか画像の例
  • ぼかし計算の半径が 10 の場合
  • 左は元の画像

リスト1
Gaussian Blur または Box Blur を使用したぼかし画像の作成
アルファチャンネルの処理が必要なければ PNG 画像，ビットマップ画像でもテスト可能		 
uses
  plBlurGDIplus;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  SpinEdit1.Value := 5;
end;

//=============================================================================
//  矩形領域内だけをぼかす
//  写真等のぼかし画像作成用
//
//  TImageのAutoSizeプロパティの値をTrueにしている
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGPGraphic    : TGPGraphics;
  LGPBitmap     : TGPBitmap;
  LGPBlurBitmap : TGPBitmap;
  LStream       : TMemoryStream;
  LImgWidth     : Integer;
  LImgHeight    : Integer;
  LImgFilePath  : string;
  LRadius       : Integer;
begin
  LRadius := SpinEdit1.Value;

  LImgFilePath := ExpandFileName('PenguinsB.bmp');
  LStream := TMemoryStream.Create;
  try
    //画像をメモリストリームに読み込んで処理
    LStream.LoadFromFile(LImgFilePath);

    //ストリームからTGPBitmapを生成
    LGPBitmap  := TGPBitmap.Create(TStreamAdapter.Create(LStream, soReference));
    LImgWidth  := LGPBitmap.GetWidth;
    LImgHeight := LGPBitmap.GetHeight;

    //ぼかし画像を作成
    if CheckBox1.Checked then begin
      LGPBlurBitmap := BoxBlur(LGPBitmap, LRadius);
    end else begin
      LGPBlurBitmap := GaussianBlur(LGPBitmap, LRadius, 1);
    end;

    //元の画像をTImageに描画
    Image1.Picture.Assign(nil);
    Image1.Left := 10;

    Image1.Picture.Bitmap.SetSize(LImgWidth + 20, LImgHeight + 20);
    LGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);
    LGPGraphic.DrawImage(LGPBitmap, 15, 15);


    FreeAndNil(LGPGraphic);

    //作成したぼかし画像をTImageに描画
    Image2.Picture.Assign(nil);
    Image2.Left := 10;
    Image2.Top  := Image1.Top + Image1.Height + 1;
    Image2.Picture.Bitmap.SetSize(LImgWidth + 20, LImgHeight + 20);
    LGPGraphic := TGPGraphics.Create(Image2.Canvas.Handle);
    LGPGraphic.DrawImage(LGPBlurBitmap, 15, 15);
  finally
    FreeAndNil(LGPGraphic);
    FreeAndNil(LGPBitmap);
    FreeAndNil(LGPBlurBitmap);
    FreeAndNil(LStream);
  end;
end;

//=============================================================================
//  CheckBox1のOnClickイベント処理
//  Gaussian BlurとBox Blur処理の切り換え
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  Button1Click(nil);
end;

//=============================================================================
//  SpinEdit1のOnChangeイベント処理
//  ぼかし計算の範囲を変更
//=============================================================================
procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
  if SpinEdit1.Value < 0 then begin
    SpinEdit1.Value := 0;
  end else begin
    Button1Click(nil);
  end;
end;



02_画像のぼかし用関数を使用した影付き文字列の描画


影付き文字列の描画例です．
まず文字列をぼかし画像にします (文字列も画像として描画されます)．そのぼかし画像のマスク画像を作成しています．ぼかし画像，つまり影の部分は半透明になっています．その画像に元の画像を重ね描画しています．これ以降も同じ手法で作成しています．


図3
影付き文字の例
  • 一番上が元の文字列
  • 次がぼかしたマスク画像
  • その画像に元の画像を重ね描画したのが一番下のの画像

下図は，Drop Shadow 作成用の関数の最後の引数の値を clRed にした場合です． 

    //ぼかし画像を作成(実際にはマスク画像のぼかし画像)
    LGPBlurBitmap := CreateGaussianBlurShadow(LGPBitmap, LRadius, 0.8, clRed);


図4
マスク画像の色を clRed に変更

リスト2
画像のぼかし用関数を使用した影付き ( Drop Shadow 付き ) 文字列の描画		 
uses
  plBlurGDIplus;

{$R *.DFM}

//=============================================================================
//  影付き文字列の描画
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGPGraphic    : TGPGraphics;
  LGPBitmap     : TGPBitmap;
  LGPBlurBitmap : TGPBitmap;
  LGPDstBitmap  : TGPBitmap;
  LGPFont       : TGPFont;
  LGPBrush      : TGPSolidBrush;
  LFontSize     : Single;
  LGPColor      : TGPColor;
  LRadius       : Integer;
begin
  LFontSize := 60.0;
  LGPColor  := MakeColor($FF, 0, 0, 0);
  LRadius   := 2;

  //文字列を描画するTGpBitmapを生成
  LGPBitmap  := TGPBitmap.Create(Image1.Width, Image1.Height);
  LGPGraphic := TGPGraphics.Create(LGPBitmap);
  try
    //フォントと文字列を描画するブラシを設定
    LGPFont  := TGPFont.Create('Tahoma', LFontSize, FontStyleBold, UnitPixel);
    LGPBrush := TGPSolidBrush.Create(LGPColor);
    //その設定でTGPBitmapに文字列を描画
    LGPGraphic.DrawString('Delphi', -1, LGPFont, MakePoint(0.0, 0.0), LGPBrush);


    //ぼかし画像を作成(実際にはぼかし画像のマスク画像)
    if CheckBox1.Checked then begin
      LGPBlurBitmap := CreateBoxBlurShadow(LGPBitmap, LRadius, 0.5, clBlack);
    end else begin
      LGPBlurBitmap := CreateGaussianBlurShadow(LGPBitmap, LRadius, 0.5, clBlack);
    end;


    //Image1に元の画像を，Image2にぼかし画像を描画
    DrawGPBitmapToTImage(Image1, LGPBitmap);
    DrawGPBitmapToTImage(Image2, LGPBlurBitmap);

    FreeAndNil(LGPGraphic);

    //結果用のTGPBitmapを生成して，そこにぼかし画像と元の加増を重ね描画
    LGPDstBitmap := TGPBitmap.Create(Image1.Width, Image1.Height);
    LGPGraphic := TGPGraphics.Create(LGPDstBitmap);
    LGPGraphic.DrawImage(LGPBlurBitmap, -LRadius * 2 + 5, -LRadius * 2 + 5);
    LGPGraphic.DrawImage(LGPBitmap, 0, 0);

    //Image3に重ね描画した結果の画像を描画
    DrawGPBitmapToTImage(Image3, LGPDstBitmap);
  finally
    FreeAndNil(LGPGraphic);
    FreeAndNil(LGPBitmap);
    FreeAndNil(LGPBlurBitmap);
    FreeAndNil(LGPDstBitmap);
    FreeAndNil(LGPFont);
    FreeAndNil(LGPBrush);
  end;
end;

//=============================================================================
//  CheckBox1のOnClickイベント処理
//  Gaussian BlurとBox Blur処理の切り換え
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  Button1Click(nil);
end;

//-----------------------------------------------------------------------------
//  引数で指定するTImageコントロールにTGPBitmapを描画
//-----------------------------------------------------------------------------
procedure TForm1.DrawGPBitmapToTImage(ATImage: TImage; AGPBitmap: TGPBitmap);
var
  LGPGraphic : TGPGraphics;
begin
  ATImage.Picture.Assign(nil);

  LGPGraphic := TGPGraphics.Create(ATImage.Canvas.Handle);
  LGPGraphic.DrawImage(AGPBitmap, 0, 0);
end;



03_画像に半透明の Drop Shadow を描画


画像の背景に影を描画する例です．テストに使用したのは 32 ビットのアルファチャンネル付きのビットマップ画像で，背景は透明色です．


図5
実行結果
  • この影は半透明
  • 左は元の画像

Drop Shadow (影) 画像作成用の関数の不透明度と色の指定を省略すると，ぼかし画像だけを作成することができます．下図はそのぼかし画像とマスク画像です．


図6
ぼかし画像
  • 画像の周囲のぼかし部分は半透明
  • 描画開始位置は [ほかしの半径 X 2] ピクセル分右下からとなる
  • 左は元の画像
図7
ぼかし画像をマスク画像にした画像
  • 不透明度の値を 1.0 にして，色の指定を clBlack にしている
  • マスク画像の周囲のぼかし部分は半透明

下図は，画像の周囲に半透明の影を描画した例です．マスク画像のぼかし画像を少し拡大リサイズしてみました．


図8
画像の周囲に影を描画
  • 左は元の画像

以上は背景が透明色の画像でしたが，背景が透明でない画像の場合は下図のようになります．
合成した画像は元の画像サイズよりも大きくなることに注意する必要があります．この画像では，マスク画像の不透明度を 0.5 にしています．		 

    LGPBlurBitmap := CreateGaussianBlurShadow(LGPBitmap, 3, 0.5, clBlack);


図9
半透明の影
  • 左は元の画像

下図は不透明度を 1.0 にした場合です．
不透明度を 1.0 にしても必ずしもピクセルのアルファ値が $FF になるとは限りません．GDI+ は画像を 32 ビットのアルファチャンネル付きのビットマップとして処理します．ぼかし画像を作成する際に使用する拡張領域のピクセルは透明色として処理されます．		 

    LGPBlurBitmap := CreateGaussianBlurShadow(LGPBitmap, 3, 1.0, clBlack);


図10
不透明度を 1.0 にした場合の影
  • 左は元の画像

リスト3
画像に半透明の Drop Shadow を描画		 
uses
  plBlurGDIplus;

{$R *.DFM}

//=============================================================================
//  画像にDrop Shadow(半透明の影)を描画
//
//  TImageのAutoSizeの値をTrueにしている
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGPGraphic    : TGPGraphics;
  LGPBitmap     : TGPBitmap;
  LGPBlurBitmap : TGPBitmap;
  LGPDstBitmap  : TGPBitmap;
  LBitmap       : TBitmap;
  LStream       : TMemoryStream;
  LImgWidth     : Integer;
  LImgHeight    : Integer;
  LImgFilePath  : string;
  LRadius       : Integer;
begin
  LRadius := 3;

  //操作対象のビットマップ画像ファイル名
  LImgFilePath := ExpandFileName('503_Transe.bmp');

  LBitmap := TBitmap.Create;
  LStream := TMemoryStream.Create;
  try
    //ビットマップ画像をメモリストリームに読み込んで処理
    LStream.LoadFromFile(LImgFilePath);
    LStream.Position :=0;
    LBitmap.LoadFromStream(LStream);

    //メモリストリームからTGPBitmapを生成
    LGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(LStream, soReference));
    if LBitmap.PixelFormat = pf32bit then begin
      //TGPBitmapでTBitmapのアルファチャンネルを扱えるようにする
      SetAlphaValueFromTBitmap(LGPBitmap, LBitmap);
    end;
    LImgWidth  := LGPBitmap.GetWidth;
    LImgHeight := LGPBitmap.GetHeight;


    //ぼかし画像を作成(実際にはぼかし画像のマスク画像)
    if CheckBox1.Checked then begin
      LGPBlurBitmap := CreateBoxBlurShadow(LGPBitmap, LRadius, 0.5, clBlack);
    end else begin
      LGPBlurBitmap := CreateGaussianBlurShadow(LGPBitmap, LRadius, 0.5, clBlack);
    end;


    //結果用のTGPBitmapを生成して，そこにぼかし画像と元の加増を重ね描画
    LGPDstBitmap := TGPBitmap.Create(LImgWidth + 20, LImgHeight + 20);
    LGPGraphic := TGPGraphics.Create(LGPDstBitmap);
    LGPGraphic.DrawImage(LGPBlurBitmap, -LRadius * 2 + 5, -LRadius * 2 + 5);
    LGPGraphic.DrawImage(LGPBitmap, 0, 0);


    FreeAndNil(LGPGraphic);

    //Image1に元の画像を描画
    Image1.Picture.Assign(nil);
    Image1.Picture.Bitmap.SetSize(LImgWidth + 20, LImgHeight + 20);
    LGPGraphic := TGPGraphics.Create(Image1.Canvas.Handle);
    LGPGraphic.DrawImage(LGPBitmap, 0, 0);

    FreeAndNil(LGPGraphic);

    //Image2に重ね描画した結果の画像を描画
    Image2.Picture.Assign(nil);
    Image2.Left := Image1.Left + Image1.Width + 10;
    Image2.Picture.Bitmap.SetSize(LImgWidth + 20, LImgHeight + 20);
    LGPGraphic := TGPGraphics.Create(Image2.Canvas.Handle);
    LGPGraphic.DrawImage(LGPDstBitmap, 0, 0);
  finally
    FreeAndNil(LGPGraphic);
    FreeAndNil(LBitmap);
    FreeAndNil(LGPBitmap);
    FreeAndNil(LGPBlurBitmap);
    FreeAndNil(LGPDstBitmap);
    FreeAndNil(LStream);
  end;
end;

//=============================================================================
//  CheckBox1のOnClickイベント処理
//  Gaussian BlurとBox Blur処理の切り換え
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  Button1Click(nil);
end;



04_アイコン画像に半透明の Drop Shadow を描画


アイコン画像に半透明の影を描画する例です．上部の画像が実サイズの画像です．テストに使用した画像は PNG 画像ファイルです．下の左側はそれの拡大表示で，右が実行結果の拡大表示画像です．
本サンプルは実行結果の画像を PNG 画像で保存するようにしています．別名保存です．


図11
実行結果

リスト4
アイコン画像に半透明の Drop Shadow を描画		 
uses
  plBlurGDIplus;

{$R *.DFM}

//=============================================================================
//  アイコン画像にDrop Shadow(半透明の影)を描画
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LGPGraphic    : TGPGraphics;
  LGPBitmap     : TGPBitmap;
  LGPBlurBitmap : TGPBitmap;
  LGPDstBitmap  : TGPBitmap;
  LStream       : TMemoryStream;
  LImgWidth     : Integer;
  LImgHeight    : Integer;
  LImgFilePath  : string;
  LSaveFilePath : string;
  LImgGUID      : TGUID;
begin
  //操作対象のビットマップ画像ファイル名
  LImgFilePath := ExpandFileName('livejournal-old.png');

  LStream := TMemoryStream.Create;
  try
    //画像をメモリストリームに読み込んで処理
    LStream.LoadFromFile(LImgFilePath);

    //メモリストリームからTGPBitmapを生成
    LGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(LStream, soReference));
    LImgWidth  := LGPBitmap.GetWidth;
    LImgHeight := LGPBitmap.GetHeight;


    //ぼかし画像を作成(実際にはマスク画像のぼかし画像)
    if CheckBox1.Checked then begin
      LGPBlurBitmap := CreateBoxBlurShadow(LGPBitmap, 1, 0.45, clBlack);
    end else begin
      LGPBlurBitmap := CreateGaussianBlurShadow(LGPBitmap, 1, 0.45, clBlack);
    end;


    //結果用のTGPBitmapを生成して，そこにぼかし画像と元の加増を重ね描画
    LGPDstBitmap := TGPBitmap.Create(LImgWidth, LImgHeight);
    LGPGraphic := TGPGraphics.Create(LGPDstBitmap);
    LGPGraphic.DrawImage(LGPBlurBitmap, -1.5, -1.5);
    LGPGraphic.DrawImage(LGPBitmap, 0, 0);


    //Image1に元の画像を描画
    DisplayImageAndGridLine(Image1, Image2, LGPBitmap);

    //Image2に重ね描画した結果の画像を描画
    Image3.Left := Image1.Left + Image1.Width + 10;
    Image4.Left := Image1.Left + Image1.Width + 10;
    DisplayImageAndGridLine(Image3, Image4, LGPDstBitmap);

    //PNG画像として保存
    if GetEncoderClsid('image/png', LImgGUID) >= 0 then begin
      LSaveFilePath := ExtractFilePath(LImgFilePath)
                     + ChangeFileExt(ExtractFileName(LImgFilePath), '') + '-Blur.png';
      LGPDstBitmap.Save(LSaveFilePath, LImgGUID);
    end;
  finally
    FreeAndNil(LGPGraphic);
    FreeAndNil(LGPBitmap);
    FreeAndNil(LGPBlurBitmap);
    FreeAndNil(LGPDstBitmap);
    FreeAndNil(LStream);
  end;
end;

//=============================================================================
//  CheckBox1のOnClickイベント処理
//  Gaussian BlurとBox Blur処理の切り換え
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  Button1Click(nil);
end;

//-----------------------------------------------------------------------------
//  実サイズと拡大してグリッド表示の画像を描画
//-----------------------------------------------------------------------------
procedure TForm1.DisplayImageAndGridLine(AImageCtrl, ARealSizeImage: TImage;
  TargetGPBitmap: TGPBitmap);
var
  LGPGraphics : TGPGraphics;
begin
  //TGPBitmapをTImageに描画
  if ARealSizeImage <> nil then begin
    ARealSizeImage.Picture.Assign(nil);
    LGPGraphics := TGPGraphics.Create(ARealSizeImage.Canvas.Handle);
    LGPGraphics.DrawImage(TargetGPBitmap, 0, 0);
    LGPGraphics.Free;
  end;
  if AImageCtrl = nil then exit;

  //ピクセルのグリッド表示
  DrawPixelColorToTImage(TargetGPBitmap, AImageCtrl, 6, 32, clGray, nil, False);
end;



05_添付のユニットのコード


本ページのサンプルで使用しているユニットのコードです．下表の関数を実装しています．



関数名 機能
GaussianBlur ガウスぼかしを使用してぼかし画像を作成する関数
CreateGaussianBlurShadow ガウスぼかしのマスク画像を作成する関数
BoxBlur ボックスぼかしを使用してぼかし画像を作成する関数
CreateBoxBlurShadow ボックスぼかしのマスク画像を作成する関数


Box Blur のコードは，以下のリンクの記事のコメントとして掲載されているコードを筆者が GDI+1.0 で使用可能なコードに変更しています．
元のコードは Delphi 2009 GDI+ Library 用となっています．

関数名と関数内の変数名はそのまま使用していますが，マスク画像の作成をピクセルを直接操作するコードに変更しています．元のカラーマトリックスによる色の平行移動では必ずしも指定の色にならない場合がありますが，この変更により，マスク画像の色の変更が有効にっています．また，不透明度も指定した色に対する値になります．



リスト5
添付のユニットのコード		 
unit plBlurGDIplus;

interface

uses
  Windows, SysUtils, Graphics, GDIPAPI, GDIPOBJ, GDIPUTIL;

  function GaussianBlur(AGPSrcBmp: TGPBitmap; ARadius: Integer;
    ARepeat: integer = 1): TGPBitmap;
  function CreateGaussianBlurShadow(ABitmap: TGPBitmap; ARadius: Integer;
    AOpacity: Double = 1.0; AColor: TColor = clNone): TGPBitmap;
  function BoxBlur(ABitmap: TGPBitmap; ARadius: Integer): TGPBitmap;
  function CreateBoxBlurShadow(ABitmap: TGPBitmap; ARadius: Integer;
    AOpacity: Double = 1.0; AColor: TColor = clNone): TGPBitmap;

implementation

uses
  Math;

//=============================================================================
//  ガウシアンぼかし(ガウスぼかし・Gaussian Blur)関数
//
//  戻り値のTGPBitmapはこの関数内で生成する
//  解放・破棄は呼出し側で実行する
//
//  AGPSrcBmp : 対象のTGPBitmap(この関数内では変更処理はしない)
//  ARadius   : ほかし計算の半径
//  ARepeat   : 繰り返し回数(2以上にすると平たい感じになる)
//=============================================================================
function GaussianBlur(AGPSrcBmp: TGPBitmap; ARadius: Integer;
  ARepeat: integer = 1): TGPBitmap;

  //---------------------------------------------------------------------------
  //  指定位置のPRGBQuadの値を取得
  //---------------------------------------------------------------------------
  function GetPRGBQuad(ABmpData: TBitmapData; APosY, APosX: Integer) : PRGBQuad;
  begin
    Result := ABmpData.Scan0;
    inc(PByte(Result), APosY * ABmpData.stride + APosX);
  end;
  //---------------------------------------------------------------------------

var
  LYRepeatCnt  : Integer;
  LXRepeatCnt  : Integer;
  LDiameter    : Integer;
  LImgWidth    : Integer;
  LImgHeight   : Integer;
  LPosX        : Integer;
  LPosY        : Integer;
  LPixel1      : Integer;
  LPixel2      : Integer;
  LCalcX       : Integer;
  LCalcY       : Integer;
  LBmpData     : TBitmapData;
  LpARGB       : PRGBQuad;
  LAlpha       : array of Integer;
  LRed         : array of Integer;
  LGreen       : array of Integer;
  LBlue        : array of Integer;
  LScanStart   : Integer;
  LBytesShift  : Integer;
begin
  Result := TGPBitmap(AGPSrcBmp.Clone);
  if ARadius <= 0 then exit;

  LDiameter   := (ARadius * 2) + 1;
  LBytesShift := SizeOf(TRGBQuad);

  LImgWidth  := Result.GetWidth- 1;
  LImgHeight := Result.GetHeight - 1;

  //TGPBitmapのビットマップデータ取得
  if Result.LockBits(MakeRect(0, 0, LImgWidth, LImgHeight),
                        ImageLockModeWrite or ImageLockModeRead,
                        PixelFormat32bppARGB, LBmpData) <> Ok then exit;

  //演算範囲を(幅x半径x2+1)に拡張
  SetLength(LAlpha, LImgWidth + 1 + (ARadius * 2));
  SetLength(LRed,   LImgWidth + 1 + (ARadius * 2));
  SetLength(LGreen, LImgWidth + 1 + (ARadius * 2));
  SetLength(LBlue,  LImgWidth + 1 + (ARadius * 2));

  for LPosY := 0 to LImgHeight do begin
    for LYRepeatCnt := 1 to ARepeat do begin
      LXRepeatCnt := -ARadius;
      while LXRepeatCnt <= LImgWidth + ARadius do begin
        LCalcX := LXRepeatCnt;
        if LCalcX < 0 then begin
          LCalcX := 0;
        end else
        if LCalcX >= LImgWidth then begin
          LCalcX := LImgWidth;
        end;

        LpARGB  := GetPRGBQuad(LBmpData, LPosY, LCalcX * LBytesShift);
        LPixel1 := LXRepeatCnt + ARadius;
        LPixel2 := LXRepeatCnt + ARadius - 1;

        LAlpha[LPixel1] := LpARGB^.rgbReserved + LAlpha[LPixel2];
        LRed  [LPixel1] := LpARGB^.rgbRed      + LRed  [LPixel2];
        LGreen[LPixel1] := LpARGB^.rgbGreen    + LGreen[LPixel2];
        LBlue [LPixel1] := LpARGB^.rgbBlue     + LBlue [LPixel2];

        inc(LXRepeatCnt);
      end;

      for LPosX := 0 to LImgWidth do begin
        LpARGB  := GetPRGBQuad(LBmpData, LPosY, LPosX * LBytesShift);
        LCalcX  := LPosX + ARadius;
        LPixel1 := LCalcX + ARadius;
        LPixel2 := LCalcX - 1 - ARadius;

        LpARGB^.rgbReserved := ((LAlpha[LPixel1] - LAlpha[LPixel2]) div LDiameter);
        LpARGB^.rgbRed      := ((LRed  [LPixel1] - LRed  [LPixel2]) div LDiameter);
        LpARGB^.rgbGreen    := ((LGreen[LPixel1] - LGreen[LPixel2]) div LDiameter);
        LpARGB^.rgbBlue     := ((LBlue [LPixel1] - LBlue [LPixel2]) div LDiameter);
      end;
    end;
  end;


  //演算範囲を(高さx半径x2+1)に拡張
  SetLength(LAlpha, LImgHeight + 1 + (ARadius * 2));
  SetLength(LRed,   LImgHeight + 1 + (ARadius * 2));
  SetLength(LGreen, LImgHeight + 1 + (ARadius * 2));
  SetLength(LBlue,  LImgHeight + 1 + (ARadius * 2));

  for LPosX := 0 to LImgWidth do begin
    for LYRepeatCnt := 1 to ARepeat do begin
      LScanStart  := 0;
      LXRepeatCnt := -ARadius;
      while LXRepeatCnt <= LImgHeight + ARadius do begin
        if (LXRepeatCnt > 0) and (LXRepeatCnt < LImgHeight) then begin
          inc(LScanStart);
        end;

        LpARGB  := GetPRGBQuad(LBmpData, LScanStart, LPosX * LBytesShift);
        LPixel1 := LXRepeatCnt + ARadius;
        LPixel2 := LXRepeatCnt + ARadius - 1;

        LAlpha[LPixel1] := LpARGB.rgbReserved + LAlpha[LPixel2];
        LRed  [LPixel1] := LpARGB.rgbRed      + LRed  [LPixel2];
        LGreen[LPixel1] := LpARGB.rgbGreen    + LGreen[LPixel2];
        LBlue [LPixel1] := LpARGB.rgbBlue     + LBlue [LPixel2];

        inc(LXRepeatCnt);
      end;

      for LPosY := 0 to LImgHeight do begin
        LpARGB  := GetPRGBQuad(LBmpData, LPosY, LPosX * LBytesShift);
        LCalcY  := LPosY + ARadius;
        LPixel1 := LCalcY + ARadius;
        LPixel2 := LCalcY - 1 - ARadius;

        LpARGB.rgbReserved := ((LAlpha[LPixel1] - LAlpha[LPixel2]) div LDiameter);
        LpARGB.rgbRed      := ((LRed  [LPixel1] - LRed  [LPixel2]) div LDiameter);
        LpARGB.rgbGreen    := ((LGreen[LPixel1] - LGreen[LPixel2]) div LDiameter);
        LpARGB.rgbBlue     := ((LBlue [LPixel1] - LBlue [LPixel2]) div LDiameter);
      end;
    end;
  end;
  Result.UnlockBits(LBmpData);

  SetLength(LAlpha, 0);
  SetLength(LRed, 0);
  SetLength(LGreen, 0);
  SetLength(LBlue, 0);
end;

//=============================================================================
//  ガウスぼかしを使用してほかし画像のマスク画像を作成する関数
//
//  戻り値のTGPBitmapはこの関数内で生成する
//  解放・破棄は呼出し側で実行する
//
//  ABitmap  : 対象のTGPBitmap(この関数内では変更処理はしない)
//  ARadius  : ほかし計算の半径
//  AOpacity : 不透明度(0.0 - 1.0)．0.0は完全な透明
//             1.0にすると単色の画像となり半透明のピクセルは生成しない
//  AColor   : マスク画像の色
//
//  不透明度と色の引数を省略すると周辺部も含めてぼかし画像となる
//=============================================================================
function CreateGaussianBlurShadow(ABitmap: TGPBitmap; ARadius: Integer;
  AOpacity: Double = 1.0; AColor: TColor = clNone): TGPBitmap;
var
  LShadow       : TGPBitmap;
  LClone        : TGPBitmap;
  LGraphics     : TGPGraphics;
  LShadowData   : TBitmapData;
  LColor        : TGPColor;
  LShadowWidth  : Integer;
  LShadowHeight : Integer;
  LScanLine     : PByte;
  LpRGBQuad     : PRGBQuad;
  LDataStride   : Integer;
  LXPos         : integer;
  LYPos         : Integer;
  LAlphaValue   : Byte;
begin
  ARadius := Max(ARadius, 0);
  LClone := TGPBitmap.Create(ABitmap.GetWidth + (4 * Cardinal(ARadius)),
                             ABitmap.GetHeight + (4 * Cardinal(ARadius)),
                             PixelFormat32bppARGB);
  LGraphics := TGPGraphics.Create(LClone);
  //ぼかし画像はぼかし領域サイズX2ピクセル分右下から描画
  //こうしないと矩形の上端と左端のほかしが切れてしまう
  //ぼかし画像の実際の描画位置は呼出し側で行う
  LGraphics.DrawImage(ABitmap,
                      MakeRect(2 * ARadius, 2 * ARadius,
                      ABitmap.GetWidth,
                      ABitmap.GetHeight),
                      0,
                      0,
                      ABitmap.GetWidth,
                      ABitmap.GetHeight,
                      UnitPixel);

  try
    LShadow := GaussianBlur(LClone, ARadius, 1);
    if (AColor <> clNone) or (AOpacity <> 1.0) then begin
      LShadowWidth  := LShadow.GetWidth;
      LShadowHeight := LShadow.GetHeight;
      LShadow.LockBits(MakeRect(0, 0, LShadowWidth, LShadowHeight),
                       ImageLockModeRead or ImageLockModeWrite,
                       PixelFormat32bppARGB,
                       LShadowData);

      LColor := ColorRefToARGB(AColor);

      LScanLine   := LShadowData.Scan0;
      LDataStride := LShadowData.Stride;

      for LYPos := 0 to LShadowHeight - 1 do begin
        LpRGBQuad := PRGBQuad(LScanLine);
        for LXPos := 0 to LShadowWidth - 1 do begin
          if LpRGBQuad^.rgbReserved <> 0 then begin
            LAlphaValue := Round(LpRGBQuad^.rgbReserved * AOpacity);
            LpRGBQuad^.rgbReserved := LAlphaValue;
            LpRGBQuad^.rgbRed   := GetRed(LColor);
            LpRGBQuad^.rgbGreen := GetGreen(LColor);
            LpRGBQuad^.rgbBlue  := GetBlue(LColor);
          end;
          Inc(LpRGBQuad);
        end;
        Inc(LScanLine, LDataStride);
      end;
    end;
    Result := TGPBitmap(LShadow.Clone);
  finally
    LShadow.UnlockBits(LShadowData);
    FreeAndNil(LClone);
    FreeAndNil(LShadow);
    FreeAndNil(LGraphics);
  end;
end;

//-----------------------------------------------------------------------------
//  Box Blurぼかし関数
//  以下のウェブページに掲載の関数をGDI+1.0用に変更したコード
//  (掲載のコードはDelphi 2009 GDI+ Library 用)
//  https://stackoverflow.com/questions/7364026/algorithm-for-fast-drop-shadow-in-gdi
//
//  戻り値のTGPBitmapはこの関数内で生成する
//  解放，破棄は呼出し側で行う
//
//  usesにMathが必要
//-----------------------------------------------------------------------------
procedure BoxBlur_Routine(const AData1, AData2: TBitmapData; AWidth, AHeight,
  ARadius: Integer);
const
  CHANNELS = 4;
var
  LScan1      : PByte;
  LScan2      : PByte;
  LSum        : array [0..CHANNELS-1] of Integer;
  LFirstValue : array [0..CHANNELS-1] of Integer;
  LLastValue  : array [0..CHANNELS-1] of Integer;
  LRadius2    : Integer;
  LStride     : Integer;
  LStart      : Integer;
  LChannel    : Integer;
  LLeft       : Integer;
  LRight      : Integer;
  LBottom     : Integer;
  LTop        : Integer;
  LRow        : Integer;
  LColumn     : Integer;
begin
  LScan1   := AData1.Scan0;
  LScan2   := AData2.Scan0;
  LRadius2 := (2 * ARadius) + 1;
  LStride  := AData1.Stride;

  for LRow := 0 to AHeight - 1 do begin
    LStart := LRow * LStride;
    LLeft  := LStart;
    LRight := LStart + ARadius * CHANNELS;
    for LChannel := 0 to CHANNELS - 1 do begin
      LFirstValue[LChannel] := LScan1[LStart + LChannel];
      LLastValue[LChannel] := LScan1[LStart + ((AWidth
                            - 1) * CHANNELS) + LChannel];
      LSum[LChannel] := (ARadius + 1) * LFirstValue[LChannel];
    end;

    for LColumn := 0 to ARadius - 1 do begin
      for LChannel := 0 to CHANNELS - 1 do begin
        LSum[LChannel] := LSum[LChannel] + LScan1[LStart
                        + (LColumn * CHANNELS) + LChannel];
      end;
    end;

    for LColumn := 0 to ARadius do begin
      for LChannel := 0 to CHANNELS - 1 do begin
        LSum[LChannel] := LSum[LChannel] + LScan1[LRight
                        + LChannel] - LFirstValue[LChannel];
        LScan2[LStart + LChannel] := Byte(LSum[LChannel] div LRadius2);
      end;
      Inc(LRight, CHANNELS);
      Inc(LStart, CHANNELS);
    end;

    for LColumn := ARadius + 1 to AWidth - ARadius - 1 do begin
      for LChannel := 0 to CHANNELS - 1 do begin
        LSum[LChannel] := LSum[LChannel] + LScan1[LRight + LChannel]
                        - LScan1[LLeft + LChannel];
        LScan2[LStart + LChannel] := Byte(LSum[LChannel] div LRadius2);
      end;
      Inc(LLeft, CHANNELS);
      Inc(LRight, CHANNELS);
      Inc(LStart, CHANNELS);
    end;

    for LColumn := AWidth-ARadius to AWidth-1 do begin
      for LChannel := 0 to CHANNELS - 1 do begin
        LSum[LChannel] := LSum[LChannel] + LLastValue[LChannel]
                        - LScan1[LLeft + LChannel];
        LScan2[LStart + LChannel] := Byte(LSum[LChannel] div LRadius2);
      end;
      Inc(LLeft, CHANNELS);
      Inc(LStart, CHANNELS);
    end;
  end;

  LStride := AData2.Stride;
  for LColumn := 0 to AWidth - 1 do begin
    LStart := LColumn * CHANNELS;
    LTop := LStart;
    LBottom := LStart + (ARadius * LStride);
    for LChannel := 0 to CHANNELS - 1 do begin
      LFirstValue[LChannel] := LScan2[LStart + LChannel];
      LLastValue[LChannel] := LScan2[LStart + ((AHeight - 1) * LStride) + LChannel];
      LSum[LChannel] := (ARadius + 1) * LFirstValue[LChannel];
    end;

    for LRow := 0 to ARadius-1 do begin
      for LChannel := 0 to CHANNELS - 1 do begin
        LSum[LChannel] := LSum[LChannel] + LScan2[LStart
                        + (LRow * LStride) + LChannel];
      end;
    end;

    for LRow := 0 to ARadius do begin
      for LChannel := 0 to CHANNELS - 1 do begin
        LSum[LChannel] := LSum[LChannel] + LScan2[LBottom + LChannel]
                        - LFirstValue[LChannel];
        LScan1[LStart + LChannel] := Byte(LSum[LChannel] div LRadius2);
      end;
      Inc(LBottom, LStride);
      Inc(LStart, LStride);
    end;

    for LRow := ARadius + 1 to AHeight - ARadius - 1 do begin
      for LChannel := 0 to CHANNELS - 1 do begin
        LSum[LChannel] := LSum[LChannel] + LScan2[LBottom
                        + LChannel] - LScan2[LTop + LChannel];
        LScan1[LStart + LChannel] := Byte(LSum[LChannel] div LRadius2);
      end;
      Inc(LTop, LStride);
      Inc(LBottom, LStride);
      Inc(LStart, LStride);
    end;

    for LRow := AHeight - ARadius to AHeight-1 do begin
      for LChannel := 0 to CHANNELS - 1 do begin
        LSum[LChannel] := LSum[LChannel] + LLastValue[LChannel]
                        - LScan2[LTop + LChannel];
        LScan1[LStart + LChannel] := Byte(LSum[LChannel] div LRadius2);
      end;
      Inc(LTop, LStride);
      Inc(LStart, LStride);
    end;
  end;
end;

//=============================================================================
//  ボックスぼかし(Box Blur)を使用してほかし画像のマスク画像を作成する関数
//
//  戻り値のTGPBitmapはこの関数内で生成する
//  解放・破棄は呼出し側で実行する
//
//  ABitmap  : 対象のTGPBitmap(この関数内では変更処理はしない)
//  ARadius  : ほかし計算の半径
//  AOpacity : 不透明度(0.0 - 1.0)．0.0は完全な透明
//             1.0にすると単色の画像となり半透明のピクセルは生成しない
//  AColor   : マスク画像の色
//
//  不透明度と色の引数を省略すると周辺部も含めてぼかし画像となる
//
//  usesにMathが必要
//=============================================================================
function CreateBoxBlurShadow(ABitmap: TGPBitmap; ARadius: Integer;
  AOpacity: Double = 1.0; AColor: TColor = clNone): TGPBitmap;
var
  LShadow       : TGPBitmap;
  LClone        : TGPBitmap;
  LGraphics     : TGPGraphics;
  LShadowData   : TBitmapData;
  LCloneData    : TBitmapData;
  LColor        : TGPColor;
  LShadowWidth  : Integer;
  LShadowHeight : Integer;
  LCloneWidth   : Integer;
  LCloneHeight  : Integer;
  LScanLine     : PByte;
  LpRGBQuad     : PRGBQuad;
  LDataStride   : Integer;
  LXPos         : integer;
  LYPos         : Integer;
  LAlphaValue   : Byte;
begin
  ARadius := Max(ARadius, 0);
  LShadow := TGPBitmap.Create(ABitmap.GetWidth + (4 * Cardinal(ARadius)),
                              ABitmap.GetHeight + (4 * Cardinal(ARadius)),
                              PixelFormat32bppARGB);
  LGraphics := TGPGraphics.Create(LShadow);
  //ぼかし画像はぼかし領域サイズX2ピクセル分右下から描画
  //こうしないと矩形の上端と左端のほかしが切れてしまう
  //ぼかし画像の実際の描画位置は呼出し側で行う
  LGraphics.DrawImage(ABitmap, MakeRect(2 * ARadius, 2 * ARadius,
                                        ABitmap.GetWidth,
                                        ABitmap.GetHeight),
                                        0,
                                        0,
                                        ABitmap.GetWidth,
                                        ABitmap.GetHeight,
                                        UnitPixel);
  LClone := TGPBitmap(LShadow.Clone);
  LShadowWidth := LShadow.GetWidth;
  LShadowHeight := LShadow.GetHeight;
  LShadow.LockBits(MakeRect(0, 0, LShadowWidth, LShadowHeight),
                   ImageLockModeRead or ImageLockModeWrite,
                   PixelFormat32bppARGB,
                   LShadowData);

  LCloneWidth  := LClone.GetWidth;
  LCloneHeight := LClone.GetHeight;
  LClone.LockBits(MakeRect(0, 0, LCloneWidth, LCloneHeight),
                  ImageLockModeRead or ImageLockModeWrite,
                  PixelFormat32bppARGB,
                  LCloneData);

  try
    BoxBlur_Routine(LShadowData, LCloneData, LShadowWidth, LShadowHeight, ARadius - 1);
    BoxBlur_Routine(LShadowData, LCloneData, LShadowWidth, LShadowHeight, ARadius - 1);
    BoxBlur_Routine(LShadowData, LCloneData, LShadowWidth, LShadowHeight, ARadius);

    if (AColor <> clNone) or (AOpacity <> 1.0) then begin
      LColor := ColorRefToARGB(AColor);

      LScanLine   := LShadowData.Scan0;
      LDataStride := LShadowData.Stride;

      for LYPos := 0 to LShadowHeight - 1 do begin
        LpRGBQuad := PRGBQuad(LScanLine);
        for LXPos := 0 to LShadowWidth - 1 do begin
          if LpRGBQuad^.rgbReserved <> 0 then begin
            LAlphaValue := Round(LpRGBQuad^.rgbReserved * AOpacity);
            LpRGBQuad^.rgbReserved := LAlphaValue;
            LpRGBQuad^.rgbRed   := GetRed(LColor);
            LpRGBQuad^.rgbGreen := GetGreen(LColor);
            LpRGBQuad^.rgbBlue  := GetBlue(LColor);
          end;
          Inc(LpRGBQuad);
        end;
        Inc(LScanLine, LDataStride);
      end;
    end;
    Result := TGPBitmap(LShadow.Clone);
  finally
    LShadow.UnlockBits(LShadowData);
    LClone.UnlockBits(LCloneData);
    FreeAndNil(LClone);
    FreeAndNil(LShadow);
    FreeAndNil(LGraphics);
  end;
end;

//=============================================================================
//  Box Blurぼかし関数を使用して画像の矩形領域内のぼかし画像を作成する関数
//
//  戻り値のTGPBitmapはこの関数内で生成する
//  解放，破棄は呼出し側で行う
//
//  ABitmap  : 対象のTGPBitmap(この関数内では変更処理はしない)
//  ARadius  : ほかし計算の半径
//
//  usesにMathが必要
//=============================================================================
function BoxBlur(ABitmap: TGPBitmap; ARadius: Integer): TGPBitmap;
var
  LShadow       : TGPBitmap;
  LClone        : TGPBitmap;
  LGraphics     : TGPGraphics;
  LShadowData   : TBitmapData;
  LCloneData    : TBitmapData;
  LShadowWidth  : Integer;
  LShadowHeight : Integer;
  LCloneWidth   : Integer;
  LCloneHeight  : Integer;
begin
  ARadius := Max(ARadius, 0);
  LShadow := TGPBitmap.Create(ABitmap.GetWidth,
                              ABitmap.GetHeight,
                              PixelFormat32bppARGB);

  LGraphics := TGPGraphics.Create(LShadow);
  LGraphics.DrawImage(ABitmap, MakeRect(0, 0,
                                        ABitmap.GetWidth,
                                        ABitmap.GetHeight),
                                        0,
                                        0,
                                        ABitmap.GetWidth,
                                        ABitmap.GetHeight,
                                        UnitPixel);
  LClone := TGPBitmap(LShadow.Clone);
  LShadowWidth := LShadow.GetWidth;
  LShadowHeight := LShadow.GetHeight;
  LShadow.LockBits(MakeRect(0, 0, LShadowWidth, LShadowHeight),
                   ImageLockModeRead or ImageLockModeWrite,
                   PixelFormat32bppARGB,
                   LShadowData);

  LCloneWidth  := LClone.GetWidth;
  LCloneHeight := LClone.GetHeight;
  LClone.LockBits(MakeRect(0, 0, LCloneWidth, LCloneHeight),
                  ImageLockModeRead or ImageLockModeWrite,
                  PixelFormat32bppARGB,
                  LCloneData);

  try
    BoxBlur_Routine(LShadowData, LCloneData, LShadowWidth, LShadowHeight, ARadius - 1);
    BoxBlur_Routine(LShadowData, LCloneData, LShadowWidth, LShadowHeight, ARadius - 1);
    BoxBlur_Routine(LShadowData, LCloneData, LShadowWidth, LShadowHeight, ARadius);

    Result := TGPBitmap(LShadow.Clone);
  finally
    LShadow.UnlockBits(LShadowData);
    LClone.UnlockBits(LCloneData);
    FreeAndNil(LClone);
    FreeAndNil(LShadow);
    FreeAndNil(LGraphics);
  end;
end;

end.

end.