C# でやったように、マスクを作って切り抜き、貼り付けをおこなう Crop SmoothEdge および
SetAlpha32 に相当する関数を Delphi でつくった。

上の画像は、マスクのエッジをぼかして滑らかにし、しかも重ね描き部分を一様にアルファ値を80%に
したものである。
GDI+ と違って、従来からの GDI では画像にアルファ値を含めて描画することはできない。
したがって、C# のときと同じ論理では Delphi では同じことはできない。 しかし、ここで
やったように、マスクさえうまく加工することができれば、画像同士の間では自前でアルファブレンドできる。
したがって、すでにライブラリに入っている MaskedOverlay() に与えるマスク画像をどうやってつくるか、
が問題である。
今回作ったのは Crop() と同じ論理でマスクをつくり、それをグレースケール専用の
GaussianBlur でぼかして SmoothEdge と同じ効果を与えるための関数二つと、
できたマスクを一様に薄めることによって SetAlpha32() と同じことをする関数、計3つ
である。
この関数をテストするために簡単なアプリをつくった。

図中の画像は、左からアルファ値が 100%、75%、50% である。また、マスクのエッジをぼかす
割合を可変にすると

左から、SmoothArea が ゼロ、1、3 である。 はめ込み部分のエッジが滑らかになっている。
今回つくった3つの関数部分のソースを記録しておく。
uses
Clipbrd, VCLImageUtils;
function GaussianBlur8(bmp: TBitmap; zone:integer = 2): Boolean;
var
tmp: TBItmap;
src, dst: TBmpData8;
d: PByte;
w, h, i, x, y, ix, iy, range: integer;
count, dd, gauss: single;
gf: array of single;
begin
result := false;
if bmp.PixelFormat <> pf8bit then exit;
if (zone < 1) or (zone > 30) then exit;
w := bmp.Width;
h := bmp.Height;
range := zone*3;
SetLength(gf,range+1);
for i := 0 to range do
gf[i] := exp(-i*i/(2*zone*zone));
tmp := BmpClone(bmp);
src := TBmpData8.Create(tmp);
dst := TBmpData8.Create(bmp);
// at first, bmp -> tmp (x blur)
for y := 0 to h-1 do
for x := 0 to w-1 do
begin
count := 0;
dd := 0;
for ix := x-range to x+range do
begin
if (ix<0) or (ix>w-1) then continue;
d := dst[ix,y];
gauss := gf[abs(ix-x)];
dd := dd+d^*gauss;
count := count+gauss;
end;
src[x,y]^ := AdjustByte(dd/count);
end;
// second, tmp -> bmp (y blur)
for y := 0 to h-1 do
for x := 0 to w-1 do
begin
count := 0;
dd := 0;
for iy := y-range to y+range do
begin
if (iy<0) or (iy>h-1) then continue;
d := src[x, iy];
gauss := gf[abs(iy-y)];
dd := dd+d^*gauss;
count := count+gauss;
end;
dst[x,y]^ := AdjustByte(dd/count);
end;
src.Free;
dst.Free;
tmp.Free;
result := true;
end;
function SetAlphaOnMask8(mask8: TBitmap; Alphapercent: integer): Boolean;
var
w, h, y, x: integer;
m: TBmpData8;
begin
result := false;
if (AlphaPercent < 0) or (AlphaPercent > 100) then exit;
if mask8.PixelFormat <> pf8bit then exit;
w := mask8.Width;
h := mask8.Height;
m := TBmpData8.Create(mask8);
for y := 0 to h-1 do
for x := 0 to w-1 do
if m[x, y]^ <> 0 then
m[x, y]^ := AdjustByte(m[x, y]^ * AlphaPercent / 100.0);
m.Free;
result := true;
end;
function MakeMask8(maskBmp: TBitmap; maskColor: TColor; Invert: Boolean;
AlphaPercent: integer; Tolerance: integer; SmoothArea : integer = 1): TBitmap;
var
mask8: TBitmap;
w, h, y, x, rr, gg, bb: integer;
rgb: LongInt;
s: TBmpData24;
m: TBmpData8;
ps: PRGBTriple;
sa: double;
begin
mask8 := TBitmap.Create;
mask8.PixelFormat := pf8Bit;
w := maskBmp.Width;
h := maskBmp.Height;
mask8.Width := w;
mask8.Height := h;
SetGrayPalette(mask8);
rgb := ColorToRGB(maskColor);
rr := GetRValue(rgb);
gg := GetGValue(rgb);
bb := GetBValue(rgb);
s := TBmpData24.Create(maskBmp);
m := TBmpData8.Create(mask8);
if Invert then
begin
for y := 0 to h-1 do
for x := 0 to w-1 do
begin
ps := s[x, y];
sa := Sqrt((rr - ps^.rgbtRed)*(rr - ps^.rgbtRed) +
(gg - ps^.rgbtGreen)*(gg - ps^.rgbtGreen) +
(bb - ps^.rgbtBlue)*(bb - ps^.rgbtBlue));
if sa > Tolerance then
m[x, y]^ := 0
else
m[x, y]^ := 255;
end;
end
else
begin
for y := 0 to h-1 do
for x := 0 to w-1 do
begin
ps := s[x, y];
sa := Sqrt((rr - ps^.rgbtRed)*(rr - ps^.rgbtRed) +
(gg - ps^.rgbtGreen)*(gg - ps^.rgbtGreen) +
(bb - ps^.rgbtBlue)*(bb - ps^.rgbtBlue));
if sa > Tolerance then
m[x, y]^ := 255
else
m[x, y]^ := 0;
end;
end;
s.Free;
m.Free;
if SmoothArea > 0 then GaussianBlur8(mask8, SmoothArea);
if AlphaPercent < 100 then SetAlphaOnMask8(mask8, AlphaPercent);
result := mask8;
end;
MakeMask8 に与える maskBmp は以下のようなもの。

また、base 画像と overlay 画像は既出のものを流用した。
base:

overlay:

[MakeMask8 SetAlphaOnMask8 GaussianBlur8]


















































