私はこのような球を描きたい:
以下のコードは、円の頂点を生成し、TIMAGE で円を描画しますが、SPHERE に必要です:
for i := 0 to 360 do begin
//Find value of X and Y
pntCordXY.X := Radius * Cos(DegToRad(i));
pntCordXY.Y := Radius * Sin(DegToRad(i));
if i = 0 then
image1.Canvas.MoveTo(Round(pntCordXY.X), Round(pntCordXY.Y))
else
image1.Canvas.LineTo(Round(pntCordXY.X), Round(pntCordXY.Y));
end;
これは楽しい練習になりました。いい質問です！
最初は、そのような球体を に描画するように具体的に要求しますTImageが、そのコンポーネントはグラフィックスを表示するために使用されることになっています。確かに、描画できるキャンバスがありますが、以下TPaintBoxでは、自分の絵に適したコンポーネントである を使用します。なぜなら、これを自分でペイントする必要があるからです。全体的に。
球体上の 3D ポイントを計算するための数学、複数の軸を中心に地球を回転させるための数学、およびおそらく 3D ポイントを 2D 画面座標系に変換するための数学。基本は次のとおりです。
type
TPoint3D = record
X: Double;
Y: Double;
Z: Double;
end;
function Sphere(Phi, Lambda: Double): TPoint3D;
begin
Result.X := Cos(Phi) * Sin(Lambda);
Result.Y := Sin(Phi);
Result.Z := Cos(Phi) * Cos(Lambda);
end;
function RotateAroundX(const P: TPoint3D; Alfa: Double): TPoint3D;
begin
Result.X := P.X;
Result.Y := P.Y * Cos(Alfa) + P.Z * Sin(Alfa);
Result.Z := P.Y * -Sin(Alfa) + P.Z * Cos(Alfa);
end;
function RotateAroundY(const P: TPoint3D; Beta: Double): TPoint3D;
begin
Result.X := P.X * Cos(Beta) + P.Z * Sin(Beta);
Result.Y := P.Y;
Result.Z := P.X * -Sin(Beta) + P.Z * Cos(Beta);
end;
使用するいくつかの地球変数:
var
Alfa: Integer; //Rotation around X axis
Beta: Integer; //Rotation around Y axis
C: TPoint; //Center
R: Integer; //Radius
Phi: Integer; //Angle relative to XY plane
Lambda: Integer; //Angle around Z axis (from pole to pole)
P: TPoint3D; //2D projection of a 3D point on the sphere's surface
緯度円のすべてのポイントを計算するコード:
for Phi := -8 to 8 do
for Lambda := 0 to 360 do
begin
P := Sphere(DegToRad(Phi * 10), DegToRad(Lambda));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
end;
経度子午線のすべてのポイントを計算するコード:
for Lambda := 0 to 17 do
for Phi := 0 to 360 do
begin
P := Sphere(DegToRad(Phi), DegToRad(Lambda * 10));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
end;
これらの点を使用して、ペイント ボックスに線や曲線を描くことができます。これらのポイントの Z 値は描画には使用されませんが、ポイントが地球の裏側にあるか表側にあるかを判断するのに役立ちます。
ロジックと補助。地球の前にあるすべての点、線、または曲線を描画する前に、深さを維持するために、地球の後ろにあるものを最初に描画する必要があります。
描画フレームワークまたは描画ライブラリ。Delphi には、デフォルトで標準の Windows GDI が装備されておりCanvas、ペイント ボックスのプロパティから利用できます。もう 1 つの可能性は、より高度で効率的な GDI+ です。特にアンチエイリアシングを考慮してください。これらは私が使用した 2 つのフレームワークですが、他にもあります。例: 3D オブジェクトを 2D に自動的に変換し、3D サーフェス、ライト、マテリアル、シェーダー、その他多くの機能を追加できる OpenGL。
この質問の最後に追加されたテスト アプリケーション。
ペイント作業のちらつきをなくすためのダブル バッファリング テクニック。ペイント ボックスにビットマップをペイントする前に、すべてが描画される別のビットマップ オブジェクトを選択しました。デモ プログラムは、それを使用しない場合のパフォーマンスも示しています (routine: GDIMultipleColorsDirect)。
フォームにペイント ボックスをドロップし、そのAlignプロパティをalClientに設定し、シミュレーション用のタイマー コンポーネントを追加し、 、 、 、および のフォーム イベント ハンドラをOnCreate追加OnDestroyしOnKeyPress、OnResizeのイベント ハンドラを追加しPaintBox1.OnPaintます。
object Form1: TForm1
Left = 497
Top = 394
Width = 450
Height = 450
Caption = 'Sphere'
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
object PaintBox1: TPaintBox
Left = 0
Top = 0
Width = 434
Height = 414
Align = alClient
OnPaint = PaintBox1Paint
end
object Timer1: TTimer
Interval = 25
OnTimer = Timer1Timer
Left = 7
Top = 7
end
end
デフォルトの GDI では、すべての点から次のすべての点まで線を引きます。奥行き感（遠近感）を出すために、手前の線を太くしました。また、濃い色から薄い色へ徐々に線の色を溢れさせていきます（ルーティン：GDIMultipleColors）。
いいけど、すべてのピクセルはとても難しいです！自分でアンチエイリアス処理を試してみましょう... ;) さらに、色の数を 2 つに減らしました。前が暗く、後ろが明るいです。これは、すべての個別の線分を取り除くためです。すべての円と子午線が 2 つのポリラインに分割されます。アンチエイリアシング効果のために、間に 3 番目の色を使用しました (ルーチン: GDIThreeColors)。
このアンチエイリアスはあまり魅力的ではありません。非常にスムーズなペイント作業を行うために、コードを GDI+ スタイルに変換しましょう。Delphi 2009 以降の場合、ライブラリはhere から入手できます。古いバージョンの Delphi の場合、ライブラリはここから入手できます。
GDI+ では、描画の動作が少し異なります。オブジェクトを作成TGPGraphicsし、そのコンストラクターを使用してデバイス コンテキストにアタッチします。続いて、オブジェクトに対する描画操作が API によって変換され、宛先コンテキスト (この場合はビットマップ) に出力されます (routine: GDIPlusDualLinewidths)。
まあ、それはすでにかなりのものです。しかし、この地球儀は、線幅が 2 つしかないポリラインで構成されています。間にいくつか追加しましょう。各円または子午線のセグメントの数は、Precision定数 (routine: GDIPlusMultipleLinewidths) によって制御されます。
キーを押して、上記のルーチンを繰り返します。
unit Globe;
interface
uses
Windows, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, Math,
GDIPAPI, GDIPOBJ;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure PaintBox1Paint(Sender: TObject);
private
FBmp: TBitmap;
FPen: TGPPen;
procedure GDIMultipleColorsDirect;
procedure GDIMultipleColors;
procedure GDIThreeColors;
procedure GDIPlusDualLinewidths;
procedure GDIPlusMultipleLinewidths;
public
A: Integer; //Alfa, rotation round X axis
B: Integer; //Beta, rotation round Y axis
C: TPoint; //Center
R: Integer; //Radius
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
LineColorFore = $00552B00;
LineColorMiddle = $00AA957F;
LineColorBack = $00FFDFBF;
BackColor = clWhite;
LineWidthFore = 4.5;
LineWidthBack = 1.5;
Precision = 10; //Should be even!
type
TCycle = 0..Precision - 1;
TPoint3D = record
X: Double;
Y: Double;
Z: Double;
end;
function Sphere(Phi, Lambda: Double): TPoint3D;
begin
Result.X := Cos(Phi) * Sin(Lambda);
Result.Y := Sin(Phi);
Result.Z := Cos(Phi) * Cos(Lambda);
end;
function RotateAroundX(const P: TPoint3D; Alfa: Double): TPoint3D;
begin
Result.X := P.X;
Result.Y := P.Y * Cos(Alfa) + P.Z * Sin(Alfa);
Result.Z := P.Y * -Sin(Alfa) + P.Z * Cos(Alfa);
end;
function RotateAroundY(const P: TPoint3D; Beta: Double): TPoint3D;
begin
Result.X := P.X * Cos(Beta) + P.Z * Sin(Beta);
Result.Y := P.Y;
Result.Z := P.X * -Sin(Beta) + P.Z * Cos(Beta);
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Brush.Style := bsClear; //This is múch cheaper then DoubleBuffered := True
FBmp := TBitmap.Create;
FPen := TGPPen.Create(ColorRefToARGB(ColorToRGB(clBlack)));
A := 35;
B := 25;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FPen.Free;
FBmp.Free;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
C.X := PaintBox1.ClientWidth div 2;
C.Y := PaintBox1.ClientHeight div 2;
R := Min(C.X, C.Y) - 10;
FBmp.Width := PaintBox1.ClientWidth;
FBmp.Height := PaintBox1.ClientHeight;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
A := A + 2;
B := B + 1;
PaintBox1.Invalidate;
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
Tag := Tag + 1;
PaintBox1.Invalidate;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
case Tag mod 5 of
0: GDIMultipleColorsDirect;
1: GDIMultipleColors;
2: GDIThreeColors;
3: GDIPlusDualLinewidths;
4: GDIPlusMultipleLinewidths;
end;
end;
procedure TForm1.GDIPlusMultipleLinewidths;
var
Lines: array of TPointFDynArray;
PointCount: Integer;
LineCount: Integer;
Drawing: TGPGraphics;
Alfa: Double;
Beta: Double;
Cycle: TCycle;
Phi: Integer;
Lambda: Integer;
P: TPoint3D;
Filter: TCycle;
PrevFilter: TCycle;
I: Integer;
procedure ResetLines;
begin
SetLength(Lines, 0);
LineCount := 0;
PointCount := 0;
end;
procedure FinishLastLine;
begin
if PointCount < 2 then
Dec(LineCount)
else
SetLength(Lines[LineCount - 1], PointCount);
end;
procedure NewLine;
begin
if LineCount > 0 then
FinishLastLine;
SetLength(Lines, LineCount + 1);
SetLength(Lines[LineCount], 361);
Inc(LineCount);
PointCount := 0;
end;
procedure AddPoint(X, Y: Single);
begin
Lines[LineCount - 1][PointCount] := MakePoint(X, Y);
Inc(PointCount);
end;
function CycleFromZ(Z: Single): TCycle;
begin
Result := Round((Z + 1) / 2 * High(TCycle));
end;
function CycleToLineWidth(ACycle: TCycle): Single;
begin
Result := LineWidthBack +
(LineWidthFore - LineWidthBack) * (ACycle / High(TCycle));
end;
function CycleToLineColor(ACycle: TCycle): TGPColor;
begin
if ACycle <= (High(TCycle) div 2) then
Result := ColorRefToARGB(ColorToRGB(LineColorBack))
else
Result := ColorRefToARGB(ColorToRGB(LineColorFore));
end;
begin
Drawing := TGPGraphics.Create(FBmp.Canvas.Handle);
try
Drawing.Clear(ColorRefToARGB(ColorToRGB(clWhite)));
Drawing.SetSmoothingMode(SmoothingModeAntiAlias);
Alfa := DegToRad(A);
Beta := DegToRad(B);
for Cycle := Low(TCycle) to High(TCycle) do
begin
ResetLines;
//Latitude
for Phi := -8 to 8 do
begin
NewLine;
PrevFilter := 0;
for Lambda := 0 to 360 do
begin
P := Sphere(DegToRad(Phi * 10), DegToRad(Lambda));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
Filter := CycleFromZ(P.Z);
if Filter <> PrevFilter then
begin
AddPoint(C.X + P.X * R, C.Y + P.Y * R);
NewLine;
end;
if Filter = Cycle then
AddPoint(C.X + P.X * R, C.Y + P.Y * R);
PrevFilter := Filter;
end;
end;
//Longitude
for Lambda := 0 to 17 do
begin
NewLine;
PrevFilter := 0;
for Phi := 0 to 360 do
begin
P := Sphere(DegToRad(Phi), DegToRad(Lambda * 10));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
Filter := CycleFromZ(P.Z);
if Filter <> PrevFilter then
begin
AddPoint(C.X + P.X * R, C.Y + P.Y * R);
NewLine;
end;
if Filter = Cycle then
AddPoint(C.X + P.X * R, C.Y + P.Y * R);
PrevFilter := Filter;
end;
end;
FinishLastLine;
FPen.SetColor(CycleToLineColor(Cycle));
FPen.SetWidth(CycleToLineWidth(Cycle));
for I := 0 to LineCount - 1 do
Drawing.DrawLines(FPen, PGPPointF(@(Lines[I][0])), Length(Lines[I]));
if Cycle = (High(TCycle) div 2 + 1) then
Drawing.DrawEllipse(FPen, C.X - R, C.Y - R, 2 * R, 2 * R);
end;
finally
Drawing.Free;
end;
PaintBox1.Canvas.Draw(0, 0, FBmp);
end;
procedure TForm1.GDIPlusDualLinewidths;
const
LineColors: array[Boolean] of TColor = (LineColorFore, LineColorBack);
LineWidths: array[Boolean] of Single = (LineWidthFore, LineWidthBack);
BackColor = clWhite;
var
Lines: array of TPointFDynArray;
PointCount: Integer;
LineCount: Integer;
Drawing: TGPGraphics;
Alfa: Double;
Beta: Double;
Phi: Integer;
Lambda: Integer;
BackSide: Boolean;
P: TPoint3D;
PrevZ: Double;
I: Integer;
procedure ResetLines;
begin
SetLength(Lines, 0);
LineCount := 0;
PointCount := 0;
end;
procedure FinishLastLine;
begin
if PointCount < 2 then
Dec(LineCount)
else
SetLength(Lines[LineCount - 1], PointCount);
end;
procedure NewLine;
begin
if LineCount > 0 then
FinishLastLine;
SetLength(Lines, LineCount + 1);
SetLength(Lines[LineCount], 361);
Inc(LineCount);
PointCount := 0;
end;
procedure AddPoint(X, Y: Single);
begin
Lines[LineCount - 1][PointCount] := MakePoint(X, Y);
Inc(PointCount);
end;
begin
Drawing := TGPGraphics.Create(FBmp.Canvas.Handle);
try
Drawing.Clear(ColorRefToARGB(ColorToRGB(clWhite)));
Drawing.SetSmoothingMode(SmoothingModeAntiAlias);
Alfa := DegToRad(A);
Beta := DegToRad(B);
for BackSide := True downto False do
begin
ResetLines;
//Latitude
for Phi := -8 to 8 do
begin
NewLine;
PrevZ := 0;
for Lambda := 0 to 360 do
begin
P := Sphere(DegToRad(Phi * 10), DegToRad(Lambda));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
if Sign(P.Z) <> Sign(PrevZ) then
NewLine;
if (BackSide and (P.Z < 0)) or (not BackSide and (P.Z >= 0)) then
AddPoint(C.X + P.X * R, C.Y + P.Y * R);
PrevZ := P.Z;
end;
end;
//Longitude
for Lambda := 0 to 17 do
begin
NewLine;
PrevZ := 0;
for Phi := 0 to 360 do
begin
P := Sphere(DegToRad(Phi), DegToRad(Lambda * 10));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
if Sign(P.Z) <> Sign(PrevZ) then
NewLine;
if (BackSide and (P.Z < 0)) or (not BackSide and (P.Z >= 0)) then
AddPoint(C.X + P.X * R, C.Y + P.Y * R);
PrevZ := P.Z;
end;
end;
FinishLastLine;
FPen.SetColor(ColorRefToARGB(ColorToRGB(LineColors[BackSide])));
FPen.SetWidth(LineWidths[BackSide]);
for I := 0 to LineCount - 1 do
Drawing.DrawLines(FPen, PGPPointF(@(Lines[I][0])), Length(Lines[I]));
end;
Drawing.DrawEllipse(FPen, C.X - R, C.Y - R, 2 * R, 2 * R);
finally
Drawing.Free;
end;
PaintBox1.Canvas.Draw(0, 0, FBmp);
end;
procedure TForm1.GDIThreeColors;
const
LineColors: array[TValueSign] of TColor = (LineColorBack, LineColorMiddle,
LineColorFore);
LineWidths: array[TValueSign] of Integer = (2, 4, 2);
var
Lines: array of array of TPoint;
PointCount: Integer;
LineCount: Integer;
Alfa: Double;
Beta: Double;
Phi: Integer;
Lambda: Integer;
BackSide: Boolean;
P: TPoint3D;
PrevZ: Double;
I: TValueSign;
J: Integer;
procedure ResetLines;
begin
SetLength(Lines, 0);
LineCount := 0;
PointCount := 0;
end;
procedure FinishLastLine;
begin
if PointCount < 2 then
Dec(LineCount)
else
SetLength(Lines[LineCount - 1], PointCount);
end;
procedure NewLine;
begin
if LineCount > 0 then
FinishLastLine;
SetLength(Lines, LineCount + 1);
SetLength(Lines[LineCount], 361);
Inc(LineCount);
PointCount := 0;
end;
procedure AddPoint(APoint: TPoint); overload;
var
Last: TPoint;
begin
if PointCount > 0 then
begin
Last := Lines[LineCount - 1][PointCount - 1];
if (APoint.X = Last.X) and (APoint.Y = Last.Y) then
Exit;
end;
Lines[LineCount - 1][PointCount] := APoint;
Inc(PointCount);
end;
procedure AddPoint(X, Y: Integer); overload;
begin
AddPoint(Point(X, Y));
end;
begin
FBmp.Canvas.Brush.Color := BackColor;
FBmp.Canvas.FillRect(Rect(0, 0, FBmp.Width, FBmp.Height));
Alfa := DegToRad(A);
Beta := DegToRad(B);
for BackSide := True downto False do
begin
ResetLines;
//Latitude
for Phi := -8 to 8 do
begin
NewLine;
PrevZ := 0;
for Lambda := 0 to 360 do
begin
P := Sphere(DegToRad(Phi * 10), DegToRad(Lambda));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
if Sign(P.Z) <> Sign(PrevZ) then
NewLine;
if (BackSide and (P.Z < 0)) or (not BackSide and (P.Z >= 0)) then
AddPoint(Round(C.X + P.X * R), Round(C.Y + P.Y * R));
PrevZ := P.Z;
end;
end;
//Longitude
for Lambda := 0 to 17 do
begin
NewLine;
PrevZ := 0;
for Phi := 0 to 360 do
begin
P := Sphere(DegToRad(Phi), DegToRad(Lambda * 10));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
if Sign(P.Z) <> Sign(PrevZ) then
NewLine;
if (BackSide and (P.Z < 0)) or (not BackSide and (P.Z >= 0)) then
AddPoint(Round(C.X + P.X * R), Round(C.Y + P.Y * R));
PrevZ := P.Z;
end;
end;
FinishLastLine;
if BackSide then
begin
FBmp.Canvas.Pen.Color := LineColors[-1];
FBmp.Canvas.Pen.Width := LineWidths[-1];
for J := 0 to LineCount - 1 do
FBmp.Canvas.Polyline(Lines[J]);
end
else
for I := 0 to 1 do
begin
FBmp.Canvas.Pen.Color := LineColors[I];
FBmp.Canvas.Pen.Width := LineWidths[I];
for J := 0 to LineCount - 1 do
FBmp.Canvas.Polyline(Lines[J])
end
end;
FBmp.Canvas.Brush.Style := bsClear;
FBmp.Canvas.Ellipse(C.X - R, C.Y - R, C.X + R, C.Y + R);
PaintBox1.Canvas.Draw(0, 0, FBmp);
end;
procedure TForm1.GDIMultipleColors;
var
Alfa: Double;
Beta: Double;
Phi: Integer;
Lambda: Integer;
P: TPoint3D;
Backside: Boolean;
function ColorFromZ(Z: Single): TColorRef;
var
R: Integer;
G: Integer;
B: Integer;
begin
Z := (Z + 1) / 2;
R := GetRValue(LineColorFore) - GetRValue(LineColorBack);
R := GetRValue(LineColorBack) + Round(Z * R);
G := GetGValue(LineColorFore) - GetGValue(LineColorBack);
G := GetGValue(LineColorBack) + Round(Z * G);
B := GetBValue(LineColorFore) - GetBValue(LineColorBack);
B := GetBValue(LineColorBack) + Round(Z * B);
Result := RGB(R, G, B);
end;
begin
FBmp.Canvas.Pen.Width := 2;
FBmp.Canvas.Brush.Color := BackColor;
FBmp.Canvas.FillRect(PaintBox1.ClientRect);
Alfa := DegToRad(A);
Beta := DegToRad(B);
for Backside := True downto False do
begin
if not BackSide then
FBmp.Canvas.Pen.Width := 3;
//Latitude
for Phi := -8 to 8 do
for Lambda := 0 to 360 do
begin
P := Sphere(DegToRad(Phi * 10), DegToRad(Lambda));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
if (Lambda = 0) or (Backside and (P.Z >= 0)) or
(not Backside and (P.Z < 0)) then
FBmp.Canvas.MoveTo(C.X + Round(P.X * R), C.Y + Round(P.Y * R))
else
begin
FBmp.Canvas.Pen.Color := ColorFromZ(P.Z);
FBmp.Canvas.LineTo(C.X + Round(P.X * R), C.Y + Round(P.Y * R));
end;
end;
//Longitude
for Lambda := 0 to 17 do
for Phi := 0 to 360 do
begin
P := Sphere(DegToRad(Phi), DegToRad(Lambda * 10));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
if (Phi = 0) or (Backside and (P.Z >= 0)) or
(not Backside and (P.Z < 0)) then
FBmp.Canvas.MoveTo(C.X + Round(P.X * R), C.Y + Round(P.Y * R))
else
begin
FBmp.Canvas.Pen.Color := ColorFromZ(P.Z);
FBmp.Canvas.LineTo(C.X + Round(P.X * R), C.Y + Round(P.Y * R));
end;
end;
end;
PaintBox1.Canvas.Draw(0, 0, FBmp);
end;
procedure TForm1.GDIMultipleColorsDirect;
var
Alfa: Double;
Beta: Double;
Phi: Integer;
Lambda: Integer;
P: TPoint3D;
Backside: Boolean;
function ColorFromZ(Z: Single): TColorRef;
var
R: Integer;
G: Integer;
B: Integer;
begin
Z := (Z + 1) / 2;
R := GetRValue(LineColorFore) - GetRValue(LineColorBack);
R := GetRValue(LineColorBack) + Round(Z * R);
G := GetGValue(LineColorFore) - GetGValue(LineColorBack);
G := GetGValue(LineColorBack) + Round(Z * G);
B := GetBValue(LineColorFore) - GetBValue(LineColorBack);
B := GetBValue(LineColorBack) + Round(Z * B);
Result := RGB(R, G, B);
end;
begin
PaintBox1.Canvas.Pen.Width := 2;
PaintBox1.Canvas.Brush.Color := BackColor;
PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);
Alfa := DegToRad(A);
Beta := DegToRad(B);
for Backside := True downto False do
begin
if not BackSide then
PaintBox1.Canvas.Pen.Width := 3;
//Latitude
for Phi := -8 to 8 do
for Lambda := 0 to 360 do
begin
P := Sphere(DegToRad(Phi * 10), DegToRad(Lambda));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
if (Lambda = 0) or (Backside and (P.Z >= 0)) or
(not Backside and (P.Z < 0)) then
PaintBox1.Canvas.MoveTo(C.X + Round(P.X * R), C.Y + Round(P.Y * R))
else
begin
PaintBox1.Canvas.Pen.Color := ColorFromZ(P.Z);
PaintBox1.Canvas.LineTo(C.X + Round(P.X * R), C.Y + Round(P.Y * R));
end;
end;
//Longitude
for Lambda := 0 to 17 do
for Phi := 0 to 360 do
begin
P := Sphere(DegToRad(Phi), DegToRad(Lambda * 10));
P := RotateAroundX(P, Alfa);
P := RotateAroundY(P, Beta);
if (Phi = 0) or (Backside and (P.Z >= 0)) or
(not Backside and (P.Z < 0)) then
PaintBox1.Canvas.MoveTo(C.X + Round(P.X * R), C.Y + Round(P.Y * R))
else
begin
PaintBox1.Canvas.Pen.Color := ColorFromZ(P.Z);
PaintBox1.Canvas.LineTo(C.X + Round(P.X * R), C.Y + Round(P.Y * R));
end;
end;
end;
end;
end.
(bummi さんのコメントに感謝します。)