この発言に対し以下のコメントが寄せられています

#00884　凛              さん　RE:WYSIWYGの例　viewportを使う




ViewPortを使ったWYSIWYGのサンプルです。
もっと練ってからUpしようと思ったのですが、あまりのびのびになるのも何だ
し、、(^^; 　結構使いよさげなのにあんまり使われていないようなので
どうなんですかね？　FontはsizeではなくHeightで指定するのがポイントです。
何かありましたら是非つっこみよろしくお願いいたします。m(_ _)m


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
Dialogs,
  StdCtrls, Spin,printers;

type
  TForm1 = class(TForm)
    Button1: TButton;
    xx: TSpinEdit;
    yy: TSpinEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
     procedure 
wyswygDraw(targetCanvas:TCanvas;Org:TPoint;Scale:Extended);
     procedure LoMMDraw(targetCanvas:TCanvas;Org:TPoint);
     procedure DrawW(theCanvas:TCanvas);
     procedure DrawM(theCanvas:TCanvas);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//Canvas上で見える大きさと同じ大きさでプリンタに印字する
procedure 
TForm1.wyswygDraw(targetCanvas:TCanvas;Org:TPoint;Scale:Extended);
var
   ScreenX,ScreenY,DrawX,DrawY:integer;
   pp:pPoint;
begin
   //この例では self.canvasを使う
   ScreenX:=GetDeviceCaps(canvas.handle,LOGPIXELSX);
   ScreenY:=GetDeviceCaps(canvas.handle,LOGPIXELSY);

   DrawX  :=Trunc(GetDeviceCaps(targetCanvas.handle,LOGPIXELSX)*Scale);
   DrawY  :=Trunc(GetDeviceCaps(targetCanvas.handle,LOGPIXELSY)*Scale);

   SetMapMode      (targetCanvas.Handle, MM_ANISOTROPIC);
   SetViewportExtEx(targetCanvas.Handle, DrawX  ,DrawY  , nil);
   SetWindowExtEx  (targetCanvas.Handle, ScreenX,ScreenY, nil);
   new(pp);
   SetViewportOrgEx(targetCanvas.Handle, Org.X*DrawX div 
ScreenX,Org.Y*DrawY div ScreenY,pp);

   DrawW(targetCanvas);
   SetMapMode      (targetCanvas.Handle, MM_TEXT);
   SetViewportOrgEx(targetCanvas.Handle, pp^.x,pp^.y,nil);
   dispose(pp);
end;

//絶対値指定で描画 1が0.1mmに相当 
//org手抜き
procedure TForm1.LoMMDraw(targetCanvas:TCanvas;Org:TPoint);
begin
   SetMapMode      (targetCanvas.Handle, MM_LOMETRIC);
   DrawM(targetCanvas);
end;

//絶対値指定用 描画ルーチン
procedure TForm1.DrawM(theCanvas:TCanvas);
var
   i,y:integer;
   s:string;
begin
   s:='poo';
   with theCanvas do
   begin
      for i:= 1 to 10 do
      begin
         Pen.Width:=i*10;
         Font.height:=i*10;
         y:=-(i*100+100);
         MoveTo(0,y);
         LineTo(100,y);
         TextOut(150,y,s);
      end;
   end;
end;

//Canvasとwysiwygするルーチン
procedure TForm1.DrawW(theCanvas:TCanvas);
var
   i,y:integer;
   s:string;
begin
   s:='poo';
   with theCanvas do
   begin
      for i:= 1 to 20 do
      begin
         Pen.Width:=i;
         Font.height:=i;
         y:=(i*30+10);
         MoveTo(0,y);
         LineTo(100,y);
         TextOut(150,y,s);
      end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   wyswygDraw(canvas,Point(100,100),1);
   LoMMDraw(canvas,Point(200,0));
   printer.beginDoc;
   wyswygDraw(printer.canvas,Point(100,100),1);
   LoMMDraw(printer.canvas,Point(200,0));
   printer.EndDoc;
end;

end.
                                 99/01/08(金) 23:49 凛(MXB01744)

Original document by 凛              氏 ID:(MXB01744)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。