Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> GDI+,Antialias, Draw 
:(
    Опции темы
Ftako
Дата 26.4.2014, 15:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 8
Регистрация: 27.12.2013

Репутация: нет
Всего: нет



Как сделать antialias для данного кода ? Или как нарисовать подобное на канве с антиалиасом?

Код

procedure DrawMoon( XCanvas: TCanvas);
Var W     : Integer;
 Phasex,   Phase : Extended;
      alpha,delta,dist,dkm,diam, phasex,illum : double;
begin
 // Phase:=GetPhase(now);

illum := 0,25;
Phasex := 180;

  If phasex < 180
    Then Phase:=(illum)
    Else Phase:=-(illum);

  With XCanvas  do Begin

    W:=ClipRect.Right-ClipRect.Left;

    Brush.Color:=$e3e3e3; // clWhite;
    Brush.Style:=bsSolid;
    Pen.Style := psClear;
    Rectangle(ClipRect.Left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
    // Фон
    Brush.Color:=clBlack;
    Brush.Style:=bsSolid;
    Pen.Style := psSolid;
    Pen.Color:=clBlack;
    Ellipse(ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom);
    If Abs(Phase) < 0.01 Then
      Exit;
    Brush.Color:=clWhite;
    If Phase > 0
      Then Pie(ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom,
               ClipRect.Left+ (W div 2), ClipRect.Bottom, ClipRect.Left+ (W div 2), ClipRect.Top)
      Else Pie(ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom,
               ClipRect.Left+ (W div 2), ClipRect.Top, ClipRect.Left+ (W div 2), ClipRect.Bottom);
    If (Abs(Phase) >= 0.48) And (Abs(Phase) <= 0.52) Then
      Exit;
    If Abs(Phase) < 0.5 Then
      Brush.Color:=clBlack;
    Pen.Color:=Brush.Color;
    Ellipse(ClipRect.Left+Round(W-W*Abs(Phase)), ClipRect.Top, ClipRect.Left+Round(W*Abs(Phase)), ClipRect.Bottom);
    Pen.Color:=clBlack;
    Brush.Color:=$e3e3e3; // clWhite;
    Brush.Style:=bsClear;
    Ellipse(ClipRect.Left, ClipRect.Top, ClipRect.Right, ClipRect.Bottom);  {}
  End
end;


PM MAIL   Вверх
Illusion Dolphin
Дата 28.4.2014, 00:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63



Подходов много, посмотрите сюда http://stackoverflow.com/questions/3613130...on-for-delphi-7


--------------------
В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5
PM MAIL WWW ICQ   Вверх
Alexeis
Дата 29.4.2014, 09:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459



  Один из классических способов, используемых в 3D графике состоит в том, чтобы рисовать изображение в несколько раз больше 2х, 4х и т.д. и затем делать уменьшение с интерполяцией цвета, по 4м и более соседним пикселям. Получается, что цвет линии смешивается с цветом фона по краям линии. Но при таком способе следует пропорционально увеличивать и толщину линии. К сожалению GDI средства неэффективно рисуют линии толщины более чем 1, поэтому ожидаемая потеря производительности порядка 20-50 раз. 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
PointerToNil
Дата 29.4.2014, 19:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата



*


Профиль
Группа: Участник
Сообщений: 108
Регистрация: 17.6.2013

Репутация: нет
Всего: 6



Код

uses Math;

// корни вроде как растут из работы Wu Xiaolin
// идея алгоритма взята с http://www.landkey.net/d/antialiased/wu4_RF/

// для понятности - версия с TCanvas.Pixels; с TBitmap.Scanline будет гораздо быстрее

procedure AACircle(ACanvas: TCanvas; CX, CY, R: integer; AColor: TColor); // AntiAliased окружность толщиной 1
var
  x, y, i: integer; real_x, intensity: double;

  procedure put8pixels(x, y: integer; intensity: double);

    procedure putpixel(x, y: integer);
    var color: TColor;
    begin
      color := ACanvas.Pixels[x, y];
      color := RGB(round(GetRValue(color) * (1-intensity) + GetRValue(AColor) * intensity),
                   round(GetGValue(color) * (1-intensity) + GetGValue(AColor) * intensity),
                   round(GetBValue(color) * (1-intensity) + GetBValue(AColor) * intensity));
      ACanvas.Pixels[x, y] := color;
    end;

  begin
    putpixel(cx-x, cy-y);
    putpixel(cx-x, cy+y);
    putpixel(cx+x, cy-y);
    putpixel(cx+x, cy+y);
    putpixel(cx-y, cy-x);
    putpixel(cx+y, cy-x);
    putpixel(cx-y, cy+X);
    putpixel(cx+y, cy+x);
  end;

begin
  for y:=0 to round(r/sqrt(2)) do
  begin
    real_x := sqrt(r*r-y*y);
    x := ceil(real_x);
    intensity := x - real_x;
    put8pixels(x-1, y, intensity);
    put8pixels(x, y, 1-intensity);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject); // понарисуем рандомных кружков
var i, c, x, y, r: integer;
begin
  Canvas.Pen.Style := psClear;
  for i:=0 to 100 do
  begin
    c := random(256*256*256);
    x := random(ClientWidth); y:=random(ClientHeight); r:=random(100);
    AACircle(Canvas, x, y, r, c);
    Canvas.Brush.Color := c;
    Canvas.Ellipse(x-r, y-r, x+r+2, y+r+2); // а для заливки - обычный GDI Ellipse
  end;
end;
 
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!


Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »


 




[ Время генерации скрипта: 0.0500 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.