如何使线条平滑？？？(200分)

好象只要几句话就行了，但我当时没记现在忘了，希望大家能够帮帮我！
给我那几句代码行吗？
在此先谢谢了！

我也想知道，谢谢楼上提这个问题。[]

反走样？

我帮你提前！

另外，试试看CANvas.PolyBezier

几句话？不能吧，去看计算机图形学吧，不是很简单。yysun说过这个问题

来自：yysun 时间：00-3-22 21:59:57 ID:204035
将离散的点连接成为光滑曲线是我以前教《计算机地图制图》的主要内容之一。
其中有2个要点：
1、什么是光滑？光滑就是用细密的折线段来模拟曲线。
2、光滑后的曲线需要经过原始离散点。
B样条函数(PolyBezierTo，PolyBezier)不符合这个条件。
常用的方法叫5点光滑法(数学原理请参加测绘出版社的《计算机地图制图》)。
以下是程序：

unit Unit3;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
PaintBox1: TPaintBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
rpoint = record
x,y:single;
end;
rline=array[0..100] of rpoint;
xys = array[0..100] of single;

Const xWorldMin: single = 0; yWorldMin : single = 0;
xWorldMax: single = 100; yWorldMax : single = 100;
ScreenWidth: integer = 640; ScreenHeight : integer = 480;

var sScale: single;

procedure AdjustScale;
var sx, sy: single;
begin
sx := (xWorldMax - xWorldMin)/ ScreenWidth;
sy := (yWorldMax - yWorldMin)/ ScreenHeight;
if sx < sy then sScale := 1.0/sy
else sScale := 1.0/sx;
xWorldMax := xWorldMin + ScreenWidth / sScale;
yWorldMin := yWorldMax - ScreenHeight / sScale ;
end;

procedure XYWorld2Screen(x, y: single; var xx, yy: integer);
begin
xx := trunc ((x - xWorldMin) *sScale);
yy := trunc ((yWorldMax - y) *sScale);
xx := trunc( (x - xWorldMin) / (xWorldMax - xWorldMin) * ScreenWidth);
yy := trunc( (yWorldMax - y) / (yWorldMax - yWorldMin) * ScreenHeight);
end;

procedure pMoveTo(x, y: single);
var sx, sy: integer;
begin
XYWorld2Screen(x, y, sx, sy);
Form1.Paintbox1.Canvas.MoveTo(sx, sy);
end;

procedure pLineTo(x, y: single);
var sx, sy: integer;
begin
XYWorld2Screen(x, y, sx, sy);
Form1.Paintbox1.Canvas.LineTo(sx, sy);
end;

procedure pPolyline(rl: rline; no:integer);
var ii: integer;
begin
pMoveto(rl[0].x, rl[0].y);
for ii := 1 to no-1 do pLineto(rl[ii].x, rl[ii].y);
end;

procedure smoothline(rl: rline; no:integer);
const step = 0.1;
dist = 0.05;
var
k,m,l,j,cir1,ctl:integer;
bb:char;
a,b,x1,y1:array[1..5] of single;
sn,sn1,sn2,cn,cn1,cn2,w2,w3,z,z1,a0,b0,sn4,cn4,
p0,p1,p2,p3,q0,q1,q2,q3,xt,yt,xt1,yt1,lastx,lasty,p11,p21,q11,q21:single;

r,r1:single;
x,y : ^xys;
begin
ctl:=1;sn2:=0;cn2:=0;sn1:=0;cn1:=0;

if (no<3) then begin
pMoveTo(rl[0].x,rl[0].y);
pLineTo(rl[1].x,rl[1].y);
end;
new(x);new;
pMoveto(rl[0].x,rl[0].y);
for k:=0 to no-1 do begin
x^[k+2]:=rl[k].x;
y^[k+2]:=rl[k].y;
end;
if ((abs(rl[0].x-rl[no-1].x)<0.05) and (abs(rl[0].y-rl[no-1].y)<0.05)) then begin
x^[1]:=rl[no-1].x;
y^[1]:=rl[no-1].y;
x^[0]:=rl[no-2].x;
y^[0]:=rl[no-2].y;
x^[no+3]:=rl[1].x;
y^[no+3]:=rl[1].y;
x^[no+2]:=rl[0].x;
y^[no+2]:=rl[0].y;
end
else begin
p0:=x^[2]; p1:=x^[3]; p2:=x^[4];
q0:=y^[2]; q1:=y^[3]; q2:=y^[4];
x^[1]:=3*(p0-p1)+p2;
y^[1]:=3*(q0-q1)+q2;
p0:=x^[1]; p1:=x^[2]; p2:=x^[3];
q0:=y^[1]; q1:=y^[2]; q2:=y^[3];
x^[0]:=3*(p0-p1)+p2;
y^[0]:=3*(q0-q1)+q2;
p0:=x^[no+1]; p1:=x^[no-1]; p2:=x^[no];
q0:=y^[no+1]; q1:=y^[no-1]; q2:=y^[no];
x^[no+2]:=3*(p0-p2)+p1;
y^[no+2]:=3*(q0-q2)+q1;
p0:=x^[no+2]; p1:=x^[no+1]; p2:=x^[no];
q0:=y^[no+2]; q1:=y^[no+1]; q2:=y^[no];
x^[no+3]:=3*(p0-p1)+p2;
y^[no+3]:=3*(q0-q1)+q2;
end;

for m:=3 to no+1 do begin
j:=m-2;
for k:=1 to 5 do begin
x1[k]:=x^[j];
y1[k]:=y^[j];
j:=j+1;
end;
for k:=1 to 4 do begin
a[k]:=x1[k+1]-x1[k];
b[k]:=y1[k+1]-y1[k];
end;
if m>=5 then begin sn1:=sn2; cn1:=cn2; end;
if ((a[2]=b[2]) and (a[2]=0)) then begin
a[2]:=a[1]; b[2]:=b[1];
end;
if ((a[3]=b[3]) and (a[3]=0)) then begin
a[3]:=a[2]; b[3]:=b[2];
end
else begin
if ((a[4]=b[4]) and (a[4]=0)) then begin
a[4]:=a[2]; b[4]:=b[2];
end;
end;

w2:=abs(a[3]*b[4]-a[4]*b[3]);
w3:=abs(a[1]*b[2]-a[2]*b[1]);
if ((w3=w2) and (w3=0)) then begin w2:=1; w3:=1; end;
a0:=w2*a[2]+w3*a[3]; b0:=w2*b[2]+w3*b[3];
r1:=a0*a0+b0*b0;
r:=sqrt(r1)+0.0001;
sn:=b0/r; cn:=a0/r;
if (m=3) then begin
sn1:=sn; cn1:=cn;
end
else begin
sn2:=sn; cn2:=cn;
r1:=a[2]*a[2]+b[2]*b[2];
r:=sqrt(r1);
p0:=x1[2]; q0:=y1[2];
p1:=r*cn1; q1:=r*sn1;
p2:=3*a[2]-r*(cn2+2*cn1);
q2:=3*b[2]-r*(sn2+2*sn1);
p3:=(-2)*(x1[3]-x1[2])+r*(cn2+cn1);
q3:=(-2)*(y1[3]-y1[2])+r*(sn2+sn1);
z:=1;
repeat
z:=z*0.9;
xt:=p0+z*(p1+z*(p2+z*p3))-x1[2];
yt:=q0+z*(q1+z*(q2+z*q3))-y1[2];
r:=xt*xt+yt*yt;
r1:=sqrt(r);
until (r1<=step);
z1:=z;
while(z<=1) do begin
xt:=p0+z*(p1+z*(p2+z*p3));
yt:=q0+z*(q1+z*(q2+z*q3));
plineto(xt,yt);
z:=z+z1;
end;
end;
end;
dispose(x);dispose;
end;

procedure doubleline(rl:rline;nn:integer;ww:single);
var l1,l2:rline;
ii:integer;
xt,yt,r,SN,CN:single;
begin
for ii:=0 to nn-2 do begin
xt:=rl[ii+1].x-rl[ii].x;
yt:=rl[ii+1].y-rl[ii].y;
r:=sqrt(xt*xt+yt*yt);
SN:=yt/r;CN:=xt/r;
l1[ii].x:=rl[ii].x+ww*SN;
l1[ii].y:=rl[ii].y-ww*CN;

l2[ii].x:=rl[ii].x-ww*SN;
l2[ii].y:=rl[ii].y+ww*CN;
end;
xt:=rl[nn-2].x-rl[nn-1].x;
yt:=rl[nn-2].y-rl[nn-1].y;
r:=sqrt(xt*xt+yt*yt);
SN:=yt/r;CN:=xt/r;

l1[nn-1].x:=rl[nn-1].x-ww*SN;
l1[nn-1].y:=rl[nn-1].y+ww*CN;

l2[nn-1].x:=rl[nn-1].x+ww*SN;
l2[nn-1].y:=rl[nn-1].y-ww*CN;

smoothline(l1,nn);
smoothline(l2,nn);
end;

procedure Thickline(rl:rline;nn:integer;ww:single);
const penwide=0.001;
var k,j:integer;
begin
k:=trunc(ww/penwide);
for j:=1 to k do
doubleline(rl,nn,j*penwide);
doubleline(rl,nn,ww);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
ScreenWidth := Paintbox1.Width-1;
ScreenHeight := Paintbox1.Height-1;
AdjustScale;
end;

var ALine: rLine;

procedure TForm1.Button1Click(Sender: TObject);
begin
ALine[0].x := 10; ALine[0].y := 10;
ALine[1].x := 40; ALine[1].y := 60;
ALine[2].x := 60; ALine[2].y := 70;
ALine[3].x := 80; ALine[3].y := 50;
ALine[4].x := 120; ALine[4].y := 30;
ALine[5].x := 130; ALine[5].y := 30;
ALine[6].x := 150; ALine[6].y := 30;
Paintbox1.Canvas.Pen.Color := clBlack;
pPolyline(ALine, 7);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Paintbox1.Canvas.Pen.Color := clRed;
smoothline(ALine, 7);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
Paintbox1.Canvas.Pen.Color := clBlue;
doubleline(ALine, 7, 4);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
xWorldMin := 0; yWorldMin := 0;
xWorldMax := 100; yWorldMax := 100;
AdjustScale;
PaintBox1.Refresh;
end;

end.

这里还同时奉送实数坐标到屏幕坐标的转换算法以及双线和粗线绘制的算法呢。

您作些调整可以完成您的要求。

我建议打点就比较圆滑了，其实算法差不多的，但是效果要好的多

lcl-003所说的procedure smoothline(rl: rline; no:integer); 就是可以的。
你试试看！

几句话是决对做不到的,看看图形学方面的知识吧，我给铁道部门开发的系统中就用到了平滑
斜线的技术，不过我不能给你，我怕有麻烦。

我一直在想这个问题，但是，尽管间隔很密，用激光打印机打印出来的不是很光滑，我见过用Matlab
或者Origin画的曲线，打印出来非常平滑，除了算法的问题外，应该还有用什么图形格式的问题，我在作图的时候
用MetaFile类型，但是这里面牵扯到MMWidth和MMHeight的设置问题，我不知道如何设置，TigerDing给个指点吧

to 天真
光滑有好多种方法，比较常见的是样条和贝塞尔曲线，前者是光滑线过控制点，后者是不过
控制点，就看你需要哪一种？

我这儿都有，不过接口可能不能满足你的要求，这样吧，你写一个调用接口，我看看能不能
帮你填代码。

吕前辈：
我要光滑线过控制点，我想学学谢谢了，！
如果教我调用接口但我又不知该填哪些参数据啊！
谢谢了！
mc@bj99.net

to 天真
你C/C++的功夫如何？可以的话我给你一个C的程序。

呵呵，好的，
看起来有点吃力
但还可以，谢谢了

收邮件吧。

我没看到哪个设置平滑的呀

你想如何设置平滑？

我想做到就是比如画一个斜线，
他的边缘没有坑坑哇哇的

我懂了，你要的不是矢量线段的平滑，你要的是栅格线段的边缘反走样平滑，对吧。

对，吕前辈，
矢量线段平滑与栅格线段的边缘反走样平滑有什么区别？
对了，再请教一个问题
你是如何保存矢量数据的记录的？
比如目前有两个矢量图，一个是圆，一个是不规则的多边形至于有多少个边不定，
你是如何把它保存下来的？
这个问题困扰了我很久了希望能够提示我一下
谢谢了

这二者的区别我不详述了，在很多的图形学书上有比我更经典的解释，总之一个是矢量的
计算，生成很多的光滑插值点来模拟光滑线，一个是其于点阵像素的操作，使边界的色彩过渡
自然一些。

矢量点数据我是存放在链表中的，如Delphi中的TList中，或VC中的CPtrArray中。圆可以保存
其四角坐标，不规则多边形就要保存每一个结点坐标，边数不确定的话，这种链表存储结构
可以助你方便地增删改。