フォントの斜体の右端がきれてしまう (ID:7282)

名前

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

本文

これはABC幅というやつですね．詳しい説明は省略します．
FormにButtonを一つ配置して，以下のコードを実行してみて下さい．
なお，拙作の印刷プレビューコンポーネントの文字列描画では，この
描画方法をサポートしていません．(^_^);

procedure TForm1.Button1Click(Sender: TObject);
var
     S: String;
     P: PChar;
     Code: UINT;
     ABC: TABC;
     NormalWidth: Integer;
     ItalicWidth: Integer;
     AHeight: Integer;
begin
     S:='目的の文字列';

{普通?の書体でFormのCanvasに文字列を描画}
     {その周囲に矩形を描画}
     Canvas.Brush.Color := clWhite;
     Canvas.Font.Size:=50;
     Canvas.TextOut(20,100,s);
     NormalWidth:=Canvas.TextWidth(S);
     AHeight    :=Canvas.TextHeight(S);
     Canvas.Brush.Color := clBlack;
     Canvas.FrameRect(Rect(20,100,20+NormalWidth,100+AHeight));

{Fontを斜体にして描画}
     Canvas.Brush.Color := clWhite;
     Canvas.Font.Style:=[fsItalic];
     Canvas.TextOut(20,200,s);

{最後の文字のABC幅だけ求めればよい}
     {GetCharABC...はTrueTypeFontのABC幅を求める関数}
     P:=AnsiStrLastChar(PChar(S));
     {最初のバイトを検査}
     if P^ in LeadBytes then begin
       Code:=(Ord(P^) shl 8)+Ord((P+1)^);
     end else begin
       Code:=Ord(P^);
     end;
     GetCharABCWidths(Canvas.Handle,Code,Code,ABC);
     {結果は負数なので...}
     ItalicWidth:=Canvas.TextWidth(S)-ABC.abcC;
     {文字列描画領域に矩形を描画}
     Canvas.Brush.Style:=bsClear;
     Canvas.Rectangle(20,200,20+ItalicWidth,200+AHeight);
end;

end.

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

戻る