Fatal编程技术网
  • delphi/
  • Delphi的TImage控件绘制球体

Delphi的TImage控件绘制球体

delphi 3d geometry

Delphi的TImage控件绘制球体,delphi,3d,geometry,Delphi,3d,Geometry,我想画这样的球体： 下面的代码是生成圆的顶点并在TIMAGE上绘制圆，但我希望它用于球体： 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(pntC

我想画这样的球体：

下面的代码是生成圆的顶点并在TIMAGE上绘制圆，但我希望它用于球体：

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
    属性使用。另一种可能性是GDI+，它更先进，效率更高。特别是考虑到抗锯齿。这是我使用的两个框架，但也有其他框架。例如：OpenGL，它自动将3D对象转换为2D，并能够添加3D曲面、灯光、材质、着色器和更多功能

  • 测试应用程序，添加在此问题底部

  • 双缓冲技术，使绘画作品不闪烁。在画框上绘制位图之前，我选择了一个单独的位图对象，在该对象上绘制所有内容。演示程序还演示了没有它的性能（例程：
    GDIMultipleColorsDirect
    ）

设置： 在窗体上放置一个绘制框，并将其
Align
属性设置为
alClient
，添加用于模拟的计时器组件，为
OnCreate
、
ondestory
、
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
）

第二次尝试： 不错，但是所有的像素都太硬了！让我们试着自己做一些消除混叠…；）此外，我将颜色数减少到两种：前面是深色，后面是浅色。这样做是为了去除所有单独的线段：现在每个圆和子午线被划分为两条多段线。我使用了中间的第三种颜色来实现抗锯齿效果（例程：
GDIThreeColors
）

GDI+拯救： 这种反走样不是最迷人的。为了获得真正平滑的绘制工作，让我们将代码转换为GDI+样式。对于Delphi 2009及以上版本，该库可用。对于较旧的Delphi版本，该库可用

在GDI+中，绘图的工作方式有点不同。创建
TGPGraphics
对象，并使用其构造函数将其附加到设备上下文。随后，API将转换对象上的绘图操作，并将输出到目标上下文，即本例中的位图（例程：
GDIPlusDualLinewidths
）

能做得更好吗？ 嗯，这已经很了不起了。但是这个地球仪是由多段线组成的，只有两种不同的线宽。让我们在两者之间加上一些。每个圆或子午线中的分段计数由
精度
常数控制（例程：
gdiplus多线宽度
）

示例应用程序： 按一个键循环执行上述例行程序

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.

unitglobe；
接口
使用
Windows、SysUtils、类、图形、控件、窗体、ExtCtrls、数学、，
GDIPAPI，GDIPOBJ；
类型
TForm1=类（TForm）
PaintBox1:tPaintbox1；
定时器1:TTimer；
过程表单创建（发送方：ToObject）；
销毁程序表（发送方：TObject）；
过程FormResize（发送方：ToObject）；
程序定时器1定时器（发送方：TObject）；
过程FormKeyPress（发送方：TObject；变量键：Char）；
程序喷漆箱1喷漆（发送方：TObject）；
私有的
FBmp:TBitmap；
FPen:TGPPen；
程序GDIMultipleColorsDirect；
程序GDIMultipleColor；
程序和颜色；
程序GDIPLUS双线宽；
程序GDIPlusMultipleLinewidths；
公众的
A：整数//阿尔法，绕X轴旋转
B：整数//β，绕Y轴旋转
C：t点//居中
R：整数//半径
结束；
变量
表1:TForm1；
实施
{$R*.DFM}
常数
LineColorFore=$00552B00；
LineColorMiddle=$00AA957F；
LineColorBack=$00FFDFBF；
背景色=白色；
线宽fore=4.5；
LineWidthBack=1.5；
精度=10//应该是平的！
类型
TCycle=0..Precision-1；
TPoint3D=记录
X:双倍；
Y:双倍；
Z:双倍；
结束；
函数球体（φ，λ：双）：TPoint3D；
开始
结果X:=Cos（φ）*Sin（λ）；
结果Y:=Sin（φ）；
结果Z:=Cos（φ）*Cos（λ）；
结束；
函数RotateAroundX（常数P:TPoint3D；Alfa:Double）：TPoint3D；
开始
结果X:=P.X；
结果Y:=P.Y*Cos（Alfa）+P.Z*Sin（Alfa）；
结果Z:=P.Y*-Sin（Alfa）+P.Z*Cos（Alfa）；
结束；
函数旋转