建立坐标(200分)

  • 主题发起人 主题发起人 yeah_yahoo
  • 开始时间 开始时间
Y

yeah_yahoo

Unregistered / Unconfirmed
GUEST, unregistred user!
如何在Form上建立坐标,横坐标为时间坐标,纵坐标任意,输入纵横坐标值,
对应点能在Form上按时间顺序显示,并能连成光滑曲线,当纵坐标值超出窗口,曲线能够动态适应缩小,使曲线依然在窗口内,而曲线形状不变,当曲线变化不明显时,也能够动态的放大.
 
描点法建立坐标。

动态适应?重绘吧
 
坐标保存在自己的数据结构里,然后描点
 
曲线可以,要光滑曲线不容易,得自己编程控制
 
在FORM的OnPaint和OnResize里重画。
可以用PolyBezierTo,PolyBezier画光滑曲线吧。
 
大概只能分段光滑吧?
 
能否给出一个缩放比例的算法?使坐标及曲线始终在窗口内
 
只要横纵坐标按相同的比例变化就行吧?
 
你要实现的是(t,s)->(x,y)的转换,其比例系数由自己确定。只要跟踪曲线的最大
最小值变化,取合适的系数来转换,就能让曲线一直在窗口里
 
kang是否有你所说的转换的详细资料?谢谢
 
哎呀,大虾,有很多很多符合条件的控件呀!!!
比如去深度历险或者星际总部去找图形绘制方面的控件?
这分归我了吧?西西
 
win32的gdi中有画贝则曲线的函数,不知是否能用来画光滑曲线
 
我要的是关于这方面的算法及资料,如有源程序最好啦,呵呵
 
我只描点,没画过曲线。
 
那Kang是否有你描点的源程序呢?
 
给你发了,收到没有
 
我没有收到,能email给我吗?heaven@fzu.edu.cn
 
z再等等看,263有是很慢
今晚22:00你来一趟,告诉收到没有。(不过是很简单的一个袄)
 
将离散的点连接成为光滑曲线是我以前教《计算机地图制图》的主要内容之一。
其中有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(y);
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(y);
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.

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

您作些调整可以完成您的要求。
 
斑竹来了,我要白发了。。。。
 
后退
顶部