Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2000年12月12日] [更新 2016年04月18日]　印刷プレビュー制御コンポーネント
印刷プレビュー制御コンポーネント
特殊な文字列
動作確認等 図は Windows 7 U64(SP1) + Delphi XE(UP1) Pro で作成






方向と幅指定の文字列 


TextSpecial(X, Y, R, V, Text)

方向と文字幅を指定して文字列を描画します．ワープロ専用機のような横倍角などの文字列の作成が可能です (もういいかげんにワープロ専用機を使うのはやめてほしいです)．

引数 型 説明
X Integer 描画開始 X 座標値．R=0 の横書きの場合は左端の X 座標値
Y Integer 描画開始の Y 座標値．R=0 の横書きの場合は上端の Y 座標値
R Integer 1 度単位の反時計回りが正の回転角度．R=270 の時は縦書き
V Integer 文字の幅．1 パーセント単位で指定
Text String 描画する文字列


図1
上が通常の文字で下が横倍角文字




上下左右反転ミラー文字列


特殊な文字列を描画する際の参考コードです．
上下または左右を反転した文字列，いわゆるミラー文字列を描画します．


図2
設計時の画面
図3
左右反転ミラー文字列
図4
左右を反転して，上下も反転した文字列

リスト1
左右を反転，または上下を反転した文字列を描画するサンプル		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    plPrev1: TplPrev;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure DrawTextToplPrevCanvas(AplPrev: TplPrev; X1, Y1, X2, Y2: Integer;
      AText : string; AFont: TFont);
    procedure SwapIntValue(var A: Integer; var B: Integer);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Printers;

{$R *.DFM}

//====================================================================
//  ミラー文字列(反転文字列)のテスト
//
//  動作確認 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
//====================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFont    : TFont;
  LX1      : Integer;
  LX2      : Integer;
  LY1      : Integer;
  LY2      : Integer;
  LTextLen : Integer;
  LText    : String;
begin
  LText := 'テスト文字列';

  plPrev1.plSetPrinter.Orientation := poLandscape;

  plPrev1.BeginDoc;
  try
    LFont := TFont.Create;
    try
      LX1 := 200;
      LY1 := 300;
      LY2 := LY1+500;

      //通常の文字の描画
      plPrev1.Canvas.Font.Height :=  LY2 - LY1;
      plPrev1.TextOut(LX1, LY1, LText);
      //文字列の長さを求める
      LTextLen  := plPrev1.Canvas.TextWidth(LText);
      LX2 := LX1 + LTextLen;
      //文字列を囲む枠を描画
      plPrev1.Rectangle(LX1, LX2, LY1, LY2);


      //反転文字の色等を設定
      LFont.Assign(plPrev1.Canvas.Font);
      LFont.Color := clGreen;
      plPrev1.Canvas.Pen.Color := clRed;
      LY1 := LY2 + 400;
      LY2 := LY1 + 500;

      //左右反転ミラーの指定
      if CheckBox1.Checked then begin
        SwapIntValue(LX1, LX2);
      end;

      //上下反転ミラーの指定
      if CheckBox2.Checked then begin
        SwapIntValue(LY1, LY2);
      end;

      //文字列の描画
      DrawTextToplPrevCanvas(plPrev1, LX1, LY1, LX2, LY2, LText, LFont);
      //文字列を囲む枠を描画
      plPrev1.Rectangle(LX1, LX2, LY1, LY2);
    finally
      FreeAndNil(LFont);
    end;
  finally
    plPrev1.EndDoc;
  end;

  //プレビュー開始
  plPrev1.ShowModal;
end;

//-----------------------------------------------------------------------------
//  文字列をを引数で指定する範囲に描画する関数
//  メタファイルに文字列を描画して，そのメタファイルをTplPrevのCanvasに描画
//
//  メタファイルは，座標値を入れ替えることで反転ミラー文字の描画が可能だが，
//  ここではメタファイルには通常のTextOutで描画している
//  メタファイルをTplPrev.StretchDrawMetaFileで描画する際に座標値を入れ替えている
//-----------------------------------------------------------------------------
procedure TForm1.DrawTextToplPrevCanvas(AplPrev: TplPrev; X1, Y1, X2, Y2: Integer;
  AText: string; AFont: TFont);
var
  LMetaFile : TMetafile;
  LCanvas   : TMetaFileCanvas;
  LWidth    : Integer;
  LHeight   : Integer;
begin
  LMetaFile      := TMetafile.Create;
  LMetaFile.Inch := 0;

  try
    LCanvas  := TMetafileCanvas.Create(LMetaFile, 0);
    try
      //メタファイルに必要なサイズを求める
      LCanvas.Font.Assign(AFont);
      LWidth  := LCanvas.TextWidth(AText);
      LHeight := LCanvas.TextHeight(AText);
      //一旦描画を終了してメタファイルのサイズを設定
      LCanvas.Free;
      LMetaFile.Width  := LWidth;
      LMetaFile.Height := LHeight;

      //メタファイルCanvasを再生成
      LCanvas  := TMetafileCanvas.Create(LMetaFile, 0);
      LCanvas.Font.Assign(AFont);
      //メタファイルに通常にテキスト描画
      LCanvas.Brush.Style := bsClear;
      LCanvas.TextOut(0, 0, AText);
    finally
      LCanvas.Free;
    end;

    //TplPrevのCanvasにメタファイルを描画
    AplPrev.StretchDrawMetaFile(Rect(X1, Y1, X2, Y2), LMetaFile);
  finally
    LMetaFile.Free;
  end;
end;

//-----------------------------------------------------------------------------
//  変数の交換(入替え)関数
//-----------------------------------------------------------------------------
procedure TForm1.SwapIntValue(var A, B: Integer);
var
  LTemp : Integer;
begin
  LTemp := A;
  A := B;
  B := LTemp;
end;

end.



上下左右反転ミラー文字列と文字列の回転


特殊な文字列を描画する際の参考コードです．
回転した文字列を描画し，更に，上下または左右を反転した文字列を描画します．必要な部分を取り出して利用してください．


図5
設計時の画面
図6
通常の文字列の回転
  • 赤丸は，回転の中心座標
図7
左右を反転して，上下も反転した文字列
  • 赤丸は，回転の中心座標

リスト2
文字列の回転と，上下左右の反転を行うサンプル		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    plPrev1: TplPrev;
    RadioGroup1: TRadioGroup;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure DrawTextToplPrevCanvas(AplPrev: TplPrev; X1, Y1, X2, Y2: Integer;
      ARotate: Integer; AText: string; AFont: TFont);
    procedure SwapIntValue(var A: Integer; var B: Integer);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Math;

{$R *.DFM}

//====================================================================
//  ミラー文字列(反転文字列)と回転文字列のテスト
//
//  動作確認 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
//  三角関数等の計算にはusesにMathが必要
//====================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFont : TFont;
  LCenterX    : Integer;
  LCenterY    : Integer;
  LX2         : Integer;
  LY2         : Integer;
  LXX1        : Integer;
  LXX2        : Integer;
  LYY1        : Integer;
  LYY2        : Integer;
  LTextLen    : Integer;
  LTestText   : string;
  LBlankText  : string;
  LDrawHeight : Integer;
  LRotate     : Integer;
  LRotateRad  : Double;
begin
  LBlankText := '    ';
  LTestText  := 'テスト' + LBlankText;

  plPrev1.BeginDoc;
  try
    LFont := TFont.Create;
    LDrawHeight := 250;
    try
      //回転の中心座標値
      LCenterX := plPrev1.PaperWidth div 2;
      LCenterY := plPrev1.PageHeight div 2;
      LY2      := LCenterY + LDrawHeight;

      //フォント高さ等
      plPrev1.Canvas.Font.Height := LY2 - LCenterY;
      LFont.Assign(plPrev1.Canvas.Font);
      LFont.Color := clGreen;
      plPrev1.Canvas.Pen.Color := clRed;

      //文字列の長さを求める
      LTextLen := plPrev1.Canvas.TextWidth(LTestText);
      LX2 := LCenterX + LTextLen;

      //文字列を囲む枠を描画
      plPrev1.Rectangle(LCenterX, LX2, LCenterY, LY2);
      //回転中心の丸
      plPrev1.PenColor(clRed);
      plPrev1.BrushColor(clRed);
      plPrev1.Circle(LCenterX,LCenterY, 100);


      //以下は，上で描画した矩形の左上を回転の中心とした場合のコード

      //左右反転ミラー文字の回転
      if RadioGroup1.ItemIndex = 0 then begin
        LTestText := LBlankText + 'テスト';

        LRotate := 0;
        while True do begin
          if LRotate >= 360 then break;

          LRotateRad := DegToRad(LRotate);

          //描画開始と描画終点の座標値を計算
          LXX1 := LCenterX - LTextLen + (Round(LTextLen * Cos(LRotateRad)));
          LXX2 := LXX1 + LTextLen;
          LYY1 := LCenterY - (Round(LTextLen * Sin(LRotateRad)));
          LYY2 := LY2 - (Round(LTextLen * Sin(LRotateRad)));

          SwapIntValue(LXX1, LXX2);

          LFont.Color := clGreen;
          LTestText   := 'テスト' + LBlankText;
          DrawTextToplPrevCanvas(plPrev1,
                                 LXX1,
                                 LYY1,
                                 LXX2,
                                 LYY2,
                                 LRotate,
                                 LTestText,
                                 LFont);
          inc(LRotate, 45);
        end;
      end else

      //上下反転ミラー文字の回転
      if RadioGroup1.ItemIndex = 1 then begin
        LTestText := LBlankText + 'テスト';

        LRotate := 0;
        while True do begin
          if LRotate >= 360 then Break;

          //描画開始と描画終点の座標値を計算
          LRotateRad := DegToRad(LRotate);
          LXX1 := LCenterX + Round(LDrawHeight * Sin(LRotateRad));
          LXX2 := LXX1 + LTextLen;
          LYY1 := LCenterY - LDrawHeight + (Round(LDrawHeight * Cos(LRotateRad)));
          LYY2 := LY2 - LDrawHeight + (Round(LDrawHeight * Cos(LRotateRad)));

          SwapIntValue(LYY1, LYY2);

          LFont.Color := clGreen;
          DrawTextToplPrevCanvas(plPrev1,
                                 LXX1,
                                 LYY1,
                                 LXX2,
                                 LYY2,
                                 LRotate,
                                 LTestText,
                                 LFont);
          inc(LRotate, 45);
        end;

      end else begin
        //通常文字の回転
        LTestText := LBlankText + 'テスト';

        LRotate := 0;
        while True do begin
          if LRotate >= 360 then break;

          DrawTextToplPrevCanvas(plPrev1,
                                 LCenterX,
                                 LCenterY,
                                 LX2,
                                 LY2,
                                 LRotate,
                                 LTestText,
                                 LFont);
          inc(LRotate, 45);
        end;
      end;
    finally
      FreeAndNil(LFont);
    end;
  finally
    plPrev1.EndDoc;
  end;

  //プレビュー開始
  plPrev1.FormHeight := 550;
  plPrev1.FormWidth  := 600;
  plPrev1.ShowModal;
end;

//-----------------------------------------------------------------------------
//  文字列をを引数で指定する範囲に描画する関数
//  文字列の回転を引数で指定する
//  メタファイルに文字列を描画して，そのメタファイルをTplPrevのCanvasに描画
//
//  メタファイルは，座標値を入れ替えることで反転ミラー文字の描画が可能だが，
//  ここではメタファイルには通常のTextOutで描画している
//  メタファイルをTplPrev.StretchDrawMetaFileで描画する際に座標値を入れ替えている
//-----------------------------------------------------------------------------
procedure TForm1.DrawTextToplPrevCanvas(AplPrev: TplPrev; X1, Y1, X2, Y2: Integer;
  ARotate: Integer; AText: string; AFont: TFont);
var
  LMetaFile : TMetafile;
  LCanvas   : TMetaFileCanvas;
  LWidth    : Integer;
  LHeight   : Integer;
  LLogFont  : TLogFont;
begin
  LMetaFile      := TMetafile.Create;
  LMetaFile.Inch := 0;

  try
    LCanvas  := TMetafileCanvas.Create(LMetaFile, 0);
    try
      //メタファイルに必要なサイズを求める
      LCanvas.Font.Assign(AFont);
      LWidth  := LCanvas.TextWidth(AText);
      LHeight := LCanvas.TextHeight(AText);
      //一旦描画を終了してメタファイルのサイズを設定
      LCanvas.Free;
      LMetaFile.Width  := LWidth;
      LMetaFile.Height := LHeight;
      //メタファイルCanvasを再生成
      LCanvas  :=TMetafileCanvas.Create(LMetaFile, 0);

      LCanvas.Font.Assign(AFont);
      //メタファイルに通常にテキスト描画
      LCanvas.Brush.Style := bsClear;

      //回転文字を作成(ARotateはこの関数の引数で，単位は度)
      GetObject(LCanvas.Font.Handle, SizeOf(LLogFont), @LLogFont);
      LLogFont.lfEscapement := ARotate * 10;
      LCanvas.Font.Handle   := CreateFontIndirect(LLogFont);

      LCanvas.TextOut(0, 0, AText);
    finally
      LCanvas.Free;
    end;

    //TplPrevのCanvasにメタファイルを描画
    AplPrev.StretchDrawMetaFile(Rect(X1, Y1, X2, Y2), LMetaFile);
  finally
    LMetaFile.Free;
  end;
end;

//-----------------------------------------------------------------------------
//  変数の交換(入替え)関数
//-----------------------------------------------------------------------------
procedure TForm1.SwapIntValue(var A, B: Integer);
var
  LTemp : Integer;
begin
  LTemp := A;
  A := B;
  B := LTemp;
end;

end.