Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2023年10月04日] [更新 2023年10月04日]　Delphi 一般・その他
   
袋文字 / 白抜き文字の描画
動作確認等 Windows 10 ビルド 19043 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
[整理番号 - 1230]






袋文字 / 白抜き文字の描画


文字 (フォント) の輪郭だけを描画する，いわゆる「袋文字」(outline character) を描画するサンプルです．パスの機能を使用しています．





01_袋文字の描画


実際のコードと実行結果です．
TCanvas の TBrush.Color で文字の色を設定して， TCanvas の TPen.Width の値で輪郭線の太さを設定して描画しています．

VCL の標準機能でもいろいろな装飾ができますが，GDI+ を使用すると，以下のリンクのサンプルのように，いろいろなバリエーションの装飾が可能です．


図1
実行結果

リスト1 
implementation

{$R *.dfm}

var
    FPointArray     : TByteArray;
    FPointKindArray : TByteArray;
    FPointCount     : Integer;

//=============================================================================
//  パスのデータを取得して描画開始
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LText : string;
begin
  Canvas.Font.Name := 'メイリオ';
  Canvas.Font.Size    := 100;
  Canvas.Font.Charset := DEFAULT_CHARSET;
  Canvas.Brush.Style := bsClear;

  // バスの記録
  BeginPath(Canvas.Handle);
  LText := '袋文字';
  Canvas.Textout(40, 40, LText);
  EndPath(Canvas.Handle);

  // パスの座標値の格納に必要な数を取得して配列に格納
  FPointCount := GetPath(Canvas.Handle, FPointArray, FPointKindArray, 0);
  GetPath(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);

  // パス情報が取得できたので再描画
  Invalidate;
end;


//=============================================================================
//  OnPaint イベント
//  パスのデータを使用して実際に文字を描画する
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
begin
  // 取得したパス情報で図形を描画
  BeginPath(Canvas.Handle);
  PolyDraw(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);
  EndPath(Canvas.Handle);

  // 現在のブラシでバスの内部を塗りつぶし，現在のペンで輪郭線を描画する
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clLime;
  Canvas.Pen.Color   := clBlack;
  Canvas.Pen.Width   := 3;
  StrokeAndFillPath(Canvas.Handle);
end;



02_白抜き文字の描画


TCanvas の TBrush.Color を白にすると「白抜き文字」になります．


図2
実行結果

リスト2 
implementation

{$R *.dfm}

var
    FPointArray     : TByteArray;
    FPointKindArray : TByteArray;
    FPointCount     : Integer;

//=============================================================================
//  パスのデータを取得して描画開始
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LText : string;
begin
  Canvas.Font.Name := 'メイリオ';
  Canvas.Font.Size    := 60;
  Canvas.Font.Charset := DEFAULT_CHARSET;
  Canvas.Brush.Style := bsClear;

  // バスの記録
  BeginPath(Canvas.Handle);
  LText := '白抜き文字';
  Canvas.Textout(40, 70, LText);
  EndPath(Canvas.Handle);

  // パスの座標値の格納に必要な数を取得して配列に格納
  FPointCount := GetPath(Canvas.Handle, FPointArray, FPointKindArray, 0);
  GetPath(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);

  // パス情報が取得できたので再描画
  Invalidate;
end;


//=============================================================================
//  OnPaint イベント
//  パスのデータを使用して実際に文字を描画する
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
begin
  // 取得したパス情報で図形を描画
  BeginPath(Canvas.Handle);
  PolyDraw(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);
  EndPath(Canvas.Handle);

  // 現在のブラシでバスの内部を塗りつぶし，現在のペンで輪郭線を描画する
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Color   := clBlack;
  Canvas.Pen.Width   := 3;
  StrokeAndFillPath(Canvas.Handle);
end;



03_白抜き文字の描画 - フォントの太さを変更


TLogFont レコード型の lfWeight メンバの値を変更すると，フォントの太さを変更できます．
lfWeight メンバの設定可能な値は 0 から 1000 です．0 の時は 既定の太さです．400 は標準の太さです．このサンプルでは最大の 1000 を設定してています．


図3
実行結果

リスト3 
implementation

{$R *.dfm}

var
    FPointArray     : TByteArray;
    FPointKindArray : TByteArray;
    FPointCount     : Integer;

//=============================================================================
//  パスのデータを取得して描画開始
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LLogFont : TLogFont;
  LText    : string;
begin
  GetObject(Canvas.Font.Handle,SizeOf(LLogFont),@LLogFont);
  LLogFont.lfWeight := 1000;
  Canvas.Font.Handle := CreateFontIndirect(LLogFont);

  Canvas.Font.Name := 'メイリオ';
  Canvas.Font.Size    := 60;
  Canvas.Font.Charset := DEFAULT_CHARSET;
  Canvas.Brush.Style := bsClear;

  // バスの記録
  BeginPath(Canvas.Handle);
  LText := '白抜き文字';
  Canvas.Textout(40, 70, LText);
  EndPath(Canvas.Handle);

  // パスの座標値の格納に必要な数を取得して配列に格納
  FPointCount := GetPath(Canvas.Handle, FPointArray, FPointKindArray, 0);
  GetPath(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);

  // パス情報が取得できたので再描画
  Invalidate;
end;


//=============================================================================
//  OnPaint イベント
//  パスのデータを使用して実際に文字を描画する
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
begin
  // 取得したパス情報で図形を描画
  BeginPath(Canvas.Handle);
  PolyDraw(Canvas.Handle, FPointArray, FPointKindArray, FPointCount);
  EndPath(Canvas.Handle);

  // 現在のブラシでバスの内部を塗りつぶし，現在のペンで輪郭線を描画する
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Color   := clBlack;
  Canvas.Pen.Width   := 5;
  StrokeAndFillPath(Canvas.Handle);
end;