▼ KSCさん
> ただ、フォントサイズの計算が面倒かも...。
そうなんですよね．これが難問です．
そう言えば，前にDelphi-MLだった思うんですが，この反転文字列，
ミラー文字列というらしいです．質問があったような気がします．
質問された方は，確か? 型抜きだったか，とにかくミラー文字が必要な理由を
書いていました．その時は，「なるほどこんな必要性もあるんだ」と
納得した記憶があります．
少し考えながら，Q and A にカキコしながら，また考えたんですが，
もしかしたら，こういうことではないのかと．
1. TextOutで描画した場合
描画開始始点は(X1,Y1)であるが，終点は文字列の長さとサイズに
によって違ってくる
2. StretchDrawMetaFileの場合
(X1,Y1)と(X2,Y2)で設定した範囲内にStretchDrawされている
の違いかも知れません．
以下コードです．KSCさんの画像を参考に，少し修正しました．
でも，こうやって，動作内容の画像を添付していただけると嬉しいです．
理解しやすいです．
作成する方は大変でしょうけど．
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(X1,Y1,X2,Y2: Integer; Text : String; AFont: TFont);
procedure AdjustFont(Canvas : TCanvas);
procedure SwapIntValue(var A: Integer; var B: Integer);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//====================================================================
// 先読み方式のコード
// ミラー文字列(反転文字列)のテスト1
//
// TPrinerによる印刷同様，BeginDoc〜EndDocメソッドを使用する.
// (必要に応じてNewPageメソッドを使用)
// 印刷(描画)コードは本コンポーネントのCanvasを使用する．
//
// 2009年02月27日版
// 前版からの変更
// ・InverseStringの引数に座標値を追加
// ・変数の交換(入替え)関数を追加
// ・描画文字列を変数に格納
// ・TextOutで描画した文字列を追加
// ・描画文字列を囲む枠を描画
//====================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
AFont : TFont;
X1 : Integer;
X2 : Integer;
Y1 : Integer;
Y2 : Integer;
L : Integer;
TestText : String;
begin
TestText := 'テストデータ';
plPrev1.plSetPrinter.Orientation:=poLandscape;
plPrev1.BeginDoc;
try
AFont := TFont.Create;
try
X1 := 200;
X2 := 2200;
Y1 := 300;
Y2 := Y1+500;
//通常の文字の描画
plPrev1.Canvas.Font.Height := Y2-Y1;
plPrev1.TextOut(X1,Y1,TestText);
//文字列の長さを求める
L := plPrev1.Canvas.TextWidth(TestText);
//文字列を囲む枠を描画
plPrev1.Rectangle(X1,X1+L,Y1,Y2);
//反転文字の描画
AFont.Assign(plPrev1.Canvas.Font);
AFont.Color := clGreen;
plPrev1.Canvas.Pen.Color := clRed;
Y1 := Y2+400;
Y2 := Y1+500;
InverseString(X1,Y1,X2,Y2,TestText,AFont);
//文字列を囲む枠を描画
plPrev1.Rectangle(X1,X2,Y1,Y2);
finally
FreeAndNil(AFont);
end;
finally
plPrev1.EndDoc;
end;
plPrev1.ShowModal;
end;
//=============================================================================
// 左右の反転文字(ミラー文字列)作成メソッド
// メタファイルに描画して，それを印刷プレビュー制御コンポーネントのCanvasに
// 描画する
//============================================================================
procedure TForm1.InverseString(X1,Y1,X2,Y2: Integer; 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;
//左右を反転させるために右と左の座標を入替える
SwapIntValue(X1,X2);
ARect.Left := X1;
ARect.Right := X2;
ARect.Top := Y1;
ARect.Bottom := Y2;
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;
//=============================================================================
// 変数の交換(入替え)関数
//============================================================================
procedure TForm1.SwapIntValue(var A: Integer; var B: Integer);
var
Temp : Integer;
begin
Temp := A;
A := B;
B := Temp;
end;
end.
EXEファイルのダウンロードの内容も変更しておきました．
http://mrxray.on.coocan.jp/counter/DLCounterEx/lime.cgi?plPrev001
 |
