[TRUCO DELPHI] Usar Canvas en modo Anti-Aliasing.
delphi
//percent va de 1 a 100, sino no habra efecto procedure Antialising(C: TCanvas; Rect: TRect; Percent: Integer); var l, p: Integer; R, G, B: Integer; R1, R2, G1, G2, B1, B2: Byte; begin with c do begin Brush.Style := bsclear; lineto(200, 100); moveto(50, 150); Ellipse(50, 150, 200, 30); for l := Rect.Top to Rect.Bottom do begin for p := Rect.Left to Rect.Right do begin R1 := GetRValue(Pixels[p, l]); G1 := GetGValue(Pixels[p, l]); B1 := GetBValue(Pixels[p, l]); R2 := GetRValue(Pixels[p - 1, l]); G2 := GetGValue(Pixels[p - 1, l]); B2 := GetBValue(Pixels[p - 1, l]); if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then begin R := Round(R1 + (R2 - R1) * 50 / (Percent + 50)); G := Round(G1 + (G2 - G1) * 50 / (Percent + 50)); B := Round(B1 + (B2 - B1) * 50 / (Percent + 50)); Pixels[p - 1, l] := RGB(R, G, B); end; R2 := GetRValue(Pixels[p + 1, l]); G2 := GetGValue(Pixels[p + 1, l]); B2 := GetBValue(Pixels[p + 1, l]); if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then begin R := Round(R1 + (R2 - R1) * 50 / (Percent + 50)); G := Round(G1 + (G2 - G1) * 50 / (Percent + 50)); B := Round(B1 + (B2 - B1) * 50 / (Percent + 50)); Pixels[p + 1, l] := RGB(R, G, B); end; R2 := GetRValue(Pixels[p, l - 1]); G2 := GetGValue(Pixels[p, l - 1]); B2 := GetBValue(Pixels[p, l - 1]); if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then begin R := Round(R1 + (R2 - R1) * 50 / (Percent + 50)); G := Round(G1 + (G2 - G1) * 50 / (Percent + 50)); B := Round(B1 + (B2 - B1) * 50 / (Percent + 50)); Pixels[p, l - 1] := RGB(R, G, B); end; R2 := GetRValue(Pixels[p, l + 1]); G2 := GetGValue(Pixels[p, l + 1]); B2 := GetBValue(Pixels[p, l + 1]); if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then begin R := Round(R1 + (R2 - R1) * 50 / (Percent + 50)); G := Round(G1 + (G2 - G1) * 50 / (Percent + 50)); B := Round(B1 + (B2 - B1) * 50 / (Percent + 50)); Pixels[p, l + 1] := RGB(R, G, B); end; end; end; end; end;
Ejemplo de Uso:
delphi
procedure TForm1.Button1Click(Sender: TObject); begin Antialising(Image1.Canvas, Image1.Canvas.ClipRect, 100); end;
Saludos!