Ответ 1
Не очень сложно реализовать алгоритм рендеринга линии сглаживания Xiaolin Wu в Delphi. Я использовал статью в Википедии в качестве ссылки, когда я написал следующую процедуру (на самом деле я просто перевел псевдокод в Delphi и исправил ошибку, и добавлена поддержка цветного фона):
procedure DrawAntialisedLine(Canvas: TCanvas; const AX1, AY1, AX2, AY2: real; const LineColor: TColor);
var
swapped: boolean;
procedure plot(const x, y, c: real);
var
resclr: TColor;
begin
if swapped then
resclr := Canvas.Pixels[round(y), round(x)]
else
resclr := Canvas.Pixels[round(x), round(y)];
resclr := RGB(round(GetRValue(resclr) * (1-c) + GetRValue(LineColor) * c),
round(GetGValue(resclr) * (1-c) + GetGValue(LineColor) * c),
round(GetBValue(resclr) * (1-c) + GetBValue(LineColor) * c));
if swapped then
Canvas.Pixels[round(y), round(x)] := resclr
else
Canvas.Pixels[round(x), round(y)] := resclr;
end;
function rfrac(const x: real): real; inline;
begin
rfrac := 1 - frac(x);
end;
procedure swap(var a, b: real);
var
tmp: real;
begin
tmp := a;
a := b;
b := tmp;
end;
var
x1, x2, y1, y2, dx, dy, gradient, xend, yend, xgap, xpxl1, ypxl1,
xpxl2, ypxl2, intery: real;
x: integer;
begin
x1 := AX1;
x2 := AX2;
y1 := AY1;
y2 := AY2;
dx := x2 - x1;
dy := y2 - y1;
swapped := abs(dx) < abs(dy);
if swapped then
begin
swap(x1, y1);
swap(x2, y2);
swap(dx, dy);
end;
if x2 < x1 then
begin
swap(x1, x2);
swap(y1, y2);
end;
gradient := dy / dx;
xend := round(x1);
yend := y1 + gradient * (xend - x1);
xgap := rfrac(x1 + 0.5);
xpxl1 := xend;
ypxl1 := floor(yend);
plot(xpxl1, ypxl1, rfrac(yend) * xgap);
plot(xpxl1, ypxl1 + 1, frac(yend) * xgap);
intery := yend + gradient;
xend := round(x2);
yend := y2 + gradient * (xend - x2);
xgap := frac(x2 + 0.5);
xpxl2 := xend;
ypxl2 := floor(yend);
plot(xpxl2, ypxl2, rfrac(yend) * xgap);
plot(xpxl2, ypxl2 + 1, frac(yend) * xgap);
for x := round(xpxl1) + 1 to round(xpxl2) - 1 do
begin
plot(x, floor(intery), rfrac(intery));
plot(x, floor(intery) + 1, frac(intery));
intery := intery + gradient;
end;
end;
Чтобы использовать эту функцию, просто создайте холст, чтобы рисовать (аналогично функциям Windows GDI, требующим контекста устройства (DC)), и укажите начальную и конечную точки в строке. Обратите внимание, что код выше рисует черную линию и что фон должен быть белым. Нетрудно обобщить это на любую ситуацию, даже на альфа-прозрачные рисунки. Просто отрегулируйте функцию plot, в которой c \in [0, 1] - непрозрачность пикселя в (x, y).
Пример использования:
Создайте новый проект VCL и добавьте
procedure TForm1.FormCreate(Sender: TObject);
begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := clWhite;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Canvas.FillRect(ClientRect);
DrawAntialisedLine(Canvas, Width div 2, Height div 2, X, Y, clBlack);
end;
Нажмите, чтобы увеличить http://privat.rejbrand.se/aaline.png
(Увеличить)
OpenGL
Если вам нужен высокопроизводительный и высококачественный рендеринг в 2D или 3D, и вы сами делаете все чертеж, то OpenGL, как правило, лучший выбор. Очень просто написать приложение OpenGL в Delphi. См. http://privat.rejbrand.se/smooth.exe для примера, который я сделал всего за десять минут. Используйте правую кнопку мыши для переключения между заполненными многоугольниками и контурами и нажмите и удерживайте левую кнопку мыши, чтобы стрелять!
Update
Я только что сделал код на цветном фоне, например, на фотографии.
Нажмите, чтобы увеличить http://privat.rejbrand.se/aabkg.png
(Увеличить)
Обновление - Ультрабыстрый метод
Вышеприведенный код довольно медленный, потому что свойство Bitmap.Pixels удивительно медленное. Когда я работаю с графикой, я всегда представляю растровое изображение, используя двумерный массив значений цвета, который намного, намного, намного быстрее. И когда я закончил с изображением, я преобразую его в растровое изображение GDI. У меня также есть функция, которая создает массив pixmap из растрового изображения GDI.
Я изменил приведенный выше код, чтобы рисовать на массиве вместо растрового изображения GDI, и результат является многообещающим:
- Время, необходимое для отображения 100 строк
- GDI Bitmap: 2.86 с
- Пиксельный массив: 0,01 с
Если мы допустим
type
TPixmap = array of packed array of RGBQUAD;
и определите
procedure TForm3.DrawAntialisedLineOnPixmap(var Pixmap: TPixmap; const AX1, AY1, AX2, AY2: real; const LineColor: TColor);
var
swapped: boolean;
procedure plot(const x, y, c: real);
var
resclr: TRGBQuad;
begin
if swapped then
begin
if (x < 0) or (y < 0) or (x >= ClientWidth) or (y >= ClientHeight) then
Exit;
resclr := Pixmap[round(y), round(x)]
end
else
begin
if (y < 0) or (x < 0) or (y >= ClientWidth) or (x >= ClientHeight) then
Exit;
resclr := Pixmap[round(x), round(y)];
end;
resclr.rgbRed := round(resclr.rgbRed * (1-c) + GetRValue(LineColor) * c);
resclr.rgbGreen := round(resclr.rgbGreen * (1-c) + GetGValue(LineColor) * c);
resclr.rgbBlue := round(resclr.rgbBlue * (1-c) + GetBValue(LineColor) * c);
if swapped then
Pixmap[round(y), round(x)] := resclr
else
Pixmap[round(x), round(y)] := resclr;
end;
function rfrac(const x: real): real; inline;
begin
rfrac := 1 - frac(x);
end;
procedure swap(var a, b: real);
var
tmp: real;
begin
tmp := a;
a := b;
b := tmp;
end;
var
x1, x2, y1, y2, dx, dy, gradient, xend, yend, xgap, xpxl1, ypxl1,
xpxl2, ypxl2, intery: real;
x: integer;
begin
x1 := AX1;
x2 := AX2;
y1 := AY1;
y2 := AY2;
dx := x2 - x1;
dy := y2 - y1;
swapped := abs(dx) < abs(dy);
if swapped then
begin
swap(x1, y1);
swap(x2, y2);
swap(dx, dy);
end;
if x2 < x1 then
begin
swap(x1, x2);
swap(y1, y2);
end;
gradient := dy / dx;
xend := round(x1);
yend := y1 + gradient * (xend - x1);
xgap := rfrac(x1 + 0.5);
xpxl1 := xend;
ypxl1 := floor(yend);
plot(xpxl1, ypxl1, rfrac(yend) * xgap);
plot(xpxl1, ypxl1 + 1, frac(yend) * xgap);
intery := yend + gradient;
xend := round(x2);
yend := y2 + gradient * (xend - x2);
xgap := frac(x2 + 0.5);
xpxl2 := xend;
ypxl2 := floor(yend);
plot(xpxl2, ypxl2, rfrac(yend) * xgap);
plot(xpxl2, ypxl2 + 1, frac(yend) * xgap);
for x := round(xpxl1) + 1 to round(xpxl2) - 1 do
begin
plot(x, floor(intery), rfrac(intery));
plot(x, floor(intery) + 1, frac(intery));
intery := intery + gradient;
end;
end;
и функции преобразования
var
pixmap: TPixmap;
procedure TForm3.CanvasToPixmap;
var
y: Integer;
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Bitmap.SetSize(ClientWidth, ClientHeight);
Bitmap.PixelFormat := pf32bit;
BitBlt(Bitmap.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, Canvas.Handle, 0, 0, SRCCOPY);
SetLength(pixmap, ClientHeight, ClientWidth);
for y := 0 to ClientHeight - 1 do
CopyMemory(@(pixmap[y][0]), Bitmap.ScanLine[y], ClientWidth * sizeof(RGBQUAD));
finally
Bitmap.Free;
end;
end;
procedure TForm3.PixmapToCanvas;
var
y: Integer;
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Bitmap.PixelFormat := pf32bit;
Bitmap.SetSize(ClientWidth, ClientHeight);
for y := 0 to Bitmap.Height - 1 do
CopyMemory(Bitmap.ScanLine[y], @(Pixmap[y][0]), ClientWidth * sizeof(RGBQUAD));
Canvas.Draw(0, 0, Bitmap);
finally
Bitmap.Free;
end;
end;
то мы можем написать
procedure TForm3.FormPaint(Sender: TObject);
begin
// Get the canvas as a bitmap, and convert this to a pixmap
CanvasToPixmap;
// Draw on this pixmap (very fast!)
for i := 0 to 99 do
DrawAntialisedLineOnPixmap(pixmap, Random(ClientWidth), Random(ClientHeight), Random(ClientWidth), Random(ClientHeight), clRed);
// Convert the pixmap to a bitmap, and draw on the canvas
PixmapToCanvas;
end;
который будет отображать 100 сглаженных линий в форме менее чем за одну сотую секунды.
В коде есть небольшая ошибка, хотя, вероятно, в функции Canvas → Pixmap. Но сейчас я слишком устал, чтобы отлаживать (только что вернулся с работы).