喫茶XRAY [Mr.XRAY掲示板]

> 大変遅くなりましたが，こんな方法はどうでしょう．
> メタファイルで描画するやり方です．

おおっと，コードを示していませんでした．
[170_MetaFile描画でImageサイズ調整]
http://mrxray.on.coocan.jp/Delphi/plSamples/170_ImageMetaFile.htm
を利用したものです．
私のWindows XP(SP3)で文字幅が正常に表示しませんので，今回修正しました．

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  plPrev, StdCtrls, plSetPrinter,ExtCtrls,Printers;

type
  TForm1 = class(TForm)
    Button1: TButton;
    plPrev1: TplPrev;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure InverseString(Text : String; AFont: TFont);
    procedure AdjustFont(Canvas : TCanvas);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//====================================================================
//  先読み方式のコード
//  反転文字のテスト1
//
//  TPrinerによる印刷同様，BeginDoc～EndDocメソッドを使用する.
//  (必要に応じてNewPageメソッドを使用)
//  印刷(描画)コードは本コンポーネントのCanvasを使用する．
//====================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
     APos  : TPoint;
     AFont : TFont;
begin
     plPrev1.plSetPrinter.Orientation:=poLandscape;
     plPrev1.BeginDoc;
     try
       plPrev1.Canvas.Font.Height:=100;
       plPrev1.Canvas.Pen.Width:=5;
       plPrev1.Line(200,1000,600,600);
       plPrev1.TextOutRT(1000,600,'喫茶XRAY');

       //反転文字の描画
       AFont := TFont.Create;
       try
         AFont.Assign(plPrev1.Canvas.Font);
         AFont.Color := clGreen;
         InverseString('左右反転文字',AFont);
       finally
         FreeAndNil(AFont);
       end;
     finally
       plPrev1.EndDoc;
     end;
     plPrev1.ShowModal;
end;
//=============================================================================
//  反転文字作成メソッド
//  メタファイルに描画して，それを印刷プレビュー制御コンポーネントのCanvasに
//  描画する
//============================================================================
procedure TForm1.InverseString(Text: String; AFont: TFont);
var
    AMetaFile : TMetafile;
    ACanvas   : TMetaFileCanvas;
    AWidth    : Integer;
    AHeight   : Integer;
    ARect     : TRect;
begin
    AMetaFile      := TMetafile.Create;
    AMetaFile.Inch := 0;

    try
      ACanvas:=TMetafileCanvas.Create(AMetaFile,0);
      try
        //メタファイルに必要なサイズを求める
        ACanvas.Font.Assign(AFont);
        AWidth :=ACanvas.TextWidth(Text);
        AHeight:=ACanvas.TextHeight(Text);
        //一旦描画を終了してメタファイルのサイズを設定
        ACanvas.Free;
        AMetaFile.Width :=AWidth;
        AMetaFile.Height:=AHeight;
        //メタファイルCanvasを再生成
        ACanvas  :=TMetafileCanvas.Create(AMetaFile,0);
        ACanvas.Font.Assign(AFont);
        //フォントを正しく設定
        AdjustFont(ACanvas);

        ACanvas.Brush.Style:=bsClear;
        ACanvas.TextOut(0,0,Text);
      finally
        ACanvas.Free;
      end;
      //ARect.Left   := 200;
      //ARect.Right  := 2200;
      //左右を反転させるために右と左の座標を入替える
      ARect.Left   := 2200;
      ARect.Right  := 200;
      ARect.Top    := 800;
      ARect.Bottom := 1500;
      plPrev1.StretchDrawMetaFile(ARect,AMetaFile);
    finally
      AMetaFile.Free;
    end;
end;
//=============================================================================
//  フォントの縦横サイズが正確に取得できない現象の回避関数
//  フォント幅が0の時に文字幅を設定する
//  中村拓男著「Delphi Graphic Secrets」P141のコードそのまま
//============================================================================
procedure TForm1.AdjustFont(Canvas: TCanvas);
var
    tm : TTextMetric;
    lf : TLogFont;
begin
    GetObject(Canvas.Font.Handle, SizeOf(lf), @lf);
    if lf.lfWidth=0 then begin
      GetTextMetrics(Canvas.Handle, tm);
      lf.lfWidth := -lf.lfHeight * tm.tmAveCharWidth div tm.tmHeight;
      Canvas.Font.Handle := CreateFontIndirect(lf);
    end;
end;

end.