Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年01月01日] [更新 2016年04月17日]　Delphi サンプルプログラム集
180_斜体フォントの幅
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
Delphi 2009 以降専用
180_ItalicTextWidth.zip　[1,077 KB]　 2016年04月17日版 (EXE 同梱)



  • 2016年04月17日
  • DHGL を使用する文字列幅の取得サンプルを追加



01_斜体フォントの幅


斜体フォントの幅を求めるサンプルです．
斜体フォントでテキストを描画して，そのテキストの幅と高さを取得します．そして，その描画領域の矩形を描画します．斜体フォントの幅は，GetCharABCWidths 関数を使用して，下図のようなフォントの ABC 幅と呼ばれる値を取得して計算しています．

True Type でないフォントの場合は，GetCharWidth32 関数を使用します．本サンプルは True Type フォントを対象にしています．
斜体フォントについては，中村拓男さんの著書に詳しい説明があります．



図1
フォントの ABC 幅の意味

下図が設計時と実行時の画面です．フォームの Canvas に描画するので，ボタンが 1 つだけです．


図2
設計時画面
図3
実行画面
  • 上は標準の文字スタイルの場合

欧文フォントのテスト結果です．フォントの設定を次のコードに変更して実行しています．
欧文フォントは，Charset の値が SHIFTJIS_CHARSET の場合，フォント名の設定が反映されないことがあることに注意してください．

結果を見ると，先頭の文字 A が枠の左側に少しはみ出ています．これは，先頭の文字の ABC 幅を考慮していないためです．これを回避するには，先頭の文字の ABC 幅を計算して，描画開始位置と描画幅を計算する必要があります． 



  Canvas.Font.Name    := 'Times New Roman';
  Canvas.Font.Charset := ANSI_CHARSET;


図4
欧文フォントでの実行例

リスト1
斜体フォントの幅を計算する 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    function ItalicTextWidth(ACanvas:TCanvas; AFont:TFont; Text:String): Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  テスト実行
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrText    : String;
  LTextWidth  : Integer;
  LTextHeight : Integer;
  LTop        : Integer;
  LLeft       : Integer;
begin
  LStrText := '列的の文字列';

  LTop  := 40;
  LLeft := 8;

  //描画に使用する共通のフォント設定
  Canvas.Font.Name    := 'ＭＳ Ｐゴシック';
  Canvas.Font.Charset := SHIFTJIS_CHARSET;

  //普通の書体でFormのCanvasに文字列を描画
  Canvas.Font.Style   := [];
  Canvas.Brush.Color  := clWhite;
  Canvas.Font.Size    := 38;
  Canvas.TextOut(LLeft, LTop, LStrText);

  LTextWidth  := ItalicTextWidth(Canvas, Canvas.Font, LStrText);
  LTextHeight := Canvas.TextHeight(LStrText);

  //文字列を囲む領域に矩形を描画
  Canvas.Brush.Color := clBlack;
  Canvas.FrameRect(Rect(LLeft, LTop, LLeft + LTextWidth, LTop + LTextHeight));


  //斜体フォントにして描画
  LTop := LTop + LTextHeight + 10;
  Canvas.Font.Style  := [fsItalic];
  Canvas.Brush.Color := clWhite;
  Canvas.TextOut(LLeft, LTop, LStrText);

  //文字列の幅を取得して，文字列を囲む領域に矩形を描画
  LTextWidth := ItalicTextWidth(Canvas, Canvas.Font, LStrText);
  Canvas.Brush.Style := bsClear;
  Canvas.Rectangle(LLeft, LTop, LLeft + LTextWidth, LTop + LTextHeight);
end;

//=============================================================================
//  文字列の幅(通常，斜体のテキスト幅)を求める関数
//
//  ACanvas : テキストを描画するCanvas
//  AFont   : テキスト描画に使用するフォント
//  Text    : 描画テキスト文字列
//=============================================================================
function TForm1.ItalicTextWidth(ACanvas:TCanvas; AFont:TFont; Text: String): Integer;
var
  LpStrText : PChar;
  LCode     : Cardinal;
  LABCwidth : TABC;
begin
  if not(Assigned(AFont)) or (Text = '') then begin
    Result := 0;
  end else begin
    //最後の文字のABC幅だけ求めればよい
    LpStrText := AnsiLastChar(Text);

    if LpStrText^ in LeadBytes then begin
      LCode := (Ord(LpStrText^) shl 8) + Ord((LpStrText + 1)^);
    end else begin
      LCode := Ord(LpStrText^);
    end;

    GetCharABCWidths(ACanvas.Handle, LCode, LCode, LABCwidth);
    //結果は負数なので...
    Result := ACanvas.TextWidth(Text) - (LABCwidth.abcC);
  end;
end;

end.



02_ABC 幅を含めた文字列の長さ - DHGL の関数を使用


上のサンプルで示したように，文字列の長さを正確に取得するには，ABC 幅 (ペアリング) の値が必要であることが分かりました．
中村拓男氏で提供している DHGL に，TextUtils というユニットがあります．このユニットに ABC 幅を取得するための関数が実装されています．以下は，その関数を使用した結果と，テスト用のサンプルのコードです．



図5
ABC 幅を含めた文字列の長さ
  • 細線は，文字列の幅と高さの四角形
  • 上は，単純に TCanvas.TextWidth 関数で取得した場合
  • 下が ABC 幅を考慮した場合

リスト2
ABC 幅を含めた文字列の長さ - DHGL の関数を使用 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMainForm = class(TForm)
    FontDialog: TFontDialog;
    FontChangeButton: TButton;
    procedure FontChangeButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  MainForm: TMainForm;

implementation

uses
  TextUtils;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TMainForm.FormCreate(Sender: TObject);
begin
  FontDialog.Font := Font;
end;

//=============================================================================
//  [フォント変更]ボタン
//  フォントによる違いがあるかを確認するため
//=============================================================================
procedure TMainForm.FontChangeButtonClick(Sender: TObject);
begin
  if FontDialog.Execute then begin
    Canvas.Font := FontDialog.Font;
    Invalidate;
  end;
end;

//=============================================================================
//  フォームのOnPaintイベント処理
//  文字列の幅の取得
//  ABC幅を含める場合と含めない場合の違いの確認用
//
//  GetTextAAdjust 関数
//    文字列の最初の文字のベアリング(A幅)が負の時の値にその値を正の整数値で返す
//  GetTextCAdjust 関数
//    文字列の最後の文字のベアリング(C幅)が負の時にその値を正の整数値で返す
//
//  usesにTextUtils(中村拓男氏作)が必要
//=============================================================================
procedure TMainForm.FormPaint(Sender: TObject);
var
  LText       : string;
  LAAdjust    : Integer;
  LCAdjust    : Integer;
  LTextWidth  : Integer;
  LTextHeight : Integer;
  LLeft       : Integer;
  LTop        : Integer;
begin
  //描画する文字列
  LText := 'fontf';

  //文字のABC幅関係の値を取得
  LAAdjust := TextUtils.GetTextAAdjust(Canvas, LText);
  LCAdjust := TextUtils.GetTextCAdjust(Canvas, LText);

  //描画開始位置
  LLeft := 20;
  LTop  := 50;

  LTextWidth  := Canvas.TextWidth(LText);
  LTextHeight := Canvas.TextHeight(LText);

  //ABC幅を考慮しない場合
  Canvas.Brush.Style := bsSolid;
  Canvas.TextOut(LLeft, LTop, LText);
  Canvas.Brush.Style := bsClear;
  Canvas.Rectangle(LLeft,
                   LTop,
                   LLeft + LTextWidth,
                   LTop + LTextHeight);

  //ABC幅を考慮した場合
  LTop := LTop + LTextHeight + 30;
  Canvas.Brush.Style := bsSolid;
  Canvas.TextOut(LLeft + LAAdjust, LTop, LText);
  Canvas.Brush.Style := bsClear;
  Canvas.Rectangle(LLeft,
                   LTop,
                   LLeft + LTextWidth + LAAdjust + LCAdjust,
                   LTop + LTextHeight);

end;

end.