この発言に対し以下のコメントが寄せられています

#01400　geo             さん　RE:フォントを滑らかに





nifty:FDELPHI/MES/9/05118 , nifty:FDELPHI/MES/9/05163 で話題に上って
いるフォントのスムージング（アンチエイリアス）のサンプルです。
半透過での描画も出来るようにしてみました(^^)。




uses Math;

 //合成用のサブルーチン
procedure DrawTextSub(TextBmp, DestBmp: TBitmap; V2: Integer);
type
  TRGB = Packed Record
    R, G, B, X: Byte;
  end;
  PRGBQuad = ^TRGBQuad;       
  TRGBQuad = Packed Record    
    B, G, R, X: Byte;
  end;
var
  xx, yy: Integer;
  Weight: Byte;
  TextColor: TRGB;
  tcR, tcG, tcB: Byte;
  TextSL, DestSL: PRGBQuad;
begin
  TextColor := TRGB(ColorToRGB(DestBmp.Canvas.Font.Color));
  tcR := TextColor.R;  tcG := TextColor.G;  tcB := TextColor.B;
                                 //文字色をＲＧＢに分解
  for yy := 0 to TextBmp.Height - 1 do
  begin
    TextSL := TextBmp.ScanLine[yy];
    DestSL := DestBmp.ScanLine[yy];
    for xx := 0 to TextBmp.Width - 1 do
    begin
      Weight := TextSL^.R;    //Weight は赤の値で代表させる
      if Weight > 0 then      //Weight = 0 の時は何もしなくてよい
      begin
        Weight := Min(Weight * V2 div 100, 255);       //濃度の計算
        DestSL.R := (DestSL.R * not Weight + tcR * Weight) div 255;
        DestSL.G := (DestSL.G * not Weight + tcG * Weight) div 255;
        DestSL.B := (DestSL.B * not Weight + tcB * Weight) div 255;
                                                //合成処理
      end;
      Inc(TextSL);
      Inc(DestSL);
    end;
  end;
end;

 //メインルーチン
 //DestCanvas は対象のキャンバス
 //x, y は文字描画の基準位置
 //Text は描画する文字列
 //V1 は拡縮の倍率、2,3,4 位が適当
 //V2 は合成の濃度、100 が標準
procedure DrawText(DestCanvas: TCanvas; x, y: Integer;
                             Text: String; V1, V2: Integer);
var
  TextBmp, DestBmp: TBitmap;
begin
  TextBmp := TBitmap.Create;
  try
    with TextBmp do
    begin
      PixelFormat := pf32bit;
      Canvas.Font.Assign(DestCanvas.Font);    
                        //対象キャンバスのフォントをコピー
      Canvas.Font.Size := Canvas.Font.Size * V1;
                        //フォントサイズを V1 倍にする
      Canvas.Font.Color := clWhite;
      Canvas.Brush.Color := clBlack;

      Width := Canvas.TextWidth(Text);
      Height := Canvas.TextHeight(Text);
                        //サイズを文字列に合せる
      Canvas.TextOut(0, 0, Text);
    end;

{
    ここで、TextBmp に対して 1 / V1 の縮小処理を行ってください
}

    DestBmp := TBitmap.Create;
    try
      with DestBmp do
      begin
        PixelFormat := pf32bit;

        Width := TextBmp.Width;
        Height := TextBmp.Height;
                           //サイズを TextBmp に合わせる
        Canvas.CopyRect(Rect(0, 0, Width, Height), DestCanvas,
                               Rect(x, y, Width + x, Height + y));
                           //背景画像を対象キャンバスから切り出す
        Canvas.Font.Color := DestCanvas.Font.Color;
                           //文字色の受け渡し
      end;

      DrawTextSub(TextBmp, DestBmp, V2);  //合成ルーチンにかける
      DestCanvas.Draw(x, y, DestBmp);     //対象キャンバスに描き戻す

    finally
      DestBmp.Free;
    end;

  finally
    TextBmp.Free;
  end;
end;


○使い方
　　対象キャンバスのフォントを適宜セットして
　　DrawText を呼び出します

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  with Form1.Canvas do
  begin
    Font.Name := 'ＭＳ 明朝';
    Font.Charset := SHIFTJIS_CHARSET;
    Font.Size := 24;
    Font.Color := clYellow;
  end;
  
  for i := 0 to Memo1.Lines.Count - 1 do
  begin
    DrawText(Form1.Canvas, 20, i * 50, Memo1.Lines[i], 4, 100);
  end;
end;


○補足
(1)Math ユニットの Min 関数を大した意味も無く使ってます(^^;。
(2)TextBmp は本来 pf8bit で十分なんですが、自前の画像縮小ルーチンが
フルカラー専用だったため、その流れで pf32bit になりました(^^;。
(3)画像縮小ルーチンは各自用意してください(^^;。
(4)TRGBQuad は Windows.pas にもありますが、わざわざ自前で定義したの
は rgbRed,rgbGreen,rgbBlue というのがとても見づらいからです(^^;。
(5)V1, V2 という引数名はとても分かりづらいので、適当な名前にしてやっ
てください(^^;。


geo / BYQ01321
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 00/09/16 -

Original document by geo             氏 ID:(BYQ01321)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。