| [2175] Re3:やってみて、質問です？ | 返信 削除 |
| 2009/2/27 (金) 18:55:15 Mr.XRAY |
|
▼ 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ファイルのダウンロードの内容も変更しておきました．  |
