300分求粗线(线宽大于1)的直线的反走样算法(300分)

  • 主题发起人 主题发起人 ozj
  • 开始时间 开始时间
O

ozj

Unregistered / Unconfirmed
GUEST, unregistred user!
线宽1象素的算法本论坛已有,求粗线(线宽大于1)的直线的反走样算法,
请各位帮助一下。
 
Try !

var
TotRood, TotGroen, TotBlauw : real;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
with Image1.Picture.Bitmap do
begin
Width:=100;
Height:=100;
Canvas.Brush.Color:=clwhite;
Canvas.Fillrect(rect(0,0,100,100));
Canvas.Pen.Color:=clblack;
Canvas.Moveto(10,30);
Canvas.Lineto(90,90);
Canvas.Pen.Width:=2;
Canvas.ellipse(25,40,45,60);
Canvas.Font.name:='Times New Roman';
Canvas.Font.size:=15;
Canvas.Textout(5,5,'Hallo');
end;
Image2.Picture.bitmap:=AntiAliasing(Image1.picture.bitmap);
end;

function TForm1.AntiAliasing(Bitmap : TBitmap) : TBitmap;
var
x,y, Hoeveelheid : integer;
NieuweBitmap : TBitmap;
Rood, Blauw, Groen : integer;
begin
NieuweBitmap:=TBitmap.Create;?
NieuweBitmap.Assign(Bitmap);
for x:=0 to Bitmap.Width-1 do
begin
for y:=0 to Bitmap.Height-1 do
begin
TotRood:=0; TotGroen:=0; TotBlauw:=0;
CountRGB(Bitmap.Canvas,x,y,2);
CountRGB(Bitmap.Canvas,x-1,y,8);
CountRGB(Bitmap.Canvas,x,y-1,8);
CountRGB(Bitmap.Canvas,x+1,y,8);
CountRGB(Bitmap.Canvas,x,y+1,8);
NieuweBitmap.Canvas.Pixels[x,y]:=RGB(round(TotRood),round(TotGroen),round(TotBlauw));
end;
end;
result:=NieuweBitmap;
end;

procedure TForm1.CountRGB(EenCanvas : TCanvas; x,y : Integer; Hoeveelheid : Byte);
var
Kleur : LongInt;
Rood, Groen, Blauw : Integer;
begin
Kleur:=ColorToRGB(EenCanvas.Pixels[x,y]);
Blauw:=Kleur shr 16;
Groen:=(Kleur shr 8) and $00FF;
Rood:=Kleur and $0000FF;
TotRood:=TotRood+Rood/Hoeveelheid;
TotGroen:=TotGroen+Groen/Hoeveelheid;
TotBlauw:=TotBlauw+Blauw/Hoeveelheid;
end;
 
为什么锯齿仍然很明显,只是模糊了点,有没有更好的?
 
to YB_unique
我找到这样的程序,是不是原理和你上面提供的一致,请回应!

unit aliasing;

{ -------------------------------------------------------------------------- }
interface
{ -------------------------------------------------------------------------- }

uses
graphics, windows, classes, sysutils;

const
PIXELCOUNTMAX = 32768;

type
pRGBArray = ^TRGBArray;
TRGBArray = array[0..PIXELCOUNTMAX] of TRGBTriple;

TAliasing = class
private
procedure CopyBitmap( ASrc : graphics.TBitmap;
ADest : graphics.TBitmap );
public
constructor Create;
procedure AAliasText( ADest : graphics.TBitmap;
AX, AY : integer; AText : string );
end;

{ -------------------------------------------------------------------------- }
implementation
{ -------------------------------------------------------------------------- }

constructor TAliasing.Create;
begin
inherited Create;
end;

{ -------------------------------------------------------------------------- }
procedure TAliasing.CopyBitmap( ASrc : graphics.TBitmap;
ADest : graphics.TBitmap );
var
SrcRect : TRect;
DestRect : TRect;
begin
SrcRect := Bounds( 0,0, ASrc.Width, ASrc.Height );
DestRect := Bounds( 0,0, ADest.Width, ADest.Height );
ADest.Canvas.CopyRect( DestRect, ASrc.Canvas, SrcRect );
end;

{ -------------------------------------------------------------------------- }
procedure TAliasing.AAliasText( ADest : graphics.TBitmap;
AX, AY : integer; AText : string );
var
x, y, i, j : integer;
totr, totg, totb : Integer;
BigBitmap : graphics.TBitmap;
DestScan : pRGBArray;
BigScan : pRGBArray;
begin
BigBitmap := graphics.TBitmap.Create;
try
BigBitmap.PixelFormat := pf24bit;
ADest.PixelFormat := pf24bit;
BigBitmap.Width := ADest.Width * 2;
BigBitmap.Height := ADest.Height * 2;
CopyBitmap( ADest, BigBitmap );

BigBitmap.Canvas.Font := ADest.Canvas.Font;
BigBitmap.Canvas.Font.Size := 2 * ADest.Canvas.Font.Size;
BigBitmap.Canvas.Brush.Style := bsClear;
BigBitmap.Canvas.TextOut( AX, AY, AText );

// The "- 3" keeps us from falling off the edge
// of BigBox. Over the edge the Pixel value returns
// -1 and messes up the colors.
for y := 0 to (BigBitmap.Height - 3) Div 2 do
begin
DestScan := pRGBArray( ADest.ScanLine[y] );
for x := 0 to (BigBitmap.Width - 3) Div 2 do
begin
// Compute the value of output pixel (x, y).
totr := 0;
totg := 0;
totb := 0;
for j := 0 to 1 do
begin
BigScan := pRGBArray( BigBitmap.ScanLine[2*y+j] );
for i := 0 to 1 do
begin
totr := totr + BigScan[2*x+i].rgbtRed;
totg := totg + BigScan[2*x+i].rgbtGreen;
totb := totb + BigScan[2*x+i].rgbtBlue;
end;
end;
DestScan[x].rgbtBlue := totb shr 2;
DestScan[x].rgbtGreen := totg shr 2;
DestScan[x].rgbtRed := totr shr 2;
end;
end;
finally
BigBitmap.Free;
end;
end;


end.
 
如果想要更好的反走样效果,可以使用OpenGL!
如:
glEnable(GL_LINE_SMOOTH); //启动线反走样
glHint(GL_LINE_SMOOTH_HINT,GL_NICEST); //设置为最好质量的线反走样
 
接受答案了.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部