tcanvas线拷贝和圆拷贝 (2001年1月7日).txt

自己对DELPHI学习的一点体会

Tcanvas线拷贝和圆拷贝 (2001年1月7日) 

网友更新  分类:多媒体   作者:阎磊  推荐:yanlei   阅读次数:304  
(http://www.codesky.net)  

--------------------------------------------------------------------------------
在delphi中,Canvas只有矩形拷贝,没有线拷贝和圆拷贝，提供以下函数
procedure CopyEllipse(src,dest:TCanvas;x,y,r:integer);圆拷贝
var
i,j,k:Integer;
begin
for i:=x-r to x+r do
begin
if (i>=0) and (i<=640) then
begin
for j:=y-r to y+r do
if (j>=0) and (j<=480) then
begin
k:=r*r-((i-x)*(i-x)+(j-y)*(j-y));
if (k0) then dest.Pixels[i,j]:=src.Pixels[i,j];
end;

end;

end;

end;

procedure copygline(src,dest:TCanvas;x1,y1,x2,y2:integer);//线拷贝
var
xdelta, ydelta,xstep,ystep,change:integer;
begin
xdelta := x2 - x1;
ydelta := y2 - y1;
if (xdelta < 0) then
begin
xdelta := -xdelta;
xstep := -1;
end

else
xstep := 1;
if (ydelta < 0) then
begin
ydelta := -ydelta;
ystep := -1;
end

else
ystep:= 1;
if (xdelta > ydelta) then
begin
change := xdelta div 2;
while (x1 <>x2) do
begin
dest.Pixels[x1,y1]:=src.Pixels[x1,y1];
x1 := x1+xstep;
change :=change+ ydelta;
if (change > xdelta) then
begin
y1 :=y1+ ystep;
change :=change-xdelta;
end;

end;

end

else
begin
change := ydelta div 2;
while (y1 <>y2) do
begin
dest.Pixels[x1,y1]:=src.Pixels[x1,y1];
y1 := y1+ystep;
change := change+xdelta;
if (change > ydelta) then
begin 
x1 :=x1+ xstep;
change :=change -ydelta;
end;

end;

end;

end;