楕円の描画
自由曲線と同じで、線幅１以上で、指定した線種で描画するプログラムです。
楕円なので、長半径と、短半径を同じ値にすれば、円の描画が出来ます。
左図は、プログラムの実行例です。
長径、短径、開始角、終了角、回転角、線幅、線種を指定して作図しています。
標準のプログラムでは、楕円を作図する四角い枠を指定し、開始、終了位置は中心に対する座標を指定し、その２点間で表される直線と楕円の交点により求めています。
この場合は、Arcメソッドとなります。
楕円 ellipseの場合は、内部の塗りつぶしの指定をする為、開始点、終了点は指定無しとなっています。
又、標準のプログラムには、楕円が中心軸を中心に指定角回転し作図するメソッドはありません。
複雑な図形を描画するためには、沢山の作図プログラムが必要なので、それは、専用のプログラムに任せて、標準では、単純な図形のみとしたようです。
CAD(製図用)プログラムでは、全ての図形が、専用のプログラムで作図されます。
左図は、各種線幅、線種による作図例です。
楕円の開始点、終了点を角度で指定する場合、指定された角度で、そのまま作図することは出来ません。
楕円を円に戻した時の角度を計算し、その角度で作図します。
直線との交点を求めて作図する場合は、中心を通る直線から、交点座標を求めます。
直線の傾き係数を、角度に変換して、円上の角度を求めて作図したほうが簡単です。
描画は自由曲線と同じなのですが、プログラムで作図する場合、曲線を、細かく分割して直線の繋がり(多角形)として作図します。
多角形と見えないぐらいの分割数にします。
特に、印刷を行う場合は、分割数を多くします。
プログラム
曲線の描画、線種の描画は、自由曲線と同じですが、描画の指定項目に、TCanvasを追加しています。
これにより、図形が描画出来る、Form、image、のCanvasであれば、共通ルーチンとして使用する事が出来ます。
unit Unit1;
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;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
LabeledEdit5: TLabeledEdit;
LabeledEdit6: TLabeledEdit;
RadioGroup1: TRadioGroup;
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);
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; // 線幅による線ピッチ設定用
lf : integer; // 線の種類
lw : integer; // 線の幅
//-----------------------------------------------
// 線幅によるピッチの補正
// 線幅を広くするとスペースが狭くなるので広げます
// 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 := Round(px1);
y1 := Round(py1);
x2 := Round(px2);
y2 := 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;
//--------------------------------------
// 線分の表示・サブ２：線種指定
// 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);
if sp = 0 then Sp := 1;
dq := (Seqrad - Ssqrad) / sp // 分割微小角 ラジアン
end
else begin
sp := round(sp * (Pi * 2 - Ssqrad + Seqrad) / pi);
if sp = 0 then Sp := 1;
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;
//-------------------------------
// 楕円 データー読み込み作図
//-------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
a, b : double; // 楕円縦横
qdeg : double; // 回転角
x : double; // 中心座標X
y : double; // 中心座標Y
sq : double; // 描画始角
eq : double; // 描画終角
ch : integer;
Rect : TRect;
// x1, y1 : double;
begin
// 画像消去
Rect.Top := 0;
Rect.Left := 0;
Rect.Right := Width - 150;
Rect.Bottom := Height;
canvas.Brush.Style := bsSolid;
canvas.Brush.Color := clBtnface;
canvas.FillRect(Rect);
// 楕円描画の基本値セット
x := (width - 150) div 2; // 中心座標X
y := height div 2; // 中心座標Y
// 半径 a
val(LabeledEdit1.Text, a, ch);
if (ch <> 0) or (a <= 0) then begin
application.MessageBox('入力に間違いがあります','半径 a', 0);
exit;
end;
// 半径 b
val(LabeledEdit2.Text, b, ch);
if (ch <> 0) or (b <= 0) then begin
application.MessageBox('入力に間違いがあります','半径 b', 0);
exit;
end;
// 開始角
val(LabeledEdit3.Text, sq, ch);
if (ch <> 0) or (sq < 0) then begin
application.MessageBox('入力に間違いがあります','開始角', 0);
exit;
end;
// 終了角
val(LabeledEdit4.Text, eq, ch);
if (ch <> 0) or (eq < 0) then begin
application.MessageBox('入力に間違いがあります','終了角', 0);
exit;
end;
// 回転角
val(LabeledEdit5.Text, qdeg, ch);
if ch <> 0 then begin
application.MessageBox('入力に間違いがあります','回転角', 0);
exit;
end;
if qdeg < 0 then qdeg := qdeg + 360;
// 線の幅
val(LabeledEdit6.Text, lw, ch);
if (ch <> 0) or (lw < 1) then begin
application.MessageBox('入力に間違いがあります','線の幅', 0);
exit;
end;
// 線の種類
case RadioGroup1.ItemIndex of
0: lf := 3; // 実線
1: lf := 0; // 破線
2: lf := 1; // 一点鎖線
3: lf := 2; // 二点鎖線
end;
EllipseEx( // 楕円作図
Canvas, // TCanvas
lf, // 線種
lw, // 線幅
clred, // 線の色
a, // 半径 a
b, // 半径 b
x, // 中心座標 X
y, // 中心座標 Y
qdeg, // 回転角
sq, // 始角
eq // 終角
);
{
Canvas.Pen.Style := pssolid;
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clBlack;
Canvas.MoveTo(round(x),round(y));
sq := qdeg + sq;
sq := sq / 180 * pi;
eq := qdeg + eq;
eq := eq / 180 * pi;
x1 := cos(sq) * (a + b / 2) + x;
y1 := -sin(sq) * (a + b / 2) + y;
Canvas.LineTo(round(x1),round(y1));
Canvas.TextOut(round(x1) - 20,round(y1),'開始角');
Canvas.MoveTo(round(x),round(y));
x1 := cos(eq) * (a) + x;
y1 := -sin(eq) * (a) + y;
Canvas.LineTo(round(x1),round(y1));
Canvas.TextOut(round(x1) - 20,round(y1 - 10),'終了角');
Canvas.Pen.Style := psDashDot;
Canvas.MoveTo(round(x) - 60, round(y));
Canvas.LineTo(round(x) + 150, round(y));
Canvas.MoveTo(round(x), round(y) - 60);
Canvas.LineTo(round(x), round(y) + 60);
Canvas.MoveTo(round(x),round(y));
eq := qdeg / 180 * pi;
x1 := cos(eq) * (a) + x;
y1 := -sin(eq) * (a) + y;
Canvas.LineTo(round(x1),round(y1));
Canvas.TextOut(round(x1) - 20,round(y1 - 10),'傾斜角');
Canvas.MoveTo(round(x),round(y));
x1 := x - cos(eq) * (a + 10);
y1 := sin(eq) * (a + 10) + y;
Canvas.LineTo(round(x1),round(y1));
}
end;
//-----------------------------------------
// 初期設定
// 各線種のピッチ セグメント数設定
//-----------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
// 線種配列确保
setlength(LPitch, LineN);
// 線種データーセット
LPitch[0].segment := 2; // 破線
LPitch[0].Pitch[0] := 6;
LPitch[0].Pitch[1] := 3;
LPitch[1].segment := 4; // １点鎖線
LPitch[1].Pitch[0] := 15;
LPitch[1].Pitch[1] := 3;
LPitch[1].Pitch[2] := 3;
LPitch[1].Pitch[3] := 3;
LPitch[2].segment := 6; // ２点鎖線
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.
ellipse.zip