平滑線段antialising

發文回覆瀏覽次數：1375

推到 Plurk!

推到 Facebook!

缺席

poiuyt
一般會員

發表：1
回覆：0
積分：0
註冊：2009-12-23

發送簡訊給我

#1 引用回覆回覆

發表時間：2009-12-23 22:45:06

IP:61.58.xxx.xxx 未訂閱

前輩們
有個平滑線段(反鋸齒)的程式速度很慢,請前輩看看如何run得更快些?

procedure TComputerGrapicsMainForm.AtialiasClick(Sender: TObject);

var

X,Y,I,J,ColorValue,Scale:Integer;

SubAreaTotalR, SubAreaTotalG, SubAreaTotalB, R,G,B : Integer;

begin

Scale:=3; //虛擬放大倍數

with TestImage1.Canvas do

begin //以實際尺寸畫圖

Pen.Width:=3;

Brush.Color:=clYellow;

Ellipse(30,30,80,80);

MoveTo(20,20);Lineto(80,90);

end;

with TestImage2.Canvas do

begin //以虛擬放大尺寸畫圖

Pen.Width:=3*Scale;

Brush.Color:=clYellow;

Ellipse(30*Scale,30*Scale,80*Scale,80*Scale);

MoveTo(20*Scale,20*Scale);Lineto(80*Scale,90*Scale);

end;

for Y := 0 to TestImage1.Height - 1 do

begin

for X := 0 to TestImage1.Width - 1 do

begin

SubAreaTotalR := 0;SubAreaTotalG := 0; SubAreaTotalB := 0;

for I := 0 to Scale-1 do

begin

for J := 0 to Scale-1 do

begin

ColorValue:=TestImage2.Canvas.Pixels[(X*Scale) J, (Y*Scale) I];

R := Byte(ColorValue); G := Byte(ColorValue Shr 8);

B := Byte(ColorValue Shr 16);

SubAreaTotalR := SubAreaTotalR R;

SubAreaTotalG := SubAreaTotalG G;

SubAreaTotalB := SubAreaTotalB B;

end;

ImageChanged.Canvas.Pixels[X,Y] := RGB(SubAreaTotalr div (Scale*Scale),

SubAreaTotalg div (Scale*Scale), SubAreaTotalb div (Scale*Scale));

end;

系統時間：2024-05-17 4:55:39

聯絡我們 | Delphi K.Top討論版

本站聲明

1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！