楕円と直線の交点

 楕円と直線の交点を求めるプログラムの更新をしました。
新しいプログラムは、楕円に傾きが有っても、交点を求めることが出来ます。
単に、傾きが無いように座標変換をし、元の座標に戻しています。

 左図は、楕円と直線の交点を求める方法をまとめたものです。
楕円の傾きについては、無いものとして取り扱っています。
傾きがある場合は、楕円の傾きをゼロなるように、座標変換をして計算をします。
楕円の中心が原点になるようにすると、計算が簡単になります。
 角度θで楕円の中心を通る直線の交点を求めるのも検討してみましたが、傾きtan(θ)の直線が、楕円の中心を通る直線なので、容易に計算が出来ます。
プログラムは、直線の両端の座標を指定することで、交点を求めるように作りました。
傾きtan(θ)の直線の場合、片方の端点座標を楕円の中心(o,p)として、もう片方の端点をo+Lcos(θ), p+Lsin(θ) Lは適当な値(ゼロでも可)とすれば交点を求めることが出来ます。
 問題は、楕円に対して垂直の直線です。
これは、垂線で、直線ですが、直線の方程式をあてはめねことが出来ません。
この場合は、xの位置が決まっているので、単純に楕円の方程式からyの値を求めるだけです。


プログラム

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//------------------------------------
// 楕円と直線の交点を求めます
// a 楕円の半径
// b 楕円の半径
// o 楕円の中心X
// p 楕円の中心Y
// sx, sy 直線の始点座標 X Y
// ex, ey 直線の終点座標 X Y
//------------------------------------
procedure ovalcross(a, b, o, p, sx, sy, ex, ey: double);
label
  Print;
var
  c, d           : double;
  Al, Bl, Cl, Dl : double;
  x, y           : double;
  x1, x2         : double;
  y1, y2         : double;
  err            : boolean;
  csx,  csy, cex, cey : integer;
  bx, by         : integer;
begin
  bx := 350;       // 作図中心位置 X
  by := 150;       // 作図中心位置 Y
  x1 := 0;
  y1 := 0;
  x2 := 0;
  y2 := 0;
  err := true;
  // 直線の係数計算 y = cx + d
  // 楕円に対して垂直の直線の係数は求めることが出来ないので二次方程式では
  // 答えが出ません。
  if ex - sx = 0 then begin
    x1 := o - a;              // 楕円の左端計算
    x2 := o + a;              // 楕円の右端計算
    // 楕円の範囲外だったら交点なし
    if (sx < x1) or (sx > x2) then begin
      err := False;
      goto print;
    end;
      x := sx - o;            // 楕円中心からの直線の位置
      // 楕円の公式から直接Xの値からYの値計算
      y := sqrt(1 - x * x / a / a) * b;
      // Xの位置は二つ交点とも同じ
      x1 := sx;
      x2 := ex;
      // 反対側のyは対象の位置
      y1 :=   y + p;         // yの値が楕円中心に対する値なので中心値加算
      y2 :=  -y + p;
    goto print;
  end;
  c := (ey - sy) / (ex - sx);
  d := sy - c * sx;
  // 二次方程式の係数計算 Ax^2 + Bx + C = 0  判別値 D = B^2 - 4AC
  Al := 1 / a / a + c * c / b / b;
  Bl := 2 * (-o / a / a + c * (d - p) / b / b);
  Cl := o * o / a / a + (d - p) * (d - p) / b / b - 1;
  Dl := Bl * Bl - 4 * Al * Cl;
  // 判別値 D がゼロより大きい場合は 答えは二つ
  if Dl > 0 then begin
    x1 := ( -Bl + sqrt(Dl)) / Al / 2;
    x2 := ( -Bl - sqrt(Dl)) / Al / 2;
    y1 := c * x1 + d;
    y2 := c * x2 + d;
  end;
  // 判別値 D がゼロの場合は接線 答えは一つ
  if Dl = 0 then begin
    x1 := -Bl/ 2 / Al;
    x2 := x1;
    y1 := c * x1 + d;
    y2 := y1;
  end;
  // 判別値 D がゼロの以下の場合答え無し
  if Dl < 0 then err := False;

print:                  // Label;

  // 接点又は交点が有ったら作図座標計算
  if err then begin
    x1 := x1 + bx;
    x2 := x2 + bx;
    y1 := y1 + by;
    y2 := y2 + by;
  end;

  // 作図
  with Form1.Canvas do begin
    // 画像消去
    Brush.Style := bsSolid;
    Brush.Color := clBtnface;
    FillRect(rect(0, 0, Form1.ClientWidth, Form1.ClientHeight));
    // 線種設定 交点丸表示
    Brush.Style := bsClear;
    Pen.Color := clblack;
    Pen.Style := psSolid;
    Pen.Width := 1;
    // 接点 又は 交点が有ったらその場所に丸作図
    if err then begin
      Ellipse(round(x1 - 5), round(y1 - 5), round(x1 + 6), round(y1 + 6));
      Ellipse(round(x2 - 5), round(y2 - 5), round(x2 + 6), round(y2 + 6));
    end;
    cex := round(a + o + bx + 1);
    cey := round(b + p + by + 1);
    csx := round(o - a + bx);
    csy := round(p - b + by);
    // 楕円の描画
    Pen.Color := clRed;
    Pen.Width := 1;
    Ellipse(csx, csy, cex, cey);
    // 直線の描画
    Pen.Width := 1;
    Pen.Color := clBlue;
    MoveTo(round(sx + bx), round(sy + by));
    LineTo(round(ex + bx), round(ey + by));
    // 中心線の描画
    Pen.Color := clblack;
    Pen.Width := 1;
    Pen.Style := psdashDot;
    MoveTo(round(o + bx - 45), round(p + by));
    LineTo(round(o + bx + 45), round(p + by));
    MoveTo(round(o + bx), round(p + by - 45));
    LineTo(round(o + bx), round(p + by + 45));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ovalcross(
            175,      // 楕円の半径 a
            100,      // 楕円の半径 b
            -80,      // 楕円の中心座標 X
            150,      // 楕円の中心座標 Y
           -300,      // 直線の始点 X
            100,      // 直線の始点 Y
            250,      // 直線の終点 X
            200       // 直線の終点 Y
               );
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ovalcross(
            100,      // 楕円の半径 a
            180,      // 楕円の半径 b
            -80,      // 楕円の中心座標 X
            150,      // 楕円の中心座標 Y
           -300,      // 直線の始点 X
            250,      // 直線の始点 Y
            250,      // 直線の終点 X
             50       // 直線の終点 Y
               );
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ovalcross(
            180,      // 楕円の半径 a
            100,      // 楕円の半径 b
            -80,      // 楕円の中心座標 X
            150,      // 楕円の中心座標 Y
           -261,      // 直線の始点 X
            270,      // 直線の始点 Y
           -261,      // 直線の終点 X
             30       // 直線の終点 Y
               );
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  ovalcross(
            180,      // 楕円の半径 a
            100,      // 楕円の半径 b
            -80,      // 楕円の中心座標 X
            150,      // 楕円の中心座標 Y
           -100,      // 直線の始点 X
            270,      // 直線の始点 Y
           -100,      // 直線の終点 X
             30       // 直線の終点 Y
               );
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  ovalcross(
            180,      // 楕円の半径 a
            100,      // 楕円の半径 b
            -80,      // 楕円の中心座標 X
            150,      // 楕円の中心座標 Y
           -280,      // 直線の始点 X
            150,      // 直線の始点 Y
            120,      // 直線の終点 X
            150       // 直線の終点 Y
               );
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  ovalcross(
            180,      // 楕円の半径 a
            100,      // 楕円の半径 b
            -80,      // 楕円の中心座標 X
            150,      // 楕円の中心座標 Y
           -280,      // 直線の始点 X
            100,      // 直線の始点 Y
            120,      // 直線の終点 X
            100       // 直線の終点 Y
               );
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  ovalcross(
            180,      // 楕円の半径 a
            100,      // 楕円の半径 b
            -80,      // 楕円の中心座標 X
            150,      // 楕円の中心座標 Y
           -280,      // 直線の始点 X
             49,      // 直線の始点 Y
            120,      // 直線の終点 X
             49       // 直線の終点 Y
               );
end;

end.

 新しいプログラム

 楕円の値と、直線の端点二点の座標を指示する事により、直線と楕円の交点を求めることが出来るようにしました。
楕円の作図領域と、直線の作図領域に交点がない場合は、交点の作図はしません。
楕円と、直線の作図に、新しく追加した、描画モードを使用しています。
 座標は、作図範囲の中心が0,0です、作図範囲を超えても、自動調整されません。
 交点の計算は、楕円の中心座標を原点に変更、楕円角度はに座標変換をして計算、計算後、交点の座標を元の座標にもどしています。
交点の座標の値が必要な場合は、表示を追加してください。

プログラム

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, math, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Radius_a_Edit: TLabeledEdit;
    Radius_b_Edit: TLabeledEdit;
    RotationAngleEdit: TLabeledEdit;
    LineWidthEdit: TLabeledEdit;
    RadioGroup1: TRadioGroup;
    CenterXEdit: TLabeledEdit;
    CenterYEdit: TLabeledEdit;
    drawingImage: TImage;
    StartPointXEdit: TLabeledEdit;
    StartPointYEdit: TLabeledEdit;
    EndPointXEdit: TLabeledEdit;
    EndPointYEdit: TLabeledEdit;
    Label1: TLabel;
    StraightWideEdit: TLabeledEdit;
    StraightGroup: TRadioGroup;
    Label2: TLabel;
    startangleEdit: TLabeledEdit;
    EndAngleEdit: TLabeledEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    function  Dist(x1, y1, x2, y2 : double): double;
    function  Angle(dx, dy: double): double;
    procedure LineSub(Tcv: TCanvas; px1, py1, px2, py2: double);
    procedure pitchControl(NLine, LW: integer);
    procedure LineSubPitch(Tcv : TCanvas; Ln : integer; var i: integer; var d1: double; px1, py1, px2, py2:double);
    function  angleSe(a, b, rad: double): double;
    procedure EllipseEx(Tcv: TCanvas; lf, lw: integer; lc: Tcolor; a, b, x, y, rq, sq, eq: double);
    procedure StraightLineDraw(Tcv: TCanvas; lf, lw: integer; lc: Tcolor; xs, ys, xe, ye: double; sf: boolean);
    function  Crosspoint(a, b, x, y, qdeg, x1, y1, x2, y2: double; var xp1, yp1, xp2, yp2: double) : integer;
    procedure FormSet;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  PitchN = 5;                                 // 線ピッチ設定数
  LineN  = 3;                                 // 線種数
  LIMIT8 = 0.00000001;

type
  TLinePitch = Record                         // 線種用レコード
    Pitch   : array[0..PitchN] of double;     // ピッチ 線長さ 空白の繰り返し
    segment : integer;                        // ピッチ数
  End;

var
  LPitch    : array of TLinePitch;            // 線種用 (線ピッチ)
  VPitch    : array[0..PitchN] of double;     // 線幅による線ピッチ設定用
  XShift    : integer;                        // 描画中心位置X
  YShift    : integer;                        // 描画中心位置Y

//-----------------------------------------------
// 線幅によるピッチの補正
// 線幅を広くするとスペースが狭くなるので広げます
// NLine 線種
// LW    線幅
//-----------------------------------------------
procedure TForm1.pitchControl(NLine, LW: integer);
var
  i : integer;
begin
  // 線幅によるピッチの補正
  for i := 0 to pitchN do begin
    if i mod 2 <> 0 then                              // 奇数配列noセグメントがスペース
      Vpitch[i] := LPitch[NLine].Pitch[i] + LW        // スペースに線幅加算
    else
      Vpitch[i] := LPitch[NLine].Pitch[i];
  end;
end;

//----------------------------
// 二点間線引き 実線
//----------------------------
procedure TForm1.LineSub(Tcv: TCanvas; px1, py1, px2, py2: double);
var
  x1, y1, x2, y2 : integer ;
begin
  x1 := XShift + Round(px1);
  y1 := YShift - Round(py1);
  x2 := XShift + Round(px2);
  y2 := YShift - Round(py2);
  Tcv.MoveTo(x1, y1);
  Tcv.LineTo(x2, y2);
end;

//----------------------
// 距離(長さ)を計算
//  x1, y1 : 始点
//  x2, y2 : 終点
//  out : 距離(長さ)
//----------------------
function TForm1.Dist(x1, y1, x2, y2 : double): double ;
begin
  Result := Sqrt((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1)) ;
end;

//--------------------------------
// 角度を計算[rad]
//  dx : X方向差分
//  dy : Y方向差分
//  out: 角度 (0~2 * Pi)
//--------------------------------
function TForm1.Angle(dx, dy: double): double ;
var
  r : double ;
begin
  Result := 0.0;
  if (Abs(dx) < LIMIT8) and (Abs(dy) < LIMIT8) then exit;
  r := ArcTan2(dy, dx);
  if r < 0.0 then r := r + 2.0 * Pi;
  Result := r;
end;

//--------------------------------------
// 線分の表示・サブ2:線種指定
//    Ln : 線種番号(1-)
//    i  : 開始セグメント番号(終了時更新)
//    d1 : 開始ピッチ長さ  (終了時更新)
//    px1, py1 : 線分始点[mm]
//    px2, py2 : 線分終点[mm]
//--------------------------------------
procedure TForm1.LineSubPitch(Tcv: TCanvas; Ln: integer; var i: integer; var d1: double; px1, py1, px2, py2:double);
var
  x1, y1, x2, y2  : double;
  a, sa, ca, d, p : double;
  PenStyle        : TPenstyle;
begin
  PenStyle := Tcv.Pen.Style;                    // 線種バックアップ
  Tcv.Pen.Style := psSolid;
  if (Ln < 0) or (Ln >= LineN) then begin       // 無い線種は実線
    LineSub(Tcv, px1, py1, px2, py2);
    Tcv.Pen.Style := PenStyle;                  // 線種戻し
    exit;
  end;
  a := Angle(px2 - px1, py2 - py1);             // 角度計算
  d := Dist(px1, py1, px2, py2);                // 距離計算
  ca:= Cos(a);                                  // コサイン
  sa:= Sin(a);                                  // サイン
  x1:= px1;                                     // 始点x
  y1:= py1 ;                                    // 始点y
  repeat
    p := Vpitch[i] - d1;                        // ピッチと開始ピッチ長さ差分 残り分
    if (p > d) then p := d;                     // 距離より残り分が大きい場合 距離
    x2 := x1 + p * ca ;                         // 新しい位置計算
    y2 := y1 + p * sa ;
    if (i mod 2) = 0 then                       // セグメント偶数毎に線引き 空白部線引きしない
         LineSub(Tcv, x1, y1, x2, y2);
    x1 := x2;                                   // 終点を始点にセット
    y1 := y2;
    d := d - p ;                                // 残り長さ計算
    if d > LIMIT8 then begin                    // 残り長さがあったら
      d1 := 0.0;                                // 開始ピッチ長さクリア
      Inc(i);                                   // セグメントカウンターインクリメント
      if i >= LPitch[Ln].segment then i := 0;   // セグメント数を超えたらゼロに戻し
    end;
  until d <= LIMIT8;
  d1 := d1 + p;                                 // 開始ピッチ長さ
  Tcv.Pen.Style := PenStyle;                    // 線種戻し
end;

//------------------------------------------
// 楕円の開始角を 基礎円の開始角に変換
//------------------------------------------
function TForm1.angleSe(a, b, rad: double): double;
const
  KMIN = 0.00000001;
var
  l : double;
begin
  // 90°, 270°, 0°, 180° 360°近傍は計算しない
  if (abs(rad - pi / 2) < KMIN) or (abs(rad - pi - pi / 2) < KMIN)
      or (abs(rad) < KMIN) or (abs(rad - pi) < KMIN) or
      (abs(rad - pi * 2) < KMIN)
  then begin
    result := rad;
    exit;
  end;
  // 底辺の長さ計算 ( b / a の値がいつも正の値なので元の角度によって角度を補正)
  // 分母がゼロに近くなる時もあるので、判別が不要なarctan2を使用します
  l := b / a / tan(rad);
  // 180°以下だったら
  if rad < pi then
    result := arctan2(1, l)
  else
    // 360°以下だったら
    if rad < pi * 2 then
      result := arctan2(1, l) + pi
    // 360°を超えていたら
    else
      result := arctan2(1, l) + pi * 2;
end;

//---------------------------------------
// 楕円の描画
//---------------------------------------
procedure TForm1.EllipseEx(Tcv : TCanvas; lf, lw: integer; lc: Tcolor; a, b, x, y, rq, sq, eq: double);
var
  sqrad, eqrad    : double;
  qrad            : double;
  Ssqrad, Seqrad  : double;
  sp              : integer;
  dq              : double;
  d1              : double;
  dp              : integer;
  xf, yf          : double;
  rdist, nrad     : double;
  px1, py1        : double;
  px2, py2        : double;
  i               : integer;
begin
  Tcv.Pen.Width := lw;
  Tcv.Pen.Color := lc;

  // 線幅によるピッチの補正
  pitchControl(lf, lw);

  // 終了角と開始角が一致したら全周
  if abs(sq - eq) < LIMIT8 then begin
    sq := 0;
    eq := 360;
  end;

  // 分割数 半径に応じて調整
  sp := round(sqrt(a + b) * 4);               // 分割数

  // 楕円の計算と描画
  sqrad := sq / 180 * pi;
  eqrad := eq / 180 * pi;

  qrad  := pi / 180 * rq;                     // 回転角 ラジアン

  Ssqrad := angleSe(a, b, sqrad);             // 基本円角度に変換
  Seqrad := angleSe(a, b, eqrad);             // 基本円角度に変換
  // 分割微小角計算  分割数角度で補正
  if Seqrad >= Ssqrad then begin
    sp := round(sp * (Seqrad - Ssqrad) / pi);
    dq := (Seqrad - Ssqrad) / sp              // 分割微小角 ラジアン
  end
  else begin
    sp := round(sp * (Pi * 2 - Ssqrad + Seqrad) / pi);
    dq := (Pi * 2 - Ssqrad + Seqrad) / sp;    // 分割微小角 ラジアン
  end;
  // 開始点の計算
  d1 := 0;                                    // 長さ
  dp := 0;                                    // セグメント位置
  xf := cos(Ssqrad) *  a;                     // 基本楕円座標X スタート座標
  yf := sin(Ssqrad) *  b;                     // 基本楕円座標y スタート座標
  nrad := arctan2(yf, xf) + qrad;             // 新しい角度 回転角加算
  rdist := sqrt(xf * xf + yf * yf);           // 中心と楕円座標の距離
  px1 := cos(nrad) * rdist + x;               // 開始座標X
  py1 := sin(nrad) * rdist + y;               // 開始座標Y -rdistはY座標反転の為
                                              // WindowはY座標方向が逆のため
  // 分割数分計算繰り返し描画
  for i := 1 to sp do begin
    xf := cos(Ssqrad + dq * i) * a;
    yf := sin(Ssqrad + dq * i) * b;
    nrad := arctan2(yf , xf) + qrad;
    rdist := sqrt(xf * xf + yf * yf);
    px2 := round(cos(nrad) * rdist + x);      // 終点座標X
    py2 := round(sin(nrad) * rdist + y);      // 終点座標Y
    // ピッチ線描画
    LineSubPitch(                             // ピッチ線描画
                tcv,                          // TCanvas
                 lf,                          // 線種
                 dp,                          // セグメント位置
                 d1,                          // 長さ
                px1,                          // 始点X
                py1,                          // 始点Y
                px2,                          // 終点X
                py2                           // 終点Y
                   );
    px1 := px2;                               // 終点Xを始点Xに
    py1 := py2;                               // 終点Yを始点Yに
  end;
end;

//-------------------------------------------------------------
// 直線の描画
// 直線の開始はsfをTrueにします。
// つながった直線、折れ線を描画する場合は、sfをFalseに
//-------------------------------------------------------------
var
  d01              : double;                  // 長さ
  d0p              : integer;                 // セグメント位置

procedure TForm1.StraightLineDraw(Tcv: TCanvas; lf, lw: integer; lc: Tcolor; xs, ys, xe, ye: double; sf: boolean);
begin
  Tcv.Pen.Width := lw;
  Tcv.Pen.Color := lc;
  // 線幅によるピッチの補正
  pitchControl(lf, lw);
  if sf then begin
    d01 := 0;
    d0p := 0;
  end;
  LineSubPitch(                             // ピッチ線描画
                tcv,                          // TCanvas
                 lf,                          // 線種
                d0p,                          // セグメント位置
                d01,                          // 長さ
                 xs,                          // 始点X
                 ys,                          // 始点Y
                 xe,                          // 終点X
                 ye                           // 終点Y
                   );
end;

//----------------------------------------------------------------------------
// 楕円と直線の交点計算
// 楕円の中心座標を原点に座標変換し、楕円回転角ゼロにする為、直線の座標を
// 回転角(-qdeg)で座標変換をして計算します
// 交点が求まったら、元の楕円の中心座標と回転角(qdeg)で、交点の座標変換をして
// 中心座標 x, y の交点座標とします。
// a 楕円半径 a
// b 楕円半径 b
// x, y  楕円中心座標
// qdeg  楕円回転角 deg
// x1, y1, x2, y2  直線始点 終点
// xp1, yp1, xp2, yp2  交点1 交点2
// result  0 交点二箇所 1 接点一箇所 -1 交点なし
//----------------------------------------------------------------------------
function TForm1.Crosspoint(a, b, x, y, qdeg, x1, y1, x2, y2: double; var xp1, yp1, xp2, yp2: double) : integer;
const
  MinK = 0.00000000001;
var
  r              : double;   // 中心からの距離
  q0, q1         : double;   // 指定点の角度
  qb             : double;   // 回転角
  sx, sy         : double;   // 座標変換始点位置
  ex, ey          : double;  // 座標変換終点位置
  c, d           : double;   // 直線の係数
  Al, Bl, Cl, Dl : double;   // 二次方程式の係数
begin
// 座標変換
  qb := qdeg / 180 * pi;
  // 直線始点の楕円中心からの距離計算
  r   := sqrt((x1 - x) * (x1 - x) + (y1 - y) * (y1 - y));
  // 角度計算
  q0  := arctan2((y1 - y),(x1 - x));
  // 楕円の角度分修正
  q1  := q0 - qb;
  // 楕円の中心座標を原点として始点の座標変換
  sx  := cos(q1) * r;
  sy  := sin(q1) * r;
  // 直線終点の楕円中心からの距離計算
  r   := sqrt((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y));
  // 角度計算
  q0  := arctan2((y2 - y),(x2 - x));
  // 角度計算
  q1  := q0 - qb;
  // 楕円の中心座標を原点として終点の座標変換
  ex  := cos(q1) * r;
  ey  := sin(q1) * r;

// 直線傾斜係数計算
// Δxがゼロに近いときのオーバーフロー防止
// 楕円に対して垂直の線か判別
// 水平のときは c がゼロになるだけで問題なし
  if abs(ex - sx) > MinK then
    c := (ey - sy) / (ex - sx)
  else begin
    // ex と sx が等しいときは、楕円に対して垂直線
    // sx,exの値から直接yの値計算します
    // 楕円と交差するか判別 交差したら
    if (sx >= -a) and (sx <= a) then begin
      // 楕円の公式から直接Xの値からYの値計算
      yp1 := sqrt(1 - sx * sx / a / a) * b;
      // 反対側のyは対象の位置
      yp2 := - yp1;
      // xの位置は同一
      xp1 := sx;
      xp2 := xp1;
      // X座標が半径 a と同じだったら答えは一個
      if (abs(xp1) - a < MinK) then result := 0
                               else result := 1;
      // 楕円中心からの距離計算
      r := sqrt(xp1 * xp1 + yp1 * yp1);
      // 角度計算1
      q0  := arctan2(yp1, xp1);
      // 楕円の傾斜角補正
      q1  := q0 + qb;
      // 修正座標計算1
      xp1  := x + cos(q1) * r;
      yp1  := y + sin(q1) * r;
      // 角度計算2
      q0  := arctan2(yp2, xp2);
      // 楕円の傾斜角補正
      q1  := q0 + qb;
      // 修正座標計算2
      xp2  := x + cos(q1) * r;
      yp2  := y + sin(q1) * r;
      exit;
    end
    else begin
      // 交点なし
      result := -1;
      exit;
    end;
  end;
// 係数d計算
  d := sy - c * sx;

// 楕円の中心座標を 0,0 として交点計算
  Al := 1 / a / a + c * c / b / b;
  Bl := 2 * c * d / b / b;           // Bl := 2 * (-x / a / a + c * (d - y) / b / b);
  Cl := d * d / b / b - 1;           // Cl := x * x / a / a + (d - y) * (d - y) / b / b - 1;
  Dl := Bl * Bl - 4 * Al * Cl;

// 垂直線以外で交点が二箇所ある場合
// 交点の座標は、楕円中心座標と、回転角で座標変換
  if Dl >= MinK then begin
    xp1 := ( -Bl + sqrt(Dl)) / Al / 2;
    xp2 := ( -Bl - sqrt(Dl)) / Al / 2;
    yp1 := c * xp1 + d;
    yp2 := c * xp2 + d;
    // 座標変換1 元の座標に戻し
    r := sqrt(xp1 * xp1 + yp1 * yp1);
    q0  := arctan2(yp1, xp1);
    q1  := q0 + qb;
    xp1  := x + cos(q1) * r;
    yp1  := y + sin(q1) * r;
    // 座標変換2 元の座標に戻し
    r := sqrt(xp2 * xp2 + yp2 * yp2);
    q0  := arctan2(yp2 , xp2);
    q1  := q0 + qb;
    xp2  := x + cos(q1) * r;
    yp2  := y + sin(q1) * r;

    result := 0;
    exit;
  end;

// Dl = 0 接線になる場合です
// 接点の座標は、楕円中心座標と、回転角で座標変換
  if abs(Dl) <= MinK then begin
    xp1 := -Bl/ 2 / Al;
    xp2 := xp1;
    yp1 := c * xp1 + d;
    yp2 := yp1;
    // 座標変換1 元の座標に戻し
    r := sqrt(xp1 * xp1 + yp1 * yp1);
    q0  := arctan2(yp1, xp1);
    q1  := q0 + qb;
    xp1  := x + cos(q1) * r;
    yp1  := y + sin(q1) * r;

    // 座標変換2 元の座標に戻し
    // 基本的には xp2 = xp1 yp2 = yp1 なので計算の必要ありません
{
    r := sqrt(xp2 * xp2 + yp2 * yp2);
    q0  := arctan2(yp2, xp2);
    q1  := q0 + qb;
    xp2  := x + cos(q1) * r;
    yp2  := y + sin(q1) * r;
}
    xp2 := xp1;
    yp2 := yp1;
    result := 1;
    exit;
  end;

// 交点なし
  result := -1;
end;

//-------------------------------
// 楕円 データー読み込み作図
//-------------------------------
procedure TForm1.Button1Click(Sender: TObject);
const
  NINR = 0.001;             // 楕円半径の最小値
var
  lf        : integer;      // 線の種類
  lw        : integer;      // 線の幅
  a, b      : double;       // 楕円縦横
  qdeg      : double;       // 回転角
  x         : double;       // 中心座標X
  y         : double;       // 中心座標Y
  sq        : double;       // 描画始角
  eq        : double;       // 描画終角
  ch        : integer;
  Rect      : TRect;
  x1, y1    : double;
  x2, y2    : double;
  xp1, yp1  : double;
  xp2, yp2  : double;
  DrawCvs   : TCanvas;
  pdeg      : double;
  pflag     : boolean;

  // 角度修正 0~360の範囲に変更
  function DegAdjustment(degin: double): double;
  begin
    if degin < 0 then
      repeat
        degin := degin + 360;
      until degin >= 0;
    if degin > 360 then
      repeat
        degin := degin - 360;
      until degin < 360;
    result := degin;
  end;

begin
  // 画像消去
  Rect.Top  := 0;
  Rect.Left := 0;
  Rect.Right  := drawingImage.Width;
  Rect.Bottom := drawingImage.Height;
  drawingImage.Canvas.Brush.Style := bsSolid;
  drawingImage.Canvas.Brush.Color := clWhite;
  drawingImage.Canvas.FillRect(Rect);
// 楕円描画の基本値セット描画
  // 半径 a
  val(Radius_a_Edit.Text, a, ch);
  if ch <> 0 then begin
    application.MessageBox('入力に間違いがあります。','半径 a', 0);
    exit;
  end;
  if a < NINR then begin
    application.MessageBox('半径 a の値が小さすぎます。','半径 a', 0);
    exit;
  end;
  // 半径 b
  val(Radius_b_Edit.Text, b, ch);
  if ch <> 0 then begin
    application.MessageBox('入力に間違いがあります。','半径 b', 0);
    exit;
  end;
  if b < NINR then begin
    application.MessageBox('半径 b の値が小さすぎます。','半径 b', 0);
    exit;
  end;
  // 回転角
  val(RotationAngleEdit.Text, qdeg, ch);
  if  ch <> 0 then begin
    application.MessageBox('入力に間違いがあります。','回転角', 0);
    exit;
  end;
  // 作図開始角
  val(StartAngleEdit.Text, sq, ch);
  if  ch <> 0 then begin
    application.MessageBox('入力に間違いがあります。','作図開始角', 0);
    exit;
  end;
  // 作図終了角
  val(EndAngleEdit.Text, eq, ch);
  if  ch <> 0 then begin
    application.MessageBox('入力に間違いがあります。','作図終了角', 0);
    exit;
  end;

  // 角度を0~360°に修正
  qdeg := DegAdjustment(qdeg);
  sq   := DegAdjustment(sq);
  eq   := DegAdjustment(eq);

  // 線の幅
  val(lineWidthEdit.Text, lw, ch);
  if  (ch <> 0) or (lw < 1) then begin
    application.MessageBox('入力に間違いがあります。','線の幅', 0);
    exit;
  end;
  // 中心位置 X
  val(CenterXEdit.Text, x, ch);
  if  (ch <> 0) then begin
    application.MessageBox('入力に間違いがあります。','中心座標 X', 0);
    exit;
  end;
  // 中心位置 Y
  val(CenterYEdit.Text, y, ch);
  if  (ch <> 0) then begin
    application.MessageBox('入力に間違いがあります。','中心座標 Y', 0);
    exit;
  end;
  lf := 0;
  // 線の種類
  case RadioGroup1.ItemIndex of
    0: lf := 3;                     // 実線
    1: lf := 0;                     // 破線
    2: lf := 1;                     // 一点鎖線
    3: lf := 2;                     // 二点鎖線
  end;

// 描画 Canvas 設定
  DrawCvs := drawingImage.Canvas;       // 描画キャンバス
  XShift := drawingImage.Width div 2;   // X方向シフト量
  YShift := drawingImage.Height div 2;  // Y方向シフト量

// 楕円の作図
  EllipseEx(                        // 楕円作図
            DrawCvs,                // TCanvas
            lf,                     // 線種
            lw,                     // 線幅
            clred,                  // 線の色
            a,                      // 半径 a
            b,                      // 半径 b
            x,                      // 中心座標 X
            y,                      // 中心座標 Y
            qdeg,                   // 回転角
            sq,                     // 始角
            eq                      // 終角
              );

// 指定直線の描画
  val(StartPointXEdit.Text, x1, ch);
  if  (ch <> 0) then begin
    application.MessageBox('入力に間違いがあります','直線開始点 X1', 0);
    exit;
  end;
  val(StartPointYEdit.Text, y1, ch);
  if  (ch <> 0) then begin
    application.MessageBox('入力に間違いがあります','直線開始点 Y1', 0);
    exit;
  end;
  val(EndPointXEdit.Text, x2, ch);
  if  (ch <> 0) then begin
    application.MessageBox('入力に間違いがあります','直線開始点 X2', 0);
    exit;
  end;
  val(EndPointYEdit.Text, y2, ch);
  if  (ch <> 0) then begin
    application.MessageBox('入力に間違いがあります','直線開始点 Y2', 0);
    exit;
  end;
  // 線の幅
  val(StraightWideEdit.Text, lw, ch);
  if  (ch <> 0) or (lw < 1) then begin
    application.MessageBox('入力に間違いがあります','直線線の幅', 0);
    exit;
  end;
  // 線の種類
  case StraightGroup.ItemIndex of
    0: lf := 3;                     // 実線
    1: lf := 0;                     // 破線
    2: lf := 1;                     // 一点鎖線
    3: lf := 2;                     // 二点鎖線
  end;

  xp1 := -XShift + 2;
  yp1 := -YShift + 2;
  xp2 :=  XShift - 2;
  yp2 :=  YShift - 2;
// 枠の描画
  StraightLineDraw(DrawCvs, 2, 2, clGreen, xp1, yp1, xp2,  yp1, true);
  StraightLineDraw(DrawCvs, 2, 2, clGreen, xp2, yp1, xp2,  yp2, False);
  StraightLineDraw(DrawCvs, 2, 2, clGreen, xp2, yp2, xp1,  yp2, False);
  StraightLineDraw(DrawCvs, 2, 2, clGreen, xp1, yp2, xp1,  yp1, False);

// 直線の描画
  StraightLineDraw(
                    DrawCvs,                    // TCanvas
                    lf,                         // 線種
                    lw,                         // 線幅
                    clBlack,                    // 線の色
                    x1,                         // 始点X
                    y1,                         // 始点Y
                    x2,                         // 終点X
                    y2,                         // 終点Y
                    true                        // 直線開始
                    );

// 楕円中心線の描画 X
  StraightLineDraw(
                    DrawCvs,                    // TCanvas
                    1,                          // 線種 一点鎖線
                    1,                          // 線幅
                    clBlack,                    // 線の色
                    x - 50,                     // 始点X
                    y,                          // 始点Y
                    x + 50,                     // 終点X
                    y,                          // 終点Y
                    true                        // 直線開始
                    );

// 楕円中心線の描画 Y
  StraightLineDraw(
                    DrawCvs,                    // TCanvas
                    1,                          // 線種 一点鎖線
                    1,                          // 線幅
                    clBlack,                    // 線の色
                    x,                          // 始点X
                    y + 50,                     // 始点Y
                    x,                          // 終点X
                    y - 50,                     // 終点Y
                    true                        // 直線開始
                    );

// 楕円と直線の交点計算
  ch := Crosspoint(
                    a,                      // 楕円半径 a
                    b,                      // 楕円半径 b
                    x,                      // 楕円中心座標 x
                    y,                      // 楕円中心座標 y
                    qdeg,                   // 傾き角
                    x1,                     // 直線始点 x
                    y1,                     // 直線始点 y
                    x2,                     // 直線終点 x
                    y2,                     // 直線終点 y
                    xp1,                    // 交点1 X
                    yp1,                    // 交点1 Y
                    xp2,                    // 交点2 X
                    yp2                     // 交点2 y
                      );

// 交点がなかったら終了
  if ch < 0  then exit;

// 交点の円作図
// 交点が楕円作図角度内か角度で判別 作図角度範囲外なら交点作図しない
  // 交点の位置を角度に変換
  pdeg := arctan2((yp1 - y),(xp1 - x)) / pi * 180 - qdeg;
  // 角度を0~360°に修正
  pdeg := DegAdjustment(pdeg);
  pflag := false;
  if eq > sq then
    if (pdeg > sq) and (pdeg < eq) then pflag := true;
  if sq > eq then
    if (pdeg < sq) or (pdeg > eq) then pflag := true;
// 交点が直線の範囲外でも作図しない
  if (x1 < xp1) and (xp1 < x2) and pflag then
    EllipseEx(                          // 楕円作図
              DrawCvs,                    // TCanvas
              4,                          // 線種
              2,                          // 線幅
              clblue,                     // 線の色
              5,                          // 半径 a
              5,                          // 半径 b
            xp1,                          // 中心座標 X
            yp1,                          // 中心座標 Y
              0,                          // 回転角
              0,                          // 始角
            360                           // 終角
                );

// 接線だったら交点の円一個のみ
  if ch = 1  then exit;

  // 交点の位置を角度に変換
  pdeg := arctan2((yp2 - y),(xp2 - x)) / pi * 180 - qdeg;
  // 角度を0~360°に修正
  pdeg := DegAdjustment(pdeg);
  pflag := false;
  if eq > sq then
    if (pdeg > sq) and (pdeg < eq) then pflag := true;
  if sq > eq then
    if (pdeg < sq) or (pdeg > eq) then pflag := true;
// 交点が楕円作図角度内か角度で判別 作図角度範囲外なら交点作図しない
// 交点が直線の範囲外でも作図しない
  if (x1 < xp2) and (xp2 < x2)  and pflag then
    EllipseEx(                            // 楕円作図
              DrawCvs,                    // TCanvas
              4,                          // 線種
              2,                          // 線幅
              clblue,                     // 線の色
              5,                          // 半径 a
              5,                          // 半径 b
            xp2,                          // 中心座標 X
            yp2,                          // 中心座標 Y
              0,                          // 回転角
              0,                          // 始角
            360                           // 終角
                );
end;


//-------------------------------
// Form Set
//-------------------------------
procedure TForm1.FormSet;
begin
  ClientHeight            := 593;
  ClientWidth             := 922;
  Top := (Screen.Height - Height) div 2;
  Left := (Screen.Width - Width) div 2;
  Button1.Left            := ClientWidth - 150;
  Radius_a_Edit.Left      := ClientWidth - 95;
  Radius_b_Edit.Left      := ClientWidth - 95;
  RotationAngleEdit.Left  := ClientWidth - 95;
  LineWidthEdit.Left      := ClientWidth - 95;
  RadioGroup1.Left        := ClientWidth - 95;
  CenterXEdit.Left        := ClientWidth - 95;
  CenterYEdit.Left        := ClientWidth - 95;
  startAngleEdit.Left     := ClientWidth - 95;
  endAngleEdit.Left       := ClientWidth - 95;
  drawingImage.Width      := ClientWidth - 200;
  StartPointXEdit.Left    := ClientWidth - 183;
  StartPointYEdit.Left    := ClientWidth - 183;
  EndPointXEdit.Left      := ClientWidth - 183;
  EndPointYEdit.Left      := ClientWidth - 183;
  StraightWideEdit.Left   := ClientWidth - 183;
  StraightGroup.Left      := ClientWidth - 183;
  Label1.Left             := ClientWidth - 183;
end;

//-----------------------------------------
// 初期設定
// 各線種のピッチ セグメント数設定
//-----------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  FormSet;
// 線種配列确保
  setlength(LPitch, LineN);
// 線種データーセット
  LPitch[0].segment := 2;         // 破線
  LPitch[0].Pitch[0] := 6;
  LPitch[0].Pitch[1] := 3;

  LPitch[1].segment := 4;         // 1点鎖線
  LPitch[1].Pitch[0] := 15;
  LPitch[1].Pitch[1] := 3;
  LPitch[1].Pitch[2] := 3;
  LPitch[1].Pitch[3] := 3;

  LPitch[2].segment := 6;         // 2点鎖線
  LPitch[2].Pitch[0] := 18;
  LPitch[2].Pitch[1] := 3;
  LPitch[2].Pitch[2] := 3;
  LPitch[2].Pitch[3] := 3;
  LPitch[2].Pitch[4] := 3;
  LPitch[2].Pitch[5] := 3;
end;

end.

    download OvalCross.zip

各種プログラム計算例に戻る

      最初に戻る