Недавно добавленные исходники

•  Animation Loaders  750

•  DeLiKaTeS Tetris (Тетрис)  5 740

•  TDictionary Custom Sort  7 694

•  Fast Watermark Sources  7 376

•  3D Designer  10 593

•  Sik Screen Capture  7 901

•  Patch Maker  8 131

•  Айболит (remote control)  8 183

•  ListBox Drag & Drop  6 984

•  Доска для игры Реверси  100 274

•  Графические эффекты  8 256

•  Рисование по маске  7 638

•  Перетаскивание изображений  6 240

•  Canvas Drawing  6 610

•  Рисование Луны  6 535

•  Поворот изображения  5 702

•  Рисование стержней  4 634

•  Paint on Shape  3 336

•  Генератор кроссвордов  4 312

•  Головоломка Paletto  3 460

•  Теорема Монжа об окружностях  4 284

•  Пазл Numbrix  2 772

•  Заборы и коммивояжеры  3 688

•  Игра HIP  2 488

•  Игра Go (Го)  2 479

•  Симулятор лифта  2 874

•  Программа укладки плитки  2 312

•  Генератор лабиринта  3 036

•  Проверка числового ввода  2 538

•  HEX View  2 948

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Как использовать anti-aliasing



{The parameter "percent" needs an integer between 0 and 100
(include zero and 100). If "Percent" is 0, there will be no effect.
If it's 100 there will be the strongest effect.}

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]);

        //Pixel links
        //Pixel left
        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;

        //Pixel rechts
        //Pixel right
        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;

        //Pixel oben
        //Pixel up
        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;

        //Pixel unten
        //Pixel down
        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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Antialising(Image1.Canvas, Image1.Canvas.ClipRect, 100);
end;




Похожие по теме исходники

Antialiasing Picture

Anti Miner

AID Antivirus Module

RBS AntiDOT 2009

 

Anti Double

xCore Antivirus




Copyright © 2004-2026 "Delphi Sources" by «SiteAnalyzer». Delphi World FAQ

Группа ВКонтакте