VCLのDirectWriteで背景透過文字描画 (ID:151237)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

mam様　大変申し訳ありません！ 実は……先程とあるサイトを参考にすることで目的を果たすことができたのです。すいません、もっと早くこの掲示板を確認しておけばよかったです。対策コーディングを頂きまして本当に感謝いたします。まだ目を通していませんが、高い技術力に圧倒されております。必ず試させていただきます。

私のほうで出た結論をいいますと最初に提示したサンプルコードでDirectWriteはちゃんと機能していました。機能していなかったのはこれです。
Png.Assign(Bmp);
まさにmam様の「アルファチャネルは自力でPNGに入れる必要がある」が正解のようです。

ネットを巡り巡ってたどりついたのがオランダのサイトで、そこに衝撃の一文がありました。
「唯一の問題は PngImage.Assign(Bitmap) を使用して TPngImage にビットマップを割り当てると、アルファチャネルが失われることです」
https://www.bverhue.nl/delphisvg/2016/09/26/save-bitmap-with-transparency-as-png-in-vcl/

……ズッコケました。なんのためのアルファ付きビットマップなのかと。なにはともあれオランダの方が対策コードも載せてくれていたので、ありがたく使用させていただいたところ無事目的を果たすことができました。下記の画像がその結果です。吐き出したPNGを適当な静止画の上にのせたものですが、アンチエイリアス部分がしっかり馴染んでいます。
https://ibb.co/jhcmgBC

本当にお騒がせして申し訳ありませんでした。また、さまざまなご助言をいただきましてありがとうございました。下記私のほうで完成させたコードです。素人コーディングなので間違いがありましたらご指導ください。

uses
  Winapi.D2D1, Vcl.Direct2D, Vcl.Imaging.pngimage;

// アルファ付きBitmapからアルファ付きPNGを生成する（by BVerhue氏）
function PNG4TransparentBitMap(aBitmap: TBitmap): TPNGImage;
const
  CMaxSize = 8000;
type
  TRGB = packed record B, G, R: byte end;
  TRGBA = packed record B, G, R, A: byte end;
  TRGBAArray = array [0..CMaxSize] of TRGBA;
var
  BmpRGBA: ^TRGBAArray;
  PngRGB: ^TRGB;
  X, Y: Integer;
begin
  Result := TPNGImage.CreateBlank(COLOR_RGBALPHA, 8, aBitmap.Width, aBitmap.Height);
  Result.CreateAlpha;
  Result.Canvas.CopyMode := cmSrcCopy;
  Result.Canvas.Draw(0, 0, aBitmap);
  for Y := 0 to Pred(aBitmap.Height) do
  begin
    BmpRGBA := aBitmap.ScanLine[Y];
    PngRGB := Result.ScanLine[Y];
    for X := 0 to Pred(aBitmap.Width) do
    begin
      Result.AlphaScanline[Y][X] := BmpRGBA[X].A;
      if aBitmap.AlphaFormat in [afDefined, afPremultiplied] then
      begin
        if BmpRGBA[X].A <> 0 then
        begin
          // ※引用元が間違っていると思われるので修正しました。
          PngRGB^.B := Round(BmpRGBA[X].B * BmpRGBA[X].A / 255);
          PngRGB^.R := Round(BmpRGBA[X].R * BmpRGBA[X].A / 255);
          PngRGB^.G := Round(BmpRGBA[X].G * BmpRGBA[X].A / 255);
        end
        else
        begin
          PngRGB^.B := Round(BmpRGBA[X].B * 255);
          PngRGB^.R := Round(BmpRGBA[X].R * 255);
          PngRGB^.G := Round(BmpRGBA[X].G * 255);
        end;
      end;
      Inc(PngRGB);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  CFileName = 'C:\Users\xxx\ドキュメント\Test.png';
  CText = '文字サンプル';
  CWidth = 310;
  CHeight = 80;
var
  D2DCanvas: TDirect2DCanvas;
  TextFormat: IDWriteTextFormat;
  TextLayout: IDWriteTextLayout;
  Bmp: TBitmap;
  Png: TPNGImage;
  pf: TD2D1Point2F;
  r: TRect;
begin
  Bmp := TBitmap.Create;
  Png := nil;
  try
    // アルファ付きBitmapとする
    Bmp.PixelFormat := pf32bit;
    Bmp.AlphaFormat := afDefined;
    Bmp.Transparent := true;
    Bmp.SetSize(CWidth, CHeight);
    // DirectWriteによる文字描画
    r := Rect(0, 0, CWidth, CHeight);
    D2DCanvas := TDirect2DCanvas.Create(Bmp.Canvas, r);
    try
      D2DCanvas.BeginDraw;
      D2DCanvas.RenderTarget.Clear(D2D1ColorF(0.0, 0.0, 0.0, 0.0));
      DWriteFactory.CreateTextFormat(PWideChar('メイリオ'), nil,
        DWRITE_FONT_WEIGHT_NORMAL, DWRITE_FONT_STYLE_NORMAL,
        DWRITE_FONT_STRETCH_NORMAL, 47, 'ja-jp', TextFormat);
      DWriteFactory.CreateTextLayout(PWideChar(CText), Length(CText), TextFormat, 0,
        0, TextLayout);
      TextLayout.SetWordWrapping(DWRITE_WORD_WRAPPING_NO_WRAP);
      D2DCanvas.Font.Brush.Color := clBlue;
      pf.X := 10;
      pf.Y := 10;
      D2DCanvas.RenderTarget.DrawTextLayout(pf, TextLayout,
        D2DCanvas.Font.Brush.Handle, D2D1_DRAW_TEXT_OPTIONS_NONE);
      D2DCanvas.EndDraw;
    finally
      D2DCanvas.Free;
    end;
    // アルファ付きBitmapからアルファ付きPNGを生成する
    Png := PNG4TransparentBitMap(Bmp);
    Png.SaveToFile(CFileName);
  finally
    Png.Free;
    Bmp.Free;
  end;
end;

←解決時は質問者本人がここをチェックしてください。

戻る