绘制球体上的TImage控制德尔福 [英] Draw Sphere on TImage control of Delphi
本文介绍了绘制球体上的TImage控制德尔福的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我想提请球是这样的：
下面code是产生圈的顶点和借鉴的TImage圆，但我想它SPHERE：
对于i：= 0到360就开始
//找到X和Y的值
pntCordXY.X：=半径* COS（DegToRad（ⅰ））;
pntCordXY.Y：=半径* SIN（DegToRad（一））;
如果I = 0，则
image1.Canvas.MoveTo（圆（pntCordXY.X），圆形（pntCordXY.Y））
其他
image1.Canvas.LineTo（圆（pntCordXY.X），圆形（pntCordXY.Y））;
结束;
解决方案
这竟然是一个有趣的练习;有趣的问题！
首先，你要专门针对上绘制这样一个球一个的TImage ，但该组件应该是用于显示图形。当然，它具有其上可以得出一个画布，但下面我用一个 TPaintBox 这是preferred组件自己的绘画。因为，你必须自己绘制此。完全放弃了。
配料需要：
-
一些数学计算3D点上的球体，绕多个轴的地球，并可能用于将3D点到2D屏幕坐标系。基本要点有：
键入 TPoint3D =记录 X：双; Y：双; Z：双; 结束; 函数球（皮皮，LAMBDA：双人间）：TPoint3D; 开始 Result.X：= COS（PHI）*罪（波长）; Result.Y：= SIN（披）; Result.Z：= COS（PHI）* COS（LAMBDA）; 结束; 功能RotateAroundX（常量警：TPoint3D;阿尔法：双人间）：TPoint3D; 开始 Result.X：= P.X; Result.Y：= P.Y * COS（阿尔法）+ P.Z * SIN（阿尔法）; Result.Z：= P.Y * -sin（阿尔法）+ P.Z * COS（阿尔法）; 结束; 功能RotateAroundY（常量警：TPoint3D;β：双人间）：TPoint3D; 开始 Result.X：= P.X * COS（测试版）+ P.Z * SIN（测试版）; Result.Y：= P.Y; Result.Z：= P.X * -sin（测试版）+ P.Z * COS（测试版）; 结束; -
一些全球变量一起工作：
变种 阿尔法：整数; //旋转围绕X轴 Beta版：整数; //绕Y轴旋转 C：TPoint; //中央 R：整; //半径 皮皮：整数; //角度相对于XY平面 LAMBDA：整数;绕Z轴//角度（从南极到北极） 病人：TPoint3D; 3D点的球面上的表面// 2D投影 -
code来计算纬度圈的所有点：
的皮皮：= -8〜8做 为LAMBDA：= 0至360做 开始 病人：=球（DegToRad（披* 10），DegToRad（波长））; 病人：= RotateAroundX（P，阿尔法）; 病人：= RotateAroundY（P，β）; 结束; -
code来计算经度经络的所有点：
的LAMBDA：= 0〜17做 对于皮皮：= 0到360做 开始 病人：=球（DegToRad（PHI），DegToRad（LAMBDA * 10））; 病人：= RotateAroundX（P，阿尔法）; 病人：= RotateAroundY（P，β）; 结束;这些点可以用来画上颜料盒直线或曲线。不用于绘图这些点的Z值，但它们是决定点是否位于地球的背面或前侧有帮助
-
逻辑和艾滋病。前在地球的前方的点，线或曲线可以得出，那些在地球的背面都首先被绘制，以preserve的深度的
-
一个绘制框架或绘图库。德尔福是通过
默认配备了标准的Windows GDI，可在油漆中的画布属性。另一种可能性是GDI +哪个更先进，可以更有效。特别是考虑到反aliassing。这是我与两个框架，但也有其他人。例如：OpenGL的，其将3D对象自动2D并能够添加3D曲面，灯光，材质，着色器，还有更多的功能的 。
-
一个测试应用程序，它加入了这个问题的底部。
-
一个双缓冲技术来获得油漆工作无闪烁。我选择了上一切都绘制一个单独的位图对象，之前画的颜料盒的位图。演示程序也显示性能，而它（常规：
GDIMultipleColorsDirect）。
设置：
删除一个颜料盒的形式，其对齐属性设置为为alClient ，添加一个计时器组件模拟，添加表单事件处理程序的OnCreate ，的OnDestroy ， OnKey preSS 和 onResize受到，然后添加一个事件处理程序 PaintBox1.OnPaint 。
对象Form1中：TForm1
左= 497
顶部= 394
宽度= 450
身高= 450
标题='球'
颜色= clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name ='宋体'
Font.Style = []
OldCreateOrder =假
在OnCreate = FormCreate
的OnDestroy = FormDestroy
OnKey preSS = FormKey preSS
onResize受到= FormResize
PixelsPerInch = 96
textHeight不同= 13
对象PaintBox1：TPaintBox
左= 0
顶部= 0
宽度= 434
身高= 414
ALIGN =为alClient
的OnPaint = PaintBox1Paint
结束
反对定时器1：的TTimer
间隔= 25
的OnTimer = Timer1Timer
左= 7
TOP = 7
结束
结束
第一次尝试：
在默认GDI，我画的每一点每一个点线。要增加深度（角度）的感觉，我给了前面的线更大的宽度。另外，我渐渐让线条的颜色由深溢出光（常规： GDIMultipleColors ）。
第二次尝试：
不错，但所有像素都这么难！让我们尝试做一些反aliassing ourselfs ...）。此外，我减少了颜色数到二：黑暗面前，光在后面。这是为了摆脱所有独立线段：现在每圈和经络分为2折线。我用的是第三种颜色之间的反aliassing效应（常规： GDIThreeColors ）。
GDI +救援：
这反aliassing不是最迷人的。要获得真正光滑的喷漆工作，让我们转换code到GDI +的风格。对于德尔福2009年及以上，该库可从这里。对于老版本的Delphi，该库可从这里。
在GDI +，绘图工作稍有不同。创建一个 TGPGraphics 对象，并将其连接到其构造的设备上下文。随后，在对象上的绘图操作是由API翻译和将被输出到的目的地上下文，位图在此情况下（常规： GDIPlusDualLinewidths ）。
它可以更好呢？
嗯，这是相当成才了。但是，这个地球是编造出来的折线仅使用两个不同的线宽。让我们添加一些介于两者之间。在每一个圆或经络段的计数由控制 precision 常数（常规： GDIPlusMultipleLinewidths ）。
示例应用程序：
preSS通过上述的程序一键循环。
单元截止;
接口
用途
Windows中，SysUtils单元，类图形，控件，窗体，ExtCtrls，数学，
GDIPAPI，GDIPOBJ;
类型
TForm1 =类（TForm的）
PaintBox1：TPaintBox;
定时器1：的TTimer;
程序FormCreate（发件人：TObject的）;
程序FormDestroy（发件人：TObject的）;
程序FormResize（发件人：TObject的）;
程序Timer1Timer（发件人：TObject的）;
程序FormKey preSS（发件人：TObject的; VAR键：夏亚）;
程序PaintBox1Paint（发件人：TObject的）;
私人
FBmp：TBitmap;
FPen：TGPPen;
程序GDIMultipleColorsDirect;
程序GDIMultipleColors;
程序GDIThreeColors;
程序GDIPlusDualLinewidths;
程序GDIPlusMultipleLinewidths;
上市
答：整数; //阿尔法，旋转轮X轴
B：整数; // Beta版，旋转轮Y轴
C：TPoint; //中央
R：整; //半径
结束;
变种
Form1中：TForm1;
履行
{$ R * .DFM}
常量
LineColorFore = $ 00552B00;
LineColorMiddle = $ 00AA957F;
LineColorBack = $ 00FFDFBF;
背景色= clWhite;
LineWidthFore = 4.5;
LineWidthBack = 1.5;
precision = 10; //要均匀！
类型
t周期= 0 .. precision - 1;
TPoint3D =记录
X：双;
Y：双;
Z：双;
结束;
函数球（皮皮，LAMBDA：双人间）：TPoint3D;
开始
Result.X：= COS（PHI）*罪（波长）;
Result.Y：= SIN（披）;
Result.Z：= COS（PHI）* COS（LAMBDA）;
结束;
功能RotateAroundX（常量警：TPoint3D;阿尔法：双人间）：TPoint3D;
开始
Result.X：= P.X;
Result.Y：= P.Y * COS（阿尔法）+ P.Z * SIN（阿尔法）;
Result.Z：= P.Y * -sin（阿尔法）+ P.Z * COS（阿尔法）;
结束;
功能RotateAroundY（常量警：TPoint3D;β：双人间）：TPoint3D;
开始
Result.X：= P.X * COS（测试版）+ P.Z * SIN（测试版）;
Result.Y：= P.Y;
Result.Z：= P.X * -sin（测试版）+ P.Z * COS（测试版）;
结束;
{TForm1}
程序TForm1.FormCreate（发件人：TObject的）;
开始
Brush.Style：= bsClear; //这是便宜得多，那么DoubleBuffered：= TRUE
FBmp：= TBitmap.Create;
FPen：= TGPPen.Create（ColorRefToARGB（ColorToRGB（clBlack）））;
答：= 35;
B：= 25;
结束;
程序TForm1.FormDestroy（发件人：TObject的）;
开始
FPen.Free;
FBmp.Free;
结束;
程序TForm1.FormResize（发件人：TObject的）;
开始
C.X：= PaintBox1.ClientWidth 2区;
C.Y：= PaintBox1.ClientHeight 2区;
R：=最小值（C.X，C.Y） - 10;
FBmp.Width：= PaintBox1.ClientWidth;
FBmp.Height：= PaintBox1.ClientHeight;
结束;
程序TForm1.Timer1Timer（发件人：TObject的）;
开始
答：= A + 2;
B：= B + 1;
PaintBox1.Invalidate;
结束;
程序TForm1.FormKey preSS（发件人：TObject的; VAR键：夏亚）;
开始
标签：=标签+ 1;
PaintBox1.Invalidate;
结束;
程序TForm1.PaintBox1Paint（发件人：TObject的）;
开始
的情况下，标签mod5
0：GDIMultipleColorsDirect;
1：GDIMultipleColors;
2：GDIThreeColors;
3：GDIPlusDualLinewidths;
4：GDIPlusMultipleLinewidths;
结束;
结束;
程序TForm1.GDIPlusMultipleLinewidths;
变种
行：TPointFDynArray的阵列;
PointCount：整数;
LineCount：整数;
图：TGPGraphics;
阿尔法：双;
Beta版：双;
周期：时钟周期内完成;
皮皮：整数;
LAMBDA：整数;
病人：TPoint3D;
过滤器：时钟周期内完成;
prevFilter：时钟周期内完成;
我：整数;
程序ResetLines;
开始
SetLength（系，0）;
LineCount：= 0;
PointCount：= 0;
结束;
程序FinishLastLine;
开始
如果PointCount＆LT; 2则
十二月（LineCount）
其他
SetLength（系[LineCount - 1]，PointCount）;
结束;
程序换行;
开始
如果LineCount＆GT; 0，则
FinishLastLine;
SetLength（系，LineCount + 1）;
SetLength（系[LineCount]，361）;
公司（LineCount）;
PointCount：= 0;
结束;
程序AddPoint（X，Y：单）;
开始
线[LineCount - 1] [PointCount]：= MakePoint（X，Y）;
公司（PointCount）;
结束;
功能CycleFromZ（Z：单）：时钟周期内完成;
开始
结果：= ROUND（（Z + 1）/ 2 *高（时钟周期内完成））;
结束;
功能CycleToLineWidth（ACycle：时钟周期内完成）：单;
开始
结果：= LineWidthBack +
（LineWidthFore - LineWidthBack）*（ACycle /高（时钟周期内完成））;
结束;
功能CycleToLineColor（ACycle：时钟周期内完成）：TGPColor;
开始
如果ACycle＆LT; =（高（时钟周期内完成）DIV 2）然后
结果：= ColorRefToARGB（ColorToRGB（LineColorBack））
其他
结果：= ColorRefToARGB（ColorToRGB（LineColorFore））;
结束;
开始
图：= TGPGraphics.Create（FBmp.Canvas.Handle）;
尝试
Drawing.Clear（ColorRefToARGB（ColorToRGB（clWhite）））;
Drawing.SetSmoothingMode（SmoothingModeAntiAlias）;
阿尔法：= DegToRad（A）;
Beta版：= DegToRad（B）;
对于周期：=低（时钟周期内完成）到高（时钟周期内完成）办
开始
ResetLines;
//纬度
对于皮皮：= -8〜8做
开始
换行;
prevFilter：= 0;
为LAMBDA：= 0至360做
开始
病人：=球（DegToRad（披* 10），DegToRad（波长））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
过滤：= CycleFromZ（P.Z）;
如果过滤器＆LT;＆GT; prevFilter然后
开始
AddPoint（C.X + P.X * R，C.Y + P.Y * R）;
换行;
结束;
如果过滤器=循环再
AddPoint（C.X + P.X * R，C.Y + P.Y * R）;
prevFilter：=过滤;
结束;
结束;
//经度
对于LAMBDA：= 0〜17做
开始
换行;
prevFilter：= 0;
对于皮皮：= 0到360做
开始
病人：=球（DegToRad（PHI），DegToRad（LAMBDA * 10））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
过滤：= CycleFromZ（P.Z）;
如果过滤器＆LT;＆GT; prevFilter然后
开始
AddPoint（C.X + P.X * R，C.Y + P.Y * R）;
换行;
结束;
如果过滤器=循环再
AddPoint（C.X + P.X * R，C.Y + P.Y * R）;
prevFilter：=过滤;
结束;
结束;
FinishLastLine;
FPen.SetColor（CycleToLineColor（循环））;
FPen.SetWidth（CycleToLineWidth（循环））;
因为我：= 0至LineCount - 1做
Drawing.DrawLines（FPen，PGPPointF（@（系[I] [0]）），长度（系[I]））;
如果周期=（高（时钟周期内完成）DIV 2 + 1），然后
Drawing.DrawEllipse（FPen，CX - R，CY - R，2 * R，2 * R）;
结束;
最后
Drawing.Free;
结束;
PaintBox1.Canvas.Draw（0，0，FBmp）;
结束;
程序TForm1.GDIPlusDualLinewidths;
常量
LineColors：数组TColor =（LineColorFore，LineColorBack）的[布尔]
线宽：阵列单=（LineWidthFore，LineWidthBack）的[布尔]
背景色= clWhite;
变种
行：TPointFDynArray的阵列;
PointCount：整数;
LineCount：整数;
图：TGPGraphics;
阿尔法：双;
Beta版：双;
皮皮：整数;
LAMBDA：整数;
背面：布尔;
病人：TPoint3D;
preVZ：双;
我：整数;
程序ResetLines;
开始
SetLength（系，0）;
LineCount：= 0;
PointCount：= 0;
结束;
程序FinishLastLine;
开始
如果PointCount＆LT; 2则
十二月（LineCount）
其他
SetLength（系[LineCount - 1]，PointCount）;
结束;
程序换行;
开始
如果LineCount＆GT; 0，则
FinishLastLine;
SetLength（系，LineCount + 1）;
SetLength（系[LineCount]，361）;
公司（LineCount）;
PointCount：= 0;
结束;
程序AddPoint（X，Y：单）;
开始
线[LineCount - 1] [PointCount]：= MakePoint（X，Y）;
公司（PointCount）;
结束;
开始
图：= TGPGraphics.Create（FBmp.Canvas.Handle）;
尝试
Drawing.Clear（ColorRefToARGB（ColorToRGB（clWhite）））;
Drawing.SetSmoothingMode（SmoothingModeAntiAlias）;
阿尔法：= DegToRad（A）;
Beta版：= DegToRad（B）;
对于背后：= TRUE DOWNTO假做
开始
ResetLines;
//纬度
对于皮皮：= -8〜8做
开始
换行;
preVZ：= 0;
为LAMBDA：= 0至360做
开始
病人：=球（DegToRad（披* 10），DegToRad（波长））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
如果注册（P.Z）＆LT;＆GT;符号（preVZ），那么
换行;
如果（背侧和（PZ℃，））或（未背侧和（PZ＆GT; = 0）），则
AddPoint（C.X + P.X * R，C.Y + P.Y * R）;
preVZ：= P.Z;
结束;
结束;
//经度
对于LAMBDA：= 0〜17做
开始
换行;
preVZ：= 0;
对于皮皮：= 0到360做
开始
病人：=球（DegToRad（PHI），DegToRad（LAMBDA * 10））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
如果注册（P.Z）＆LT;＆GT;符号（preVZ），那么
换行;
如果（背侧和（PZ℃，））或（未背侧和（PZ＆GT; = 0）），则
AddPoint（C.X + P.X * R，C.Y + P.Y * R）;
preVZ：= P.Z;
结束;
结束;
FinishLastLine;
FPen.SetColor（ColorRefToARGB（ColorToRGB（LineColors [背侧]）））;
FPen.SetWidth（线宽[背面]）;
因为我：= 0至LineCount - 1做
Drawing.DrawLines（FPen，PGPPointF（@（系[I] [0]）），长度（系[I]））;
结束;
Drawing.DrawEllipse（FPen，CX - R，CY - R，2 * R，2 * R）;
最后
Drawing.Free;
结束;
PaintBox1.Canvas.Draw（0，0，FBmp）;
结束;
程序TForm1.GDIThreeColors;
常量
LineColors：数组[TValueSign] TColor =（LineColorBack，LineColorMiddle的，
LineColorFore）;
线宽：数组[TValueSign]整数=（2，4，2）;
变种
行：TPoint的阵列的阵列;
PointCount：整数;
LineCount：整数;
阿尔法：双;
Beta版：双;
皮皮：整数;
LAMBDA：整数;
背面：布尔;
病人：TPoint3D;
preVZ：双;
我：TValueSign;
记者：整数;
程序ResetLines;
开始
SetLength（系，0）;
LineCount：= 0;
PointCount：= 0;
结束;
程序FinishLastLine;
开始
如果PointCount＆LT; 2则
十二月（LineCount）
其他
SetLength（系[LineCount - 1]，PointCount）;
结束;
程序换行;
开始
如果LineCount＆GT; 0，则
FinishLastLine;
SetLength（系，LineCount + 1）;
SetLength（系[LineCount]，361）;
公司（LineCount）;
PointCount：= 0;
结束;
程序AddPoint（的aPoint：TPoint）;超载;
变种
最后：TPoint;
开始
如果PointCount＆GT; 0，则
开始
最后：=行[LineCount - 1] [PointCount - 1];
如果（APoint.X = Last.X）和（APoint.Y = Last.Y）然后
出口;
结束;
行[LineCount - 1] [PointCount]：=的aPoint;
公司（PointCount）;
结束;
程序AddPoint（X，Y：整数）;超载;
开始
AddPoint（点（X，Y））;
结束;
开始
FBmp.Canvas.Brush.Color：=背景色;
FBmp.Canvas.FillRect（矩形（0，0，FBmp.Width，FBmp.Height））;
阿尔法：= DegToRad（A）;
Beta版：= DegToRad（B）;
对于背后：= TRUE DOWNTO假做
开始
ResetLines;
//纬度
对于皮皮：= -8〜8做
开始
换行;
preVZ：= 0;
为LAMBDA：= 0至360做
开始
病人：=球（DegToRad（披* 10），DegToRad（波长））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
如果注册（P.Z）＆LT;＆GT;符号（preVZ），那么
换行;
如果（背侧和（PZ℃，））或（未背侧和（PZ＆GT; = 0）），则
AddPoint（圆（CX + PX * R），圆形（CY + PY * R））;
preVZ：= P.Z;
结束;
结束;
//经度
对于LAMBDA：= 0〜17做
开始
换行;
preVZ：= 0;
对于皮皮：= 0到360做
开始
病人：=球（DegToRad（PHI），DegToRad（LAMBDA * 10））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
如果注册（P.Z）＆LT;＆GT;符号（preVZ），那么
换行;
如果（背侧和（PZ℃，））或（未背侧和（PZ＆GT; = 0）），则
AddPoint（圆（CX + PX * R），圆形（CY + PY * R））;
preVZ：= P.Z;
结束;
结束;
FinishLastLine;
如果背面则
开始
FBmp.Canvas.Pen.Color：= LineColors [-1];
FBmp.Canvas.Pen.Width：=线宽[-1]
对于记者：= 0至LineCount - 1做
FBmp.Canvas.Polyline（系[J]）;
结束
其他
因为我：= 0〜1做
开始
FBmp.Canvas.Pen.Color：= LineColors [Ⅰ];
FBmp.Canvas.Pen.Width：=线宽[Ⅰ];
对于记者：= 0至LineCount - 1做
FBmp.Canvas.Polyline（系[J]。）
结束
结束;
FBmp.Canvas.Brush.Style：= bsClear;
FBmp.Canvas.Ellipse（CX - R，CY - R，CX + R，CY + R）;
PaintBox1.Canvas.Draw（0，0，FBmp）;
结束;
程序TForm1.GDIMultipleColors;
变种
阿尔法：双;
Beta版：双;
皮皮：整数;
LAMBDA：整数;
病人：TPoint3D;
背面：布尔;
功能ColorFromZ（Z：单）：TColorRef;
变种
R：整;
G：整数;
B：整数;
开始
Z：=（z + 1）/ 2;
R：= GetRValue（LineColorFore） - GetRValue（LineColorBack）;
R：= GetRValue（LineColorBack）+圆形（Z * R）;
G：= GetGValue（LineColorFore） - GetGValue（LineColorBack）;
G：= GetGValue（LineColorBack）+圆形（Z * G）;
B：= GetBValue（LineColorFore） - GetBValue（LineColorBack）;
B：= GetBValue（LineColorBack）+圆形（Z * B）;
结果：= RGB（R，G，B）;
结束;
开始
FBmp.Canvas.Pen.Width：= 2;
FBmp.Canvas.Brush.Color：=背景色;
FBmp.Canvas.FillRect（PaintBox1.ClientRect）;
阿尔法：= DegToRad（A）;
Beta版：= DegToRad（B）;
对于背面：= TRUE DOWNTO假做
开始
如果不是背后则
FBmp.Canvas.Pen.Width：= 3;
//纬度
对于皮皮：= -8〜8做
为LAMBDA：= 0至360做
开始
病人：=球（DegToRad（披* 10），DegToRad（波长））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
如果（LAMBDA = 0）或（背面和（PZ＆GT; = 0））或
（未背侧和（P.Z℃，）），则
FBmp.Canvas.MoveTo（CX +圆（PX * R），CY +圆（PY * R））
其他
开始
FBmp.Canvas.Pen.Color：= ColorFromZ（P.Z）;
FBmp.Canvas.LineTo（CX +圆（PX * R），CY +圆（PY * R））;
结束;
结束;
//经度
对于LAMBDA：= 0〜17做
对于皮皮：= 0到360做
开始
病人：=球（DegToRad（PHI），DegToRad（LAMBDA * 10））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
如果（披= 0）或（背面和（P.Z＆GT; = 0））或
（未背侧和（P.Z℃，）），则
FBmp.Canvas.MoveTo（CX +圆（PX * R），CY +圆（PY * R））
其他
开始
FBmp.Canvas.Pen.Color：= ColorFromZ（P.Z）;
FBmp.Canvas.LineTo（CX +圆（PX * R），CY +圆（PY * R））;
结束;
结束;
结束;
PaintBox1.Canvas.Draw（0，0，FBmp）;
结束;
程序TForm1.GDIMultipleColorsDirect;
变种
阿尔法：双;
Beta版：双;
皮皮：整数;
LAMBDA：整数;
病人：TPoint3D;
背面：布尔;
功能ColorFromZ（Z：单）：TColorRef;
变种
R：整;
G：整数;
B：整数;
开始
Z：=（z + 1）/ 2;
R：= GetRValue（LineColorFore） - GetRValue（LineColorBack）;
R：= GetRValue（LineColorBack）+圆形（Z * R）;
G：= GetGValue（LineColorFore） - GetGValue（LineColorBack）;
G：= GetGValue（LineColorBack）+圆形（Z * G）;
B：= GetBValue（LineColorFore） - GetBValue（LineColorBack）;
B：= GetBValue（LineColorBack）+圆形（Z * B）;
结果：= RGB（R，G，B）;
结束;
开始
PaintBox1.Canvas.Pen.Width：= 2;
PaintBox1.Canvas.Brush.Color：=背景色;
PaintBox1.Canvas.FillRect（PaintBox1.ClientRect）;
阿尔法：= DegToRad（A）;
Beta版：= DegToRad（B）;
对于背面：= TRUE DOWNTO假做
开始
如果不是背后则
PaintBox1.Canvas.Pen.Width：= 3;
//纬度
对于皮皮：= -8〜8做
为LAMBDA：= 0至360做
开始
病人：=球（DegToRad（披* 10），DegToRad（波长））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
如果（LAMBDA = 0）或（背面和（PZ＆GT; = 0））或
（未背侧和（P.Z℃，）），则
PaintBox1.Canvas.MoveTo（CX +圆（PX * R），CY +圆（PY * R））
其他
开始
PaintBox1.Canvas.Pen.Color：= ColorFromZ（P.Z）;
PaintBox1.Canvas.LineTo（CX +圆（PX * R），CY +圆（PY * R））;
结束;
结束;
//经度
对于LAMBDA：= 0〜17做
对于皮皮：= 0到360做
开始
病人：=球（DegToRad（PHI），DegToRad（LAMBDA * 10））;
病人：= RotateAroundX（P，阿尔法）;
病人：= RotateAroundY（P，β）;
如果（披= 0）或（背面和（P.Z＆GT; = 0））或
（未背侧和（P.Z℃，）），则
PaintBox1.Canvas.MoveTo（CX +圆（PX * R），CY +圆（PY * R））
其他
开始
PaintBox1.Canvas.Pen.Color：= ColorFromZ（P.Z）;
PaintBox1.Canvas.LineTo（CX +圆（PX * R），CY +圆（PY * R））;
结束;
结束;
结束;
结束;
结束。
（与感谢bummi的评论。）
I want to draw sphere like this:
Below code is generates Circle's Vertices and Drawing a Circle on TIMAGE BUT i want it for 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;
解决方案
This turned out to be a fun exercise; nice question!
At first, you ask specifically for drawing such a sphere on a TImage, but that component is supposed to be used for showing graphics. Sure, it has a canvas on which can be drawn, but hereunder I use a TPaintBox which is the preferred component for own painting. Because, you will have to paint this yourself. Entirely.
Ingredients needed:
Some math for calculating the 3D points on a sphere, for rotating the globe around multiple axes, and maybe for converting the 3D points to the 2D screen coordinate system. The basics are:
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;Some globe-variables to work with:
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 surfaceCode to calculate all points of the latitude circles:
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;Code to calculate all points of the longitude meridians:
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;These points can be used to draw lines or curves on the paint box. The Z value of these points are not used for drawing, but they are helpful to decide whether the point lies on the back or front side of the globe.
Logic and aids. Before all points, lines or curves in front of the globe can be drawn, the ones in the back of globe have to be drawn first, in order to preserve depth.
A drawing framework or drawing library. Delphi is by default equipped with standard Windows GDI, available via the
Canvasproperty of the paint box. Another possibility is GDI+ which is more advanced and can be more efficient. Especially considering anti-aliassing. These are the two frameworks I worked with, but there are also others. For example: OpenGL, which converts 3D objects to 2D automatically and is capable of adding 3D surfaces, lights, materials, shaders, and many more features.A testing application, which is added at the bottom of this question.
A double buffering technique to get the paint work flicker-free. I chose a separate bitmap object on which everything is drawn, prior to painting that bitmap on the paint box. The demo program also demonstrates the performance without it (routine:
GDIMultipleColorsDirect).
Setup:
Drop a paint box on your form, and set its Align property to alClient, add a timer component for simulation, add form event handlers for OnCreate, OnDestroy, OnKeyPress, and OnResize, and add an event handler for 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
First attempt:
With default GDI, I draw lines from every point to every next point. To add a feeling of depth (perspective), I gave the lines in front a greater width. Also, I gradually let the colors of the lines overflow from dark to light (routine: GDIMultipleColors).
Second attempt:
Nice, but all pixels are so hard! Let's try doing some anti-aliassing ourselfs... ;) Furthermore, I reduced the color count to two: dark in front, light in the back. This in order to get rid of all separate line segments: now every circle and meridian is devided into two polylines. I used a third color in between for the anti-aliassing effect (routine: GDIThreeColors).
GDI+ to the rescue:
This anti-aliassing isn't most charming. To get really smooth paint work, let's convert the code to GDI+ style. For Delphi 2009 and up, the library is available from here. For older Delphi versions, the library is available from here.
In GDI+, drawing works a bit differently. Create a TGPGraphics object and attach it to a device context with its constructor. Subsequently, drawing operations on the object are translated by the API and will be output to the destination context, the bitmap in this case (routine: GDIPlusDualLinewidths).
Can it even better?
Well, that's quite someting already. But this globe is made up out of polylines with just two different line widths. Let's add some in between. The count of segments in each circle or meridian is controlled by the Precision constant (routine: GDIPlusMultipleLinewidths).
Sample application:
Press a key to cycle through the above mentioned routines.
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.
(With thanks to bummi's comment.)
这篇关于绘制球体上的TImage控制德尔福的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
