(*
　数学関数で描画したい時や、TChartを使う程でもない
単純なグラフの描画なんかに.
*)
 
type
  TRcRect=record
    Left, Top, Right, Bottom: Double;
  end;
 
  TRcPoint=record
    X, Y: Double;
  end;
 
  TRealCoord = class
    Canvas: TCanvas;                          { 出力先 Canvas }
    World: TRcRect;                           { 実座標 表示範囲 }
    View: TRect;                              { 画面 表示範囲 }
    RatioX, RatioY: Double;                   { 換算比 }
    constructor Create(Dest: TCanvas);
    procedure ReCalc;
    function Vx(const x: Double): integer;    { X座標 変換 }
    function Vy(const y: Double): integer;    { Y座標 変換 }
    function Wp(const pt: TPoint): TRcPoint;  { 画面->実座標 変換 }
  end;
 
{ 以下 implementation }
 
constructor TRealCoord.Create(Dest: TCanvas);
begin
  Canvas:=Dest;
  with World do  begin
    Left:=0.0;   Top:=0.0;    Right:=105.0;    Bottom:=105.0;
  end;
  View:=Rect(0, 0, 105, 105);
  RatioX:=1.0;
  RatioY:=1.0;
end;
 
procedure TRealCoord.ReCalc;
begin
  RatioX := (View.Right-View.Left) / (World.Right-World.Left);
  RatioY := (View.Bottom-View.Top) / (World.Bottom-World.Top);
end;
 
function TRealCoord.vx(const x: Double): integer;
begin
  Result:=round( (x - World.Left)*RatioX );
end;
 
function TRealCoord.vy(const y: Double): integer;
begin
  Result:=round( (World.Bottom - y)*RatioY );
end;
 
function TRealCoord.wp(const pt: TPoint): TRcPoint;
begin
  Result.X:=pt.X / RatioX + World.Left;
  Result.Y:=World.Bottom - pt.Y / RatioY;
end;
 
 
{ ---------- 使用例 ---------- }
{ PaintBox上に折れ線を描きます }
 
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    rc: TRealCoord;
  end;
 
{ 以下 implementation }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  rc:=TRealCoord.Create(PaintBox1.Canvas);
  with rc.World do  begin
    Left:=0; Top:=0; Right:=10000; Bottom:=4000;
  end;
end;
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
var i: integer;
begin
  rc.View:=Rect(0, 0, PaintBox1.ClientWidth, PaintBox1.ClientHeight);
  rc.ReCalc;
  rc.Canvas.MoveTo(0,0);
  for i:=0 to 500 do  begin
    rc.Canvas.LineTo(rc.Vx(i*20), rc.Vy(random(3000)+i*2));
  end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  PaintBox1.Refresh;
end;
 
 
                                                ＹＨ

Original document by YH              氏 ID:(BYI15567)

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