Подтвердить что ты не робот

Простая функция сглаживания для Delphi 7

Мне нужна очень простая функция, чтобы нарисовать кучу строк с сглаживанием. Он должен следовать парадигме Delphi: автономно и SYSTEM INDEPENDENT (без DLL-ада), быстро, просто. Кто-нибудь знает такую ​​библиотеку?

До сих пор я пробовал:

WuLine
swissdelphicenter.ch/torry/showcode.php?id=1812
Я не думаю, что автор этого кода когда-либо запускал его. Чтобы сделать одну строку, требуется одна секунда! Это очевидно только для образовательных целей:)

Антиалиасированный рисунок от TMetaFile
Ссылка: blog.synopse.info/post/2010/04/02/Antialiased-drawing-from-TMetaFile
На самом деле я этого еще не пробовал (я могу сделать это в ближайшее время). Он работает только с TMetaFiles. Он загружает только файл EMF и рисует его с помощью функций сглаживания. Кроме того, много кода на этом веб-сайте является только демонстрационным/образовательным.

Image32
Очень хорошая библиотека - самая полная до сих пор. Я могу использовать его, но это слишком много для того, что мне нужно.
Недостатки:
 - След, добавленный в приложение, довольно большой.
 - Действительно сложно использовать.
 - Вам нужно глубоко погрузиться в свою неясную документацию даже для простых задач.  - Демонстрационный код слишком сложный.
 - Багги!
 - Последние обновления (исправлять ошибки)

Библиотека антиградовой геометрии
Библиотеке нужен достойный установщик. Авторами библиотеки являются пользователи Linux/Mac. Реализация Windows выглядит странно. Я не могу сказать что-то еще о самой библиотеке.

Основанная на Xiaolin Wu функция (by Andreas Rejbrand)
Просто посмотрите несколько сообщений ниже. Андреас Реджбранд предоставил очень компактное решение. Лучшее решение до сих пор.


Похоже, я должен объяснить, почему мне не нравятся большие сторонние библиотеки и VCL:

  • вам необходимо установить их
  • большая библиотека означает большое количество ошибок, что означает
  • вам нужно проверить наличие обновлений (и установить их снова).
  • При переустановке Delphi вы должны установить их еще раз (да, я ненавижу установку VCL)
  • для VCL, это означает, что вам нужно загрузить дополнительные значки в уже переполненную палитру.
  • (иногда) нет поддержки
  • LARGE footprint добавлен в размер вашего приложения.
  • большие библиотечные средства (ну не всегда, но в большинстве случаев) сложны в использовании - сложнее, чем вам нужно.
  • (для внешних DLL и API) ваше приложение становится зависящим от системы - действительно противным!
4b9b3361

Ответ 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. Но сейчас я слишком устал, чтобы отлаживать (только что вернулся с работы).

Ответ 2

Я считаю, что GDI + делает сглаженный рисунок (по умолчанию), я не знаю, имеют ли последние версии Delphi GdiPlus.pas, но есть копии доступно в Интернете.

Ответ 3

Вы можете попробовать TAgg2D. Это упрощенный API для 2D-чертежа AggPas. Таким образом, вы можете использовать простые функции, такие как:

  • Линия (x1, y1, x2, y2)
  • Прямоугольник (x1, y1, x2, y2)
  • RoundedRect (x1, y1, x2, y2, r)

Легко!

Ответ 5

Загрузите Graphics32. Создайте новый экземпляр TBitmap32. Вызвать метод TBitmap32.RenderText:

procedure TBitmap32.RenderText(X, Y: Integer; const Text: String; AALevel: Integer; Color: TColor32);

if AALevel > -1, тогда вы должны получить сглаженный текст.

Когда вы закончите запись строки (ов) в свой экземпляр TBitmap32, вы можете нарисовать этот экземпляр TBitmap32 на любой холст с помощью метода DrawTo:

procedure TBitmap32.DrawTo(hDst: HDC; DstX, DstY: Integer);

Ответ 6

Вот те продукты, о которых я знаю:

  • DtpDocument Очень хороший векторный редактор. Много возможностей. Anti-Aliasing поддерживается очень хорошо. Коммерческое решение.
  • ImageEn Это достаточно быстро для меня. Коммерческое решение.
  • Каирская графика Это очень быстро и используется Mozilla в Firefox для рендеринга. Вы можете легко использовать Cairo в Delphi этот учебник. Я настоятельно рекомендую вам сделать снимок.